f1dfe1e · rowtype-yoga/purescript-native

psc-bundle/Main.hs+2−2

compare with golang

unifiedsplit

@@ -51,7 +51,7 @@ data Options = Options

51 } deriving Show

52

53-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.

54−guessModuleIdentifier :: (Applicative m, MonadError ErrorMessage m) => FilePath -> m ModuleIdentifier

54+guessModuleIdentifier :: (MonadError ErrorMessage m) => FilePath -> m ModuleIdentifier

55guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> guessModuleType (takeFileName filename)

56 where

57 guessModuleType "index.js" = pure Regular

@@ -61,7 +61,7 @@ guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory f

61-- | The main application function.

62-- This function parses the input files, performs dead code elimination, filters empty modules

63-- and generates and prints the final Javascript bundle.

64−app :: (Applicative m, MonadError ErrorMessage m, MonadIO m) => Options -> m String

64+app :: (MonadError ErrorMessage m, MonadIO m) => Options -> m String

65app Options{..} = do

66 inputFiles <- concat <$> mapM (liftIO . glob) optionsInputFiles

67 when (null inputFiles) . liftIO $ do

psc-ide-server/Main.hs+1−1

@@ -124,7 +124,7 @@ startServer port env = withSocketsDo $ do

124 liftIO (hClose h)

125

126

127−acceptCommand :: (Applicative m, MonadIO m, MonadLogger m, MonadError T.Text m)

127+acceptCommand :: (MonadIO m, MonadLogger m, MonadError T.Text m)

128 => Socket -> m (T.Text, Handle)

129acceptCommand sock = do

130 h <- acceptConnection

psc/Main.hs+1−1

@@ -107,7 +107,7 @@ globWarningOnMisses warn = concatMapM globWithWarning

107readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]

108readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readUTF8File inFile

109

110−parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)

110+parseInputs :: (MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)

111 => [(Either P.RebuildPolicy FilePath, String)]

112 -> [(FilePath, P.ForeignJS)]

113 -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName FilePath)

src/Control/Monad/Supply.hs+1−1

@@ -27,7 +27,7 @@ import Control.Monad.Error.Class (MonadError(..))

27import Control.Monad.Reader

28import Control.Monad.Writer

29

30−newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a }

30+newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a }

31 deriving (Functor, Applicative, Monad, MonadTrans, MonadError e, MonadWriter w, MonadReader r)

32

33runSupplyT :: Integer -> SupplyT m a -> m (a, Integer)

src/Language/PureScript/AST/Traversals.hs+3−3

@@ -91,7 +91,7 @@ everywhereOnValues f g h = (f', g', h')

91

92everywhereOnValuesTopDownM

93 :: forall m

94− . (Functor m, Applicative m, Monad m)

94+ . (Monad m)

95 => (Declaration -> m Declaration)

96 -> (Expr -> m Expr)

97 -> (Binder -> m Binder)

@@ -160,7 +160,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)

160

161everywhereOnValuesM

162 :: forall m

163− . (Functor m, Applicative m, Monad m)

163+ . (Monad m)

164 => (Declaration -> m Declaration)

165 -> (Expr -> m Expr)

166 -> (Binder -> m Binder)

@@ -389,7 +389,7 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'

389

390everywhereWithContextOnValuesM

391 :: forall m s

392− . (Functor m, Applicative m, Monad m)

392+ . (Monad m)

393 => s

394 -> (s -> Declaration -> m (s, Declaration))

395 -> (s -> Expr -> m (s, Expr))

src/Language/PureScript/Bundle.hs+2−2

@@ -209,7 +209,7 @@ withDeps (Module modulePath es) = Module modulePath (map expandDeps es)

209--

210-- Each type of module element is matched using pattern guards, and everything else is bundled into the

211-- Other constructor.

212−toModule :: forall m. (Applicative m, MonadError ErrorMessage m) => Maybe FilePath -> S.Set String -> ModuleIdentifier -> JSNode -> m Module

212+toModule :: forall m. (MonadError ErrorMessage m) => Maybe FilePath -> S.Set String -> ModuleIdentifier -> JSNode -> m Module

213toModule requirePath mids mid top

214 | JSSourceElementsTop ns <- node top = Module mid <$> traverse toModuleElement ns

215 | otherwise = err InvalidTopLevel

@@ -533,7 +533,7 @@ codeGen optionsMainModule optionsNamespace ms = renderToString (NN (JSSourceElem

533-- | The bundling function.

534-- This function performs dead code elimination, filters empty modules

535-- and generates and prints the final Javascript bundle.

536−bundle :: (Applicative m, MonadError ErrorMessage m)

536+bundle :: (MonadError ErrorMessage m)

537 => [(ModuleIdentifier, String)] -- ^ The input modules. Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.

538 -> [ModuleIdentifier] -- ^ Entry points. These module identifiers are used as the roots for dead-code elimination

539 -> Maybe String -- ^ An optional main module.

src/Language/PureScript/CodeGen/JS.hs+1−1

@@ -47,7 +47,7 @@ import System.FilePath.Posix ((</>))

47--

48moduleToJs

49 :: forall m

50− . (Applicative m, Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)

50+ . (Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)

51 => Module Ann

52 -> Maybe JS

53 -> m [JS]

src/Language/PureScript/CodeGen/JS/AST.hs+1−1

@@ -347,7 +347,7 @@ everywhereOnJS f = go

347everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS

348everywhereOnJSTopDown f = runIdentity . everywhereOnJSTopDownM (Identity . f)

349

350−everywhereOnJSTopDownM :: (Applicative m, Monad m) => (JS -> m JS) -> JS -> m JS

350+everywhereOnJSTopDownM :: (Monad m) => (JS -> m JS) -> JS -> m JS

351everywhereOnJSTopDownM f = f >=> go

352 where

353 f' = f >=> go

src/Language/PureScript/CodeGen/JS/Optimizer.hs+2−2

@@ -43,12 +43,12 @@ import Language.PureScript.CodeGen.JS.Optimizer.Blocks

43-- |

44-- Apply a series of optimizer passes to simplified Javascript code

45--

46−optimize :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS

46+optimize :: (Monad m, MonadReader Options m, MonadSupply m) => JS -> m JS

47optimize js = do

48 noOpt <- asks optionsNoOptimizations

49 if noOpt then return js else optimize' js

50

51−optimize' :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS

51+optimize' :: (Monad m, MonadReader Options m, MonadSupply m) => JS -> m JS

52optimize' js = do

53 opts <- ask

54 js' <- untilFixedPoint (inlineFnComposition . tidyUp . applyAll

src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs+1−1

@@ -235,7 +235,7 @@ inlineCommonOperators = applyAll $

235

236-- (f <<< g $ x) = f (g x)

237-- (f <<< g) = \x -> f (g x)

238−inlineFnComposition :: (Applicative m, MonadSupply m) => JS -> m JS

238+inlineFnComposition :: (MonadSupply m) => JS -> m JS

239inlineFnComposition = everywhereOnJSTopDownM convert

240 where

241 convert :: (MonadSupply m) => JS -> m JS

src/Language/PureScript/Docs/AsMarkdown.hs+1−2

@@ -29,8 +29,7 @@ import qualified Language.PureScript.Docs.Render as Render

29-- Markdown-formatted String.

30--

31renderModulesAsMarkdown ::

32− (Functor m, Applicative m,

33− MonadError P.MultipleErrors m) =>

32+ (MonadError P.MultipleErrors m) =>

34 [P.Module] ->

33 [P.Module] ->

35 m String

34 m String

36renderModulesAsMarkdown =

35renderModulesAsMarkdown =

src/Language/PureScript/Docs/Convert.hs+6−6

@@ -38,7 +38,7 @@ import Language.PureScript.Docs.Convert.ReExports (updateReExports)

38-- documentation.

39--

40convertModulesInPackage ::

41− (Functor m, Applicative m, MonadError P.MultipleErrors m) =>

41+ (MonadError P.MultipleErrors m) =>

42 [InPackage P.Module] ->

43 m [Module]

44convertModulesInPackage modules =

@@ -66,7 +66,7 @@ convertModulesInPackage modules =

66-- types.

67--

68convertModules ::

69− (Functor m, Applicative m, MonadError P.MultipleErrors m) =>

69+ (MonadError P.MultipleErrors m) =>

70 [P.Module] ->

71 m [Module]

72convertModules =

@@ -81,7 +81,7 @@ importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])

81-- Convert a sorted list of modules.

82--

83convertSorted ::

84− (Functor m, Applicative m, MonadError P.MultipleErrors m) =>

84+ (MonadError P.MultipleErrors m) =>

85 [P.Module] ->

86 m [Module]

87convertSorted modules = do

@@ -99,7 +99,7 @@ convertSorted modules = do

99-- types.

100--

101typeCheckIfNecessary ::

102− (Functor m, Applicative m, MonadError P.MultipleErrors m) =>

102+ (MonadError P.MultipleErrors m) =>

103 [P.Module] ->

104 [Module] ->

105 m [Module]

@@ -122,7 +122,7 @@ typeCheckIfNecessary modules convertedModules =

122-- were not provided.

123--

124typeCheck ::

125− (Functor m, MonadError P.MultipleErrors m) =>

125+ (MonadError P.MultipleErrors m) =>

126 [P.Module] ->

127 m ([P.Module], P.Environment)

128typeCheck =

@@ -182,7 +182,7 @@ runParser p s = either (Left . show) Right $ do

182-- documentation information from.

183--

184partiallyDesugar ::

185− (Functor m, Applicative m, MonadError P.MultipleErrors m) =>

185+ (MonadError P.MultipleErrors m) =>

186 [P.Module]

187 -> m (P.Env, [P.Module])

188partiallyDesugar = P.evalSupplyT 0 . desugar'

src/Language/PureScript/Docs/Convert/ReExports.hs+13−22

@@ -69,8 +69,7 @@ updateReExports env order modules =

69-- have already been converted.

70--

71getReExports ::

72− (Functor m, Applicative m,

73− MonadState (Map P.ModuleName Module) m) =>

72+ (MonadState (Map P.ModuleName Module) m) =>

74 P.Env ->

73 P.Env ->

75 P.ModuleName ->

74 P.ModuleName ->

76 m [(P.ModuleName, [Declaration])]

75 m [(P.ModuleName, [Declaration])]

@@ -105,9 +104,7 @@ getReExports env mn =

105-- class members are listed.

104-- class members are listed.

106--

105--

107collectDeclarations ::

106collectDeclarations ::

108− (Functor m, Applicative m,

109− MonadState (Map P.ModuleName Module) m,

107+ (MonadState (Map P.ModuleName Module) m, MonadReader P.ModuleName m) =>

110− MonadReader P.ModuleName m) =>

111 P.Imports ->

108 P.Imports ->

112 P.Exports ->

109 P.Exports ->

113 m [(P.ModuleName, [Declaration])]

110 m [(P.ModuleName, [Declaration])]

@@ -154,7 +151,7 @@ collectDeclarations imports exports = do

154-- instantiate @name@ as both 'P.Ident' and 'P.ProperName'.

151-- instantiate @name@ as both 'P.Ident' and 'P.ProperName'.

155--

152--

156findImport ::

153findImport ::

157− (Show name, Eq name, Applicative m, MonadReader P.ModuleName m) =>

154+ (Show name, Eq name, MonadReader P.ModuleName m) =>

158 [P.ImportRecord name] ->

155 [P.ImportRecord name] ->

159 (name, P.ModuleName) ->

156 (name, P.ModuleName) ->

160 m (P.ModuleName, name)

157 m (P.ModuleName, name)

@@ -174,9 +171,8 @@ findImport imps (name, orig) =

174 internalErrorInModule ("findImport: not found: " ++ show (name, orig))

171 internalErrorInModule ("findImport: not found: " ++ show (name, orig))

175

172

176lookupValueDeclaration ::

173lookupValueDeclaration ::

177− (Applicative m,

178− MonadState (Map P.ModuleName Module) m,

174+ (MonadState (Map P.ModuleName Module) m,

179− MonadReader P.ModuleName m) =>

175+ MonadReader P.ModuleName m) =>

180 P.ModuleName ->

176 P.ModuleName ->

181 P.Ident ->

177 P.Ident ->

182 m (P.ModuleName, [Either (String, P.Constraint, ChildDeclaration) Declaration])

178 m (P.ModuleName, [Either (String, P.Constraint, ChildDeclaration) Declaration])

@@ -233,9 +229,8 @@ lookupValueDeclaration importedFrom ident = do

233-- are only included in the output if they are listed in the arguments.

229-- are only included in the output if they are listed in the arguments.

234--

230--

235lookupTypeDeclaration ::

231lookupTypeDeclaration ::

236− (Applicative m,

237− MonadState (Map P.ModuleName Module) m,

232+ (MonadState (Map P.ModuleName Module) m,

238− MonadReader P.ModuleName m) =>

233+ MonadReader P.ModuleName m) =>

239 P.ModuleName ->

234 P.ModuleName ->

240 P.ProperName 'P.TypeName ->

235 P.ProperName 'P.TypeName ->

241 m (P.ModuleName, [Declaration])

236 m (P.ModuleName, [Declaration])

@@ -251,9 +246,8 @@ lookupTypeDeclaration importedFrom ty = do

251 ("lookupTypeDeclaration: unexpected result: " ++ show other)

246 ("lookupTypeDeclaration: unexpected result: " ++ show other)

252

247

253lookupTypeClassDeclaration ::

248lookupTypeClassDeclaration ::

254− (Applicative m,

255− MonadState (Map P.ModuleName Module) m,

249+ (MonadState (Map P.ModuleName Module) m,

256− MonadReader P.ModuleName m) =>

250+ MonadReader P.ModuleName m) =>

257 P.ModuleName ->

251 P.ModuleName ->

258 P.ProperName 'P.ClassName ->

252 P.ProperName 'P.ClassName ->

259 m (P.ModuleName, [Declaration])

253 m (P.ModuleName, [Declaration])

@@ -276,9 +270,8 @@ lookupTypeClassDeclaration importedFrom tyClass = do

276-- state, or raise an internal error if it is not there.

270-- state, or raise an internal error if it is not there.

277--

271--

278lookupModuleDeclarations ::

272lookupModuleDeclarations ::

279− (Applicative m,

280− MonadState (Map P.ModuleName Module) m,

273+ (MonadState (Map P.ModuleName Module) m,

281− MonadReader P.ModuleName m) =>

274+ MonadReader P.ModuleName m) =>

282 String ->

275 String ->

283 P.ModuleName ->

276 P.ModuleName ->

284 m [Declaration]

277 m [Declaration]

@@ -293,8 +286,7 @@ lookupModuleDeclarations definedIn moduleName = do

293 pure (allDeclarations mdl)

286 pure (allDeclarations mdl)

294

287

295handleTypeClassMembers ::

288handleTypeClassMembers ::

296− (Functor m, Applicative m,

297− MonadReader P.ModuleName m) =>

289+ (MonadReader P.ModuleName m) =>

298 Map P.ModuleName [Either (String, P.Constraint, ChildDeclaration) Declaration] ->

290 Map P.ModuleName [Either (String, P.Constraint, ChildDeclaration) Declaration] ->

299 Map P.ModuleName [Declaration] ->

291 Map P.ModuleName [Declaration] ->

300 m (Map P.ModuleName [Declaration], Map P.ModuleName [Declaration])

292 m (Map P.ModuleName [Declaration], Map P.ModuleName [Declaration])

@@ -364,8 +356,7 @@ instance Monoid TypeClassEnv where

364-- Returns a tuple of (values, type classes).

356-- Returns a tuple of (values, type classes).

365--

357--

366handleEnv ::

358handleEnv ::

367− (Functor m, Applicative m,

368− MonadReader P.ModuleName m) =>

359+ (MonadReader P.ModuleName m) =>

369 TypeClassEnv ->

360 TypeClassEnv ->

370 m ([Declaration], [Declaration])

361 m ([Declaration], [Declaration])

371handleEnv TypeClassEnv{..} =

362handleEnv TypeClassEnv{..} =

src/Language/PureScript/Docs/ParseAndBookmark.hs+2−2

@@ -35,7 +35,7 @@ import Language.PureScript.Docs.Convert (collectBookmarks)

35-- * Collect a list of bookmarks from the whole set of source files

36-- * Return the parsed modules and the bookmarks

37parseAndBookmark ::

38− (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadIO m) =>

38+ (MonadError P.MultipleErrors m, MonadIO m) =>

39 [FilePath]

40 -> [(PackageName, FilePath)]

41 -> m ([InPackage P.Module], [Bookmark])

@@ -82,7 +82,7 @@ fileInfoToString (FromDep _ fn) = fn

82parseFile :: FilePath -> IO (FilePath, String)

83parseFile input' = (,) input' <$> readFile input'

84

85−parseAs :: (Functor m, MonadIO m) => (FilePath -> a) -> FilePath -> m (a, String)

85+parseAs :: (MonadIO m) => (FilePath -> a) -> FilePath -> m (a, String)

86parseAs g = fmap (first g) . liftIO . parseFile

87

88getDepsModuleNames :: [InPackage (FilePath, P.Module)] -> M.Map P.ModuleName PackageName

src/Language/PureScript/Errors.hs+4−4

@@ -1283,7 +1283,7 @@ renderBox = unlines

1283rethrow :: (MonadError e m) => (e -> e) -> m a -> m a

1284rethrow f = flip catchError $ \e -> throwError (f e)

1285

1286−reifyErrors :: (Functor m, MonadError e m) => m a -> m (Either e a)

1286+reifyErrors :: (MonadError e m) => m a -> m (Either e a)

1287reifyErrors ma = catchError (fmap Right ma) (return . Left)

1288

1289reflectErrors :: (MonadError e m) => m (Either e a) -> m a

@@ -1310,13 +1310,13 @@ withPosition pos (ErrorMessage hints se) = ErrorMessage (PositionedError pos : h

1310-- |

1311-- Collect errors in in parallel

1312--

1313−parU :: (MonadError MultipleErrors m, Functor m) => [a] -> (a -> m b) -> m [b]

1313+parU :: (MonadError MultipleErrors m) => [a] -> (a -> m b) -> m [b]

1314parU xs f = forM xs (withError . f) >>= collectErrors

1315 where

1316− withError :: (MonadError MultipleErrors m, Functor m) => m a -> m (Either MultipleErrors a)

1316+ withError :: (MonadError MultipleErrors m) => m a -> m (Either MultipleErrors a)

1317 withError u = catchError (Right <$> u) (return . Left)

1318

1319− collectErrors :: (MonadError MultipleErrors m, Functor m) => [Either MultipleErrors a] -> m [a]

1319+ collectErrors :: (MonadError MultipleErrors m) => [Either MultipleErrors a] -> m [a]

1320 collectErrors es = case lefts es of

1321 [] -> return $ rights es

1322 errs -> throwError $ fold errs

src/Language/PureScript/Ide.hs+3−3

@@ -74,12 +74,12 @@ findType :: (PscIde m, MonadLogger m) =>

74findType search filters =

75 CompletionResult . getExactMatches search filters <$> getAllModulesWithReexports

76

77−findPursuitCompletions :: (Applicative m, MonadIO m, MonadLogger m) =>

77+findPursuitCompletions :: (MonadIO m, MonadLogger m) =>

78 PursuitQuery -> m Success

79findPursuitCompletions (PursuitQuery q) =

80 PursuitResult <$> liftIO (searchPursuitForDeclarations q)

81

82−findPursuitPackages :: (Applicative m, MonadIO m, MonadLogger m) =>

82+findPursuitPackages :: (MonadIO m, MonadLogger m) =>

83 PursuitQuery -> m Success

84findPursuitPackages (PursuitQuery q) =

85 PursuitResult <$> liftIO (findPackagesForModuleIdent q)

@@ -118,7 +118,7 @@ caseSplit l b e csa t = do

118addClause :: Text -> CS.WildcardAnnotations -> Success

119addClause t wca = MultilineTextResult (CS.addClause t wca)

120

121−importsForFile :: (Applicative m, MonadIO m, MonadLogger m, MonadError PscIdeError m) =>

121+importsForFile :: (MonadIO m, MonadLogger m, MonadError PscIdeError m) =>

122 FilePath -> m Success

123importsForFile fp = do

124 imports <- getImportsForFile fp

src/Language/PureScript/Ide/CaseSplit.hs+1−1

@@ -78,7 +78,7 @@ findTypeDeclaration' t ExternsFile{..} =

78 EDType tn _ _ -> tn == t

79 _ -> False) efDeclarations

80

81−splitTypeConstructor :: (Applicative m, MonadError PscIdeError m) =>

81+splitTypeConstructor :: (MonadError PscIdeError m) =>

82 Type -> m (ProperName 'TypeName, [Type])

83splitTypeConstructor = go []

84 where

src/Language/PureScript/Ide/Externs.hs+1−1

@@ -34,7 +34,7 @@ import Language.PureScript.Ide.Types

34import qualified Language.PureScript.Names as N

35import qualified Language.PureScript.Pretty as PP

36

37−readExternFile :: (Applicative m, MonadIO m, MonadError PscIdeError m) =>

37+readExternFile :: (MonadIO m, MonadError PscIdeError m) =>

38 FilePath -> m PE.ExternsFile

39readExternFile fp = do

40 parseResult <- liftIO (decodeT <$> T.readFile fp)

src/Language/PureScript/Ide/SourceFile.hs+3−4

@@ -3,8 +3,7 @@

3{-# LANGUAGE OverloadedStrings #-}

4module Language.PureScript.Ide.SourceFile where

5

6−import Prelude ()

6+import Prelude

7−import Prelude.Compat

8

7

9import Control.Monad.Error.Class

8import Control.Monad.Error.Class

10import Control.Monad.IO.Class

9import Control.Monad.IO.Class

@@ -22,7 +21,7 @@ import qualified Language.PureScript.Names as N

22import qualified Language.PureScript.Parser as P

21import qualified Language.PureScript.Parser as P

23import System.Directory

22import System.Directory

24

23

25−parseModuleFromFile :: (Applicative m, MonadIO m, MonadError PscIdeError m) =>

24+parseModuleFromFile :: (MonadIO m, MonadError PscIdeError m) =>

26 FilePath -> m D.Module

25 FilePath -> m D.Module

27parseModuleFromFile fp = do

26parseModuleFromFile fp = do

28 exists <- liftIO (doesFileExist fp)

27 exists <- liftIO (doesFileExist fp)

@@ -46,7 +45,7 @@ getImports (D.Module _ _ _ declarations _) =

46 isImport (D.PositionedDeclaration _ _ (i@D.ImportDeclaration{})) = Just i

45 isImport (D.PositionedDeclaration _ _ (i@D.ImportDeclaration{})) = Just i

47 isImport _ = Nothing

46 isImport _ = Nothing

48

47

49−getImportsForFile :: (Applicative m, MonadIO m, MonadError PscIdeError m) =>

48+getImportsForFile :: (MonadIO m, MonadError PscIdeError m) =>

50 FilePath -> m [ModuleImport]

49 FilePath -> m [ModuleImport]

51getImportsForFile fp = do

50getImportsForFile fp = do

52 module' <- parseModuleFromFile fp

51 module' <- parseModuleFromFile fp

src/Language/PureScript/Ide/State.hs+7−7

@@ -25,38 +25,38 @@ import Language.PureScript.Ide.Reexports

25import Language.PureScript.Ide.Types

26import Language.PureScript.Names

27

28−getPscIdeState :: (PscIde m, Functor m) =>

28+getPscIdeState :: (PscIde m) =>

29 m (M.Map ModuleIdent [ExternDecl])

30getPscIdeState = do

31 stateVar <- envStateVar <$> ask

32 liftIO $ pscStateModules <$> readTVarIO stateVar

33

34−getExternFiles :: (PscIde m, Functor m) =>

34+getExternFiles :: (PscIde m) =>

35 m (M.Map ModuleName ExternsFile)

36getExternFiles = do

37 stateVar <- envStateVar <$> ask

38 liftIO (externsFiles <$> readTVarIO stateVar)

39

40−getAllDecls :: (PscIde m, Functor m) => m [ExternDecl]

40+getAllDecls :: (PscIde m) => m [ExternDecl]

41getAllDecls = concat <$> getPscIdeState

42

43−getAllModules :: (PscIde m, Functor m) => m [Module]

43+getAllModules :: (PscIde m) => m [Module]

44getAllModules = M.toList <$> getPscIdeState

45

46−getAllModulesWithReexports :: (PscIde m, MonadLogger m, Applicative m) =>

46+getAllModulesWithReexports :: (PscIde m, MonadLogger m) =>

47 m [Module]

48getAllModulesWithReexports = do

49 mis <- M.keys <$> getPscIdeState

50 ms <- traverse getModuleWithReexports mis

51 pure (catMaybes ms)

52

53−getModule :: (PscIde m, MonadLogger m, Applicative m) =>

53+getModule :: (PscIde m, MonadLogger m) =>

54 ModuleIdent -> m (Maybe Module)

55getModule m = do

56 modules <- getPscIdeState

57 pure ((m,) <$> M.lookup m modules)

58

59−getModuleWithReexports :: (PscIde m, MonadLogger m, Applicative m) =>

59+getModuleWithReexports :: (PscIde m, MonadLogger m) =>

60 ModuleIdent -> m (Maybe Module)

61getModuleWithReexports mi = do

62 m <- getModule mi

src/Language/PureScript/Ide/Types.hs+1−1

@@ -79,7 +79,7 @@ data PscIdeEnvironment =

79 , envConfiguration :: Configuration

80 }

81

82−type PscIde m = (Applicative m, MonadIO m, MonadReader PscIdeEnvironment m)

82+type PscIde m = (MonadIO m, MonadReader PscIdeEnvironment m)

83

84data PscIdeState =

85 PscIdeState

src/Language/PureScript/Kinds.hs+1−1

@@ -42,7 +42,7 @@ everywhereOnKinds f = go

42 go (FunKind k1 k2) = f (FunKind (go k1) (go k2))

43 go other = f other

44

45−everywhereOnKindsM :: (Functor m, Applicative m, Monad m) => (Kind -> m Kind) -> Kind -> m Kind

45+everywhereOnKindsM :: Monad m => (Kind -> m Kind) -> Kind -> m Kind

46everywhereOnKindsM f = go

47 where

48 go (Row k1) = (Row <$> go k1) >>= f

src/Language/PureScript/Linter.hs+1−1

@@ -29,7 +29,7 @@ import Language.PureScript.Linter.Imports as L

29-- | Lint the PureScript AST.

30-- |

31-- | Right now, this pass only performs a shadowing check.

32−lint :: forall m. (Applicative m, MonadWriter MultipleErrors m) => Module -> m ()

32+lint :: forall m. (MonadWriter MultipleErrors m) => Module -> m ()

33lint (Module _ _ mn ds _) = censor (addHint (ErrorInModule mn)) $ mapM_ lintDeclaration ds

34 where

35 moduleNames :: S.Set Ident

src/Language/PureScript/Linter/Exhaustive.hs+2−2

@@ -261,7 +261,7 @@ checkExhaustive hasConstraint env mn numArgs cas = makeResult . first nub $ fold

261-- |

262-- Exhaustivity checking over a list of declarations

263--

264−checkExhaustiveDecls :: forall m. (Applicative m, MonadWriter MultipleErrors m) => Environment -> ModuleName -> [Declaration] -> m ()

264+checkExhaustiveDecls :: forall m. MonadWriter MultipleErrors m => Environment -> ModuleName -> [Declaration] -> m ()

265checkExhaustiveDecls env mn = mapM_ onDecl

266 where

267 onDecl :: Declaration -> m ()

@@ -310,5 +310,5 @@ checkExhaustiveDecls env mn = mapM_ onDecl

310-- |

311-- Exhaustivity checking over a single module

312--

313−checkExhaustiveModule :: forall m. (Applicative m, MonadWriter MultipleErrors m) => Environment -> Module -> m ()

313+checkExhaustiveModule :: forall m. MonadWriter MultipleErrors m => Environment -> Module -> m ()

314checkExhaustiveModule env (Module _ _ mn ds _) = censor (addHint (ErrorInModule mn)) $ checkExhaustiveDecls env mn ds

src/Language/PureScript/Linter/Imports.hs+2−2

@@ -70,7 +70,7 @@ type UsedImports = M.Map ModuleName [Name]

70--

71lintImports

72 :: forall m

73− . (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

73+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

74 => Module

75 -> Env

76 -> UsedImports

@@ -170,7 +170,7 @@ lintImports (Module _ _ mn mdecls mexports) env usedImps = do

170

171lintImportDecl

172 :: forall m

173− . (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

173+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

174 => Env

175 -> ModuleName

176 -> Maybe ModuleName

src/Language/PureScript/Make.hs+1−1

@@ -145,7 +145,7 @@ data RebuildPolicy

145-- If timestamps have not changed, the externs file can be used to provide the module's types without

146-- having to typecheck the module again.

147--

148−make :: forall m. (Functor m, Applicative m, Monad m, MonadBaseControl IO m, MonadReader Options m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

148+make :: forall m. (Monad m, MonadBaseControl IO m, MonadReader Options m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

149 => MakeActions m

150 -> [Module]

151 -> m Environment

src/Language/PureScript/Parser/Declarations.hs+1−1

@@ -261,7 +261,7 @@ parseModule = do

261 return $ Module ss comments name decls exports

262

263-- | Parse a collection of modules in parallel

264−parseModulesFromFiles :: forall m k. (MonadError MultipleErrors m, Functor m) =>

264+parseModulesFromFiles :: forall m k. (MonadError MultipleErrors m) =>

265 (k -> FilePath) -> [(k, String)] -> m [(k, Module)]

266parseModulesFromFiles toFilePath input = do

267 modules <- flip parU id $ map wrapError $ inParallel $ flip map input $ \(k, content) -> do

src/Language/PureScript/Parser/JS.hs+1−1

@@ -36,7 +36,7 @@ import qualified Text.Parsec as PS

36

37type ForeignJS = String

38

39−parseForeignModulesFromFiles :: (Functor m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

39+parseForeignModulesFromFiles :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

40 => [(FilePath, ForeignJS)]

41 -> m (M.Map ModuleName FilePath)

42parseForeignModulesFromFiles files = do

src/Language/PureScript/Sugar.hs+1−1

@@ -63,7 +63,7 @@ import Language.PureScript.Sugar.TypeDeclarations as S

63--

64-- * Group mutually recursive value and data declarations into binding groups.

65--

66−desugar :: (Applicative m, MonadSupply m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => [ExternsFile] -> [Module] -> m [Module]

66+desugar :: (MonadSupply m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => [ExternsFile] -> [Module] -> m [Module]

67desugar externs =

68 map removeSignedLiterals

69 >>> traverse desugarObjectConstructors

src/Language/PureScript/Sugar/BindingGroups.hs+3−3

@@ -35,7 +35,7 @@ import Language.PureScript.Types

35-- Replace all sets of mutually-recursive declarations in a module with binding groups

36--

37createBindingGroupsModule

38− :: (Functor m, Applicative m, MonadError MultipleErrors m)

38+ :: (MonadError MultipleErrors m)

39 => [Module]

40 -> m [Module]

41createBindingGroupsModule =

@@ -52,7 +52,7 @@ collapseBindingGroupsModule =

52

53createBindingGroups

54 :: forall m

55− . (Functor m, Applicative m, MonadError MultipleErrors m)

55+ . (MonadError MultipleErrors m)

56 => ModuleName

57 -> [Declaration]

58 -> m [Declaration]

@@ -171,7 +171,7 @@ getTypeName _ = internalError "Expected DataDeclaration"

171--

172toBindingGroup

173 :: forall m

174− . (Functor m, MonadError MultipleErrors m)

174+ . (MonadError MultipleErrors m)

175 => ModuleName

176 -> SCC Declaration

177 -> m Declaration

src/Language/PureScript/Sugar/CaseDeclarations.hs+6−6

@@ -36,7 +36,7 @@ isLeft (Right _) = False

36-- |

37-- Replace all top-level binders in a module with case expressions.

38--

39−desugarCasesModule :: (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => [Module] -> m [Module]

39+desugarCasesModule :: (MonadSupply m, MonadError MultipleErrors m) => [Module] -> m [Module]

40desugarCasesModule ms = forM ms $ \(Module ss coms name ds exps) ->

41 rethrow (addHint (ErrorInModule name)) $

42 Module ss coms name <$> (desugarCases <=< desugarAbs <=< validateCases $ ds) <*> pure exps

@@ -44,7 +44,7 @@ desugarCasesModule ms = forM ms $ \(Module ss coms name ds exps) ->

44-- |

45-- Validates that case head and binder lengths match.

46--

47−validateCases :: forall m. (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]

47+validateCases :: forall m. (MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]

48validateCases = flip parU f

49 where

50 (f, _, _) = everywhereOnValuesM return validate return

@@ -69,7 +69,7 @@ validateCases = flip parU f

69 positionedBinder (PositionedBinder p _ _) = Just p

70 positionedBinder _ = Nothing

71

72−desugarAbs :: forall m. (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]

72+desugarAbs :: forall m. (MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]

73desugarAbs = flip parU f

74 where

75 (f, _, _) = everywhereOnValuesM return replace return

@@ -83,7 +83,7 @@ desugarAbs = flip parU f

83-- |

84-- Replace all top-level binders with case expressions.

85--

86−desugarCases :: forall m. (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]

86+desugarCases :: forall m. (MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]

87desugarCases = desugarRest <=< fmap join . flip parU toDecls . groupBy inSameGroup

88 where

89 desugarRest :: [Declaration] -> m [Declaration]

@@ -109,7 +109,7 @@ inSameGroup (PositionedDeclaration _ _ d1) d2 = inSameGroup d1 d2

109inSameGroup d1 (PositionedDeclaration _ _ d2) = inSameGroup d1 d2

110inSameGroup _ _ = False

111

112−toDecls :: forall m. (Functor m, Applicative m, Monad m, MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]

112+toDecls :: forall m. (MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]

113toDecls [ValueDeclaration ident nameKind bs (Right val)] | all isVarBinder bs = do

114 args <- mapM fromVarBinder bs

115 let body = foldr (Abs . Left) val args

@@ -147,7 +147,7 @@ toTuple (ValueDeclaration _ _ bs result) = (bs, result)

147toTuple (PositionedDeclaration _ _ d) = toTuple d

148toTuple _ = internalError "Not a value declaration"

149

150−makeCaseDeclaration :: forall m. (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => Ident -> [([Binder], Either [(Guard, Expr)] Expr)] -> m Declaration

150+makeCaseDeclaration :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Ident -> [([Binder], Either [(Guard, Expr)] Expr)] -> m Declaration

151makeCaseDeclaration ident alternatives = do

152 let namedArgs = map findName . fst <$> alternatives

153 argNames = foldl1 resolveNames namedArgs

src/Language/PureScript/Sugar/DoNotation.hs+2−2

@@ -26,10 +26,10 @@ import Control.Monad.Supply.Class

26-- Replace all @DoNotationBind@ and @DoNotationValue@ constructors with applications of the Prelude.bind function,

27-- and all @DoNotationLet@ constructors with let expressions.

28--

29−desugarDoModule :: forall m. (Applicative m, MonadSupply m, MonadError MultipleErrors m) => Module -> m Module

29+desugarDoModule :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Module -> m Module

30desugarDoModule (Module ss coms mn ds exts) = Module ss coms mn <$> parU ds desugarDo <*> pure exts

31

32−desugarDo :: forall m. (Applicative m, MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration

32+desugarDo :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration

33desugarDo (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> rethrowWithPosition pos (desugarDo d)

34desugarDo d =

35 let (f, _, _) = everywhereOnValuesM return replace return

src/Language/PureScript/Sugar/Names.hs+4−4

@@ -44,13 +44,13 @@ import Language.PureScript.Linter.Imports

44-- Replaces all local names with qualified names within a list of modules. The

45-- modules should be topologically sorted beforehand.

46--

47−desugarImports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => [ExternsFile] -> [Module] -> m [Module]

47+desugarImports :: forall m. (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => [ExternsFile] -> [Module] -> m [Module]

48desugarImports externs modules =

49 fmap snd (desugarImportsWithEnv externs modules)

50

51desugarImportsWithEnv

52 :: forall m

53− . (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

53+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

54 => [ExternsFile]

55 -> [Module]

56 -> m (Env, [Module])

@@ -141,7 +141,7 @@ elaborateExports exps (Module ss coms mn decls refs) =

141--

142renameInModule

143 :: forall m

144− . (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadState UsedImports m)

144+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadState UsedImports m)

145 => Env

146 -> Imports

147 -> Module

@@ -334,7 +334,7 @@ renameInModule env imports (Module ss coms mn decls exps) =

334--

335updateExportRefs

336 :: forall m

337− . (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

337+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

338 => Module

339 -> m Module

340updateExportRefs (Module ss coms mn decls exps) =

src/Language/PureScript/Sugar/Names/Exports.hs+3−3

@@ -31,7 +31,7 @@ import Language.PureScript.Sugar.Names.Env

31-- |

32-- Finds all exportable members of a module, disregarding any explicit exports.

33--

34−findExportable :: forall m. (Applicative m, MonadError MultipleErrors m) => Module -> m Exports

34+findExportable :: forall m. (MonadError MultipleErrors m) => Module -> m Exports

35findExportable (Module _ _ mn ds _) =

36 rethrow (addHint (ErrorInModule mn)) $ foldM updateExports nullExports ds

37 where

@@ -56,7 +56,7 @@ findExportable (Module _ _ mn ds _) =

56-- Resolves the exports for a module, filtering out members that have not been

57-- exported and elaborating re-exports of other modules.

58--

59−resolveExports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Env -> ModuleName -> Imports -> Exports -> [DeclarationRef] -> m Exports

59+resolveExports :: forall m. (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Env -> ModuleName -> Imports -> Exports -> [DeclarationRef] -> m Exports

60resolveExports env mn imps exps refs =

61 rethrow (addHint (ErrorInModule mn)) $ do

62 filtered <- filterModule mn exps refs

@@ -199,7 +199,7 @@ resolveExports env mn imps exps refs =

199--

200filterModule

201 :: forall m

202− . (Applicative m, MonadError MultipleErrors m)

202+ . (MonadError MultipleErrors m)

203 => ModuleName

204 -> Exports

205 -> [DeclarationRef]

src/Language/PureScript/Sugar/Names/Imports.hs+4−4

@@ -37,7 +37,7 @@ import Language.PureScript.Sugar.Names.Env

37--

38findImports

39 :: forall m

40− . (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

40+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

41 => [Declaration]

42 -> m (M.Map ModuleName [(Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)])

43findImports = foldM (go Nothing) M.empty

@@ -56,7 +56,7 @@ type ImportDef = (Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)

56--

57resolveImports

58 :: forall m

59− . (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

59+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

60 => Env

61 -> Module

62 -> m (Module, Imports)

@@ -160,7 +160,7 @@ resolveImports env (Module ss coms currentModule decls exps) =

160-- | Constructs a set of imports for a single module import.

161resolveModuleImport

162 :: forall m

163− . (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

163+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

164 => Env

165 -> Imports

166 -> (ModuleName, [(Maybe SourceSpan, Maybe ImportDeclarationType, Maybe ModuleName)])

@@ -187,7 +187,7 @@ resolveModuleImport env ie (mn, imps) = foldM go ie imps

187--

188resolveImport

189 :: forall m

190− . (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

190+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

191 => ModuleName

192 -> Exports

193 -> Imports

src/Language/PureScript/Sugar/ObjectWildcards.hs+1−1

@@ -21,7 +21,7 @@ import Language.PureScript.Names

21

22desugarObjectConstructors

23 :: forall m

24− . (Applicative m, MonadSupply m, MonadError MultipleErrors m)

24+ . (MonadSupply m, MonadError MultipleErrors m)

25 => Module

26 -> m Module

27desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> mapM desugarDecl ds <*> pure exts

src/Language/PureScript/Sugar/Operators.hs+3−3

@@ -57,7 +57,7 @@ type AliasName = Either (Qualified Ident) (Qualified (ProperName 'ConstructorNam

57--

58rebracket

59 :: forall m

60− . (Applicative m, MonadError MultipleErrors m)

60+ . (MonadError MultipleErrors m)

61 => [ExternsFile]

62 -> [Module]

63 -> m [Module]

@@ -116,7 +116,7 @@ removeSignedLiterals (Module ss coms mn ds exts) = Module ss coms mn (map f' ds)

116 go other = other

117

118rebracketModule

119− :: (Applicative m, MonadError MultipleErrors m)

119+ :: (MonadError MultipleErrors m)

120 => [[(Qualified Ident, Associativity)]]

121 -> Module

122 -> m Module

@@ -178,7 +178,7 @@ customOperatorTable fixities =

178

179desugarOperatorSections

180 :: forall m

181− . (Applicative m, MonadSupply m, MonadError MultipleErrors m)

181+ . (MonadSupply m, MonadError MultipleErrors m)

182 => Module

183 -> m Module

184desugarOperatorSections (Module ss coms mn ds exts) =

src/Language/PureScript/Sugar/TypeClasses.hs+4−4

@@ -45,7 +45,7 @@ type Desugar = StateT MemberMap

45-- instance dictionary expressions.

46--

47desugarTypeClasses

48− :: (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m)

48+ :: (MonadSupply m, MonadError MultipleErrors m)

49 => [ExternsFile]

50 -> [Module]

51 -> m [Module]

@@ -62,7 +62,7 @@ desugarTypeClasses externs = flip evalStateT initialState . traverse desugarModu

62 fromExternsDecl _ _ = Nothing

63

64desugarModule

65− :: (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m)

65+ :: (MonadSupply m, MonadError MultipleErrors m)

66 => Module

67 -> Desugar m Module

68desugarModule (Module ss coms name decls (Just exps)) = do

@@ -171,7 +171,7 @@ desugarModule _ = internalError "Exports should have been elaborated in name des

171-- };

172-}

173desugarDecl

174− :: (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m)

174+ :: (MonadSupply m, MonadError MultipleErrors m)

175 => ModuleName

176 -> [DeclarationRef]

177 -> Declaration

@@ -259,7 +259,7 @@ unit = TypeApp tyObject REmpty

259

260typeInstanceDictionaryDeclaration

261 :: forall m

262− . (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m)

262+ . (MonadSupply m, MonadError MultipleErrors m)

263 => Ident

264 -> ModuleName

265 -> [Constraint]

src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+6−6

@@ -32,7 +32,7 @@ import qualified Language.PureScript.Constants as C

32

33-- | Elaborates deriving instance declarations by code generation.

34deriveInstances

35− :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadSupply m)

35+ :: (MonadError MultipleErrors m, MonadSupply m)

36 => Module

37 -> m Module

38deriveInstances (Module ss coms mn ds exts) = Module ss coms mn <$> mapM (deriveInstance mn ds) ds <*> pure exts

@@ -40,7 +40,7 @@ deriveInstances (Module ss coms mn ds exts) = Module ss coms mn <$> mapM (derive

40-- | Takes a declaration, and if the declaration is a deriving TypeInstanceDeclaration,

41-- elaborates that into an instance declaration via code generation.

42deriveInstance

43− :: (Functor m, MonadError MultipleErrors m, MonadSupply m)

43+ :: (MonadError MultipleErrors m, MonadSupply m)

44 => ModuleName

45 -> [Declaration]

46 -> Declaration

@@ -82,7 +82,7 @@ typesProxy :: ModuleName

82typesProxy = ModuleName [ ProperName "Type", ProperName "Proxy" ]

83

84deriveGeneric

85− :: forall m. (Functor m, MonadError MultipleErrors m, MonadSupply m)

85+ :: forall m. (MonadError MultipleErrors m, MonadSupply m)

86 => ModuleName

87 -> [Declaration]

88 -> ProperName 'TypeName

@@ -246,7 +246,7 @@ deriveGeneric mn ds tyConNm dargs = do

246 mkGenVar = mkVarMn (Just (ModuleName [ProperName "Data", ProperName C.generic]))

247

248deriveEq ::

249− forall m. (Functor m, MonadError MultipleErrors m, MonadSupply m)

249+ forall m. (MonadError MultipleErrors m, MonadSupply m)

250 => ModuleName

251 -> [Declaration]

252 -> ProperName 'TypeName

@@ -298,7 +298,7 @@ deriveEq mn ds tyConNm = do

298 toEqTest l r _ = preludeEq l r

299

300deriveOrd ::

301− forall m. (Functor m, MonadError MultipleErrors m, MonadSupply m)

301+ forall m. (MonadError MultipleErrors m, MonadSupply m)

302 => ModuleName

303 -> [Declaration]

304 -> ProperName 'TypeName

@@ -377,7 +377,7 @@ deriveOrd mn ds tyConNm = do

377 toOrdering l r _ = preludeCompare l r

378

379findTypeDecl

380− :: (Functor m, MonadError MultipleErrors m)

380+ :: (MonadError MultipleErrors m)

381 => ProperName 'TypeName

382 -> [Declaration]

383 -> m Declaration

src/Language/PureScript/Sugar/TypeDeclarations.hs+1−1

@@ -36,7 +36,7 @@ import Language.PureScript.Traversals

36-- |

37-- Replace all top level type declarations in a module with type annotations

38--

39−desugarTypeDeclarationsModule :: forall m. (Functor m, Applicative m, MonadError MultipleErrors m) => [Module] -> m [Module]

39+desugarTypeDeclarationsModule :: forall m. (MonadError MultipleErrors m) => [Module] -> m [Module]

40desugarTypeDeclarationsModule ms = forM ms $ \(Module ss coms name ds exps) ->

41 rethrow (addHint (ErrorInModule name)) $

42 Module ss coms name <$> desugarTypeDeclarations ds <*> pure exps

src/Language/PureScript/TypeChecker.hs+12−12

@@ -40,7 +40,7 @@ import Language.PureScript.TypeClassDictionaries

40import Language.PureScript.Types

41

42addDataType

43− :: (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

43+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

44 => ModuleName

45 -> DataDeclType

46 -> ProperName 'TypeName

@@ -56,7 +56,7 @@ addDataType moduleName dtype name args dctors ctorKind = do

56 addDataConstructor moduleName dtype name (map fst args) dctor tys

57

58addDataConstructor

59− :: (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

59+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

60 => ModuleName

61 -> DataDeclType

62 -> ProperName 'TypeName

@@ -74,7 +74,7 @@ addDataConstructor moduleName dtype name args dctor tys = do

74 putEnv $ env { dataConstructors = M.insert (Qualified (Just moduleName) dctor) (dtype, name, polyType, fields) (dataConstructors env) }

75

76addTypeSynonym

77− :: (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

77+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

78 => ModuleName

79 -> ProperName 'TypeName

80 -> [(String, Maybe Kind)]

@@ -88,7 +88,7 @@ addTypeSynonym moduleName name args ty kind = do

88 , typeSynonyms = M.insert (Qualified (Just moduleName) name) (args, ty) (typeSynonyms env) }

89

90valueIsNotDefined

91− :: (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

91+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

92 => ModuleName

93 -> Ident

94 -> m ()

@@ -99,7 +99,7 @@ valueIsNotDefined moduleName name = do

99 Nothing -> return ()

100

101addValue

102− :: (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

102+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

103 => ModuleName

104 -> Ident

105 -> Type

@@ -110,7 +110,7 @@ addValue moduleName name ty nameKind = do

110 putEnv (env { names = M.insert (moduleName, name) (ty, nameKind, Defined) (names env) })

111

112addTypeClass

113− :: (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

113+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

114 => ModuleName

115 -> ProperName 'ClassName

116 -> [(String, Maybe Kind)]

@@ -126,7 +126,7 @@ addTypeClass moduleName pn args implies ds =

126 toPair _ = internalError "Invalid declaration in TypeClassDeclaration"

127

128addTypeClassDictionaries

129− :: (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

129+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

130 => Maybe ModuleName

131 -> M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope)

132 -> m ()

@@ -135,7 +135,7 @@ addTypeClassDictionaries mn entries =

135 where insertState st = M.insertWith (M.unionWith M.union) mn entries (typeClassDictionaries . checkEnv $ st)

136

137checkDuplicateTypeArguments

138− :: (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

138+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

139 => [String]

140 -> m ()

141checkDuplicateTypeArguments args = for_ firstDup $ \dup ->

@@ -145,7 +145,7 @@ checkDuplicateTypeArguments args = for_ firstDup $ \dup ->

145 firstDup = listToMaybe $ args \\ nub args

146

147checkTypeClassInstance

148− :: (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

148+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

149 => ModuleName

150 -> Type

151 -> m ()

@@ -161,7 +161,7 @@ checkTypeClassInstance _ ty = throwError . errorMessage $ InvalidInstanceHead ty

161-- Check that type synonyms are fully-applied in a type

162--

163checkTypeSynonyms

164− :: (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

164+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

165 => Type

166 -> m ()

167checkTypeSynonyms = void . replaceAllTypeSynonyms

@@ -181,7 +181,7 @@ checkTypeSynonyms = void . replaceAllTypeSynonyms

181--

182typeCheckAll

183 :: forall m

184− . (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

184+ . (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

185 => ModuleName

186 -> [DeclarationRef]

187 -> [Declaration]

@@ -343,7 +343,7 @@ typeCheckAll moduleName _ ds = traverse go ds <* traverse_ checkFixities ds

343--

344typeCheckModule

345 :: forall m

346− . (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

346+ . (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

347 => Module

348 -> m Module

349typeCheckModule (Module _ _ _ _ Nothing) = internalError "exports should have been elaborated"

src/Language/PureScript/TypeChecker/Entailment.hs+1−1

@@ -34,7 +34,7 @@ import qualified Language.PureScript.Constants as C

34--

35entails

36 :: forall m

37− . (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

37+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)

38 => ModuleName

39 -> M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope))

40 -> Constraint

src/Language/PureScript/TypeChecker/Kinds.hs+11−11

@@ -43,7 +43,7 @@ freshKind = do

43

44-- | Update the substitution to solve a kind constraint

45solveKind

46− :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m)

46+ :: (MonadError MultipleErrors m, MonadState CheckState m)

47 => Int

48 -> Kind

49 -> m ()

@@ -68,7 +68,7 @@ substituteKind sub = everywhereOnKinds go

68

69-- | Make sure that an unknown does not occur in a kind

70occursCheck

71− :: (Functor m, Applicative m, MonadError MultipleErrors m)

71+ :: (MonadError MultipleErrors m)

72 => Int

73 -> Kind

74 -> m ()

@@ -80,7 +80,7 @@ occursCheck u k = void $ everywhereOnKindsM go k

80

81-- | Unify two kinds

82unifyKinds

83− :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m)

83+ :: (MonadError MultipleErrors m, MonadState CheckState m)

84 => Kind

85 -> Kind

86 -> m ()

@@ -101,14 +101,14 @@ unifyKinds k1 k2 = do

101

102-- | Infer the kind of a single type

103kindOf

104− :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m)

104+ :: (MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m)

105 => Type

106 -> m Kind

107kindOf ty = fst <$> kindOfWithScopedVars ty

108

109-- | Infer the kind of a single type, returning the kinds of any scoped type variables

110kindOfWithScopedVars ::

111− (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m) =>

111+ (MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m) =>

112 Type ->

113 m (Kind, [(String, Kind)])

114kindOfWithScopedVars ty =

@@ -121,7 +121,7 @@ kindOfWithScopedVars ty =

121

122-- | Infer the kind of a type constructor with a collection of arguments and a collection of associated data constructors

123kindsOf

124− :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m)

124+ :: (MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m)

125 => Bool

126 -> ModuleName

127 -> ProperName 'TypeName

@@ -139,7 +139,7 @@ kindsOf isData moduleName name args ts = fmap tidyUp . liftUnify $ do

139 tidyUp (k, sub) = starIfUnknown $ substituteKind sub k

140

141freshKindVar

142− :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m)

142+ :: (MonadError MultipleErrors m, MonadState CheckState m)

143 => (String, Maybe Kind)

144 -> Kind

145 -> m (ProperName 'TypeName, Kind)

@@ -150,7 +150,7 @@ freshKindVar (arg, Just kind') kind = do

150

151-- | Simultaneously infer the kinds of several mutually recursive type constructors

152kindsOfAll

153− :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m)

153+ :: (MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m)

154 => ModuleName

155 -> [(ProperName 'TypeName, [(String, Maybe Kind)], Type)]

156 -> [(ProperName 'TypeName, [(String, Maybe Kind)], [Type])]

@@ -178,7 +178,7 @@ kindsOfAll moduleName syns tys = fmap tidyUp . liftUnify $ do

178

179-- | Solve the set of kind constraints associated with the data constructors for a type constructor

180solveTypes

181− :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m)

181+ :: (MonadError MultipleErrors m, MonadState CheckState m)

182 => Bool

183 -> [Type]

184 -> [Kind]

@@ -202,14 +202,14 @@ starIfUnknown k = k

202

203-- | Infer a kind for a type

204infer

205− :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m)

205+ :: (MonadError MultipleErrors m, MonadState CheckState m)

206 => Type

207 -> m (Kind, [(String, Kind)])

208infer ty = rethrow (addHint (ErrorCheckingKind ty)) $ infer' ty

209

210infer'

211 :: forall m

212− . (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m)

212+ . (MonadError MultipleErrors m, MonadState CheckState m)

213 => Type

214 -> m (Kind, [(String, Kind)])

215infer' (ForAll ident ty _) = do

src/Language/PureScript/TypeChecker/Monad.hs+15−15

@@ -84,7 +84,7 @@ bindTypes newNames action = do

84

85-- | Temporarily bind a collection of names to types

86withScopedTypeVars

87− :: (Functor m, Applicative m, MonadState CheckState m, MonadWriter MultipleErrors m)

87+ :: (MonadState CheckState m, MonadWriter MultipleErrors m)

88 => ModuleName

89 -> [(String, Kind)]

90 -> m a

@@ -112,20 +112,20 @@ withTypeClassDictionaries entries action = do

112

113-- | Get the currently available map of type class dictionaries

114getTypeClassDictionaries

115− :: (Functor m, MonadState CheckState m)

115+ :: (MonadState CheckState m)

116 => m (M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope)))

117getTypeClassDictionaries = typeClassDictionaries . checkEnv <$> get

118

119-- | Lookup type class dictionaries in a module.

120lookupTypeClassDictionaries

121− :: (Functor m, MonadState CheckState m)

121+ :: (MonadState CheckState m)

122 => Maybe ModuleName

123 -> m (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope))

124lookupTypeClassDictionaries mn = fromMaybe M.empty . M.lookup mn . typeClassDictionaries . checkEnv <$> get

125

126-- | Temporarily bind a collection of names to local variables

127bindLocalVariables

128− :: (Functor m, MonadState CheckState m)

128+ :: (MonadState CheckState m)

129 => ModuleName

130 -> [(Ident, Type, NameVisibility)]

131 -> m a

@@ -135,7 +135,7 @@ bindLocalVariables moduleName bindings =

135

136-- | Temporarily bind a collection of names to local type variables

137bindLocalTypeVariables

138− :: (Functor m, MonadState CheckState m)

138+ :: (MonadState CheckState m)

139 => ModuleName

140 -> [(ProperName 'TypeName, Kind)]

141 -> m a

@@ -144,15 +144,15 @@ bindLocalTypeVariables moduleName bindings =

144 bindTypes (M.fromList $ flip map bindings $ \(pn, kind) -> (Qualified (Just moduleName) pn, (kind, LocalTypeVariable)))

145

146-- | Update the visibility of all names to Defined

147−makeBindingGroupVisible :: (Functor m, MonadState CheckState m) => m ()

147+makeBindingGroupVisible :: (MonadState CheckState m) => m ()

148makeBindingGroupVisible = modifyEnv $ \e -> e { names = M.map (\(ty, nk, _) -> (ty, nk, Defined)) (names e) }

149

150-- | Update the visibility of all names to Defined in the scope of the provided action

151−withBindingGroupVisible :: (Functor m, MonadState CheckState m) => m a -> m a

151+withBindingGroupVisible :: (MonadState CheckState m) => m a -> m a

152withBindingGroupVisible action = preservingNames $ makeBindingGroupVisible >> action

153

154-- | Perform an action while preserving the names from the @Environment@.

155−preservingNames :: (Functor m, MonadState CheckState m) => m a -> m a

155+preservingNames :: (MonadState CheckState m) => m a -> m a

156preservingNames action = do

157 orig <- gets (names . checkEnv)

158 a <- action

@@ -161,7 +161,7 @@ preservingNames action = do

161

162-- | Lookup the type of a value by name in the @Environment@

163lookupVariable

164− :: (e ~ MultipleErrors, Functor m, MonadState CheckState m, MonadError e m)

164+ :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m)

165 => ModuleName

166 -> Qualified Ident

167 -> m Type

@@ -173,7 +173,7 @@ lookupVariable currentModule (Qualified moduleName var) = do

173

174-- | Lookup the visibility of a value by name in the @Environment@

175getVisibility

176− :: (e ~ MultipleErrors, Functor m, MonadState CheckState m, MonadError e m)

176+ :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m)

177 => ModuleName

178 -> Qualified Ident

179 -> m NameVisibility

@@ -185,7 +185,7 @@ getVisibility currentModule (Qualified moduleName var) = do

185

186-- | Assert that a name is visible

187checkVisibility

188− :: (e ~ MultipleErrors, Functor m, MonadState CheckState m, MonadError e m)

188+ :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m)

189 => ModuleName

190 -> Qualified Ident

191 -> m ()

@@ -197,7 +197,7 @@ checkVisibility currentModule name@(Qualified _ var) = do

197

198-- | Lookup the kind of a type by name in the @Environment@

199lookupTypeVariable

200− :: (e ~ MultipleErrors, Functor m, MonadState CheckState m, MonadError e m)

200+ :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m)

201 => ModuleName

202 -> Qualified (ProperName 'TypeName)

203 -> m Kind

@@ -208,7 +208,7 @@ lookupTypeVariable currentModule (Qualified moduleName name) = do

208 Just (k, _) -> return k

209

210-- | Get the current @Environment@

211−getEnv :: (Functor m, MonadState CheckState m) => m Environment

211+getEnv :: (MonadState CheckState m) => m Environment

212getEnv = checkEnv <$> get

213

214-- | Update the @Environment@

@@ -234,14 +234,14 @@ guardWith e False = throwError e

234

235-- | Run a computation in the substitution monad, generating a return value and the final substitution.

236liftUnify ::

237− (Functor m, MonadState CheckState m, MonadWriter MultipleErrors m, MonadError MultipleErrors m) =>

237+ (MonadState CheckState m, MonadWriter MultipleErrors m, MonadError MultipleErrors m) =>

238 m a ->

239 m (a, Substitution)

240liftUnify = liftUnifyWarnings (const id)

241

242-- | Run a computation in the substitution monad, generating a return value, the final substitution and updating warnings values.

243liftUnifyWarnings ::

244− (Functor m, MonadState CheckState m, MonadWriter MultipleErrors m, MonadError MultipleErrors m) =>

244+ (MonadState CheckState m, MonadWriter MultipleErrors m, MonadError MultipleErrors m) =>

245 (Substitution -> ErrorMessage -> ErrorMessage) ->

246 m a ->

247 m (a, Substitution)

src/Language/PureScript/TypeChecker/Rows.hs+1−1

@@ -36,7 +36,7 @@ import Language.PureScript.TypeChecker.Monad

36import Language.PureScript.Types

37

38-- | Ensure rows do not contain duplicate labels

39−checkDuplicateLabels :: forall m. (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m) => Expr -> m ()

39+checkDuplicateLabels :: forall m. (MonadError MultipleErrors m, MonadState CheckState m) => Expr -> m ()

40checkDuplicateLabels =

41 let (_, f, _) = everywhereOnValuesM def go def

42 in void . f

src/Language/PureScript/TypeChecker/Skolems.hs+1−1

@@ -53,7 +53,7 @@ newSkolemConstant = do

53-- |

54-- Introduce skolem scope at every occurence of a ForAll

55--

56−introduceSkolemScope :: (Functor m, Applicative m, MonadState CheckState m) => Type -> m Type

56+introduceSkolemScope :: (MonadState CheckState m) => Type -> m Type

57introduceSkolemScope = everywhereOnTypesM go

58 where

59 go (ForAll ident ty Nothing) = ForAll ident ty <$> (Just <$> newSkolemScope)

src/Language/PureScript/TypeChecker/Subsumption.hs+2−2

@@ -39,11 +39,11 @@ import Language.PureScript.TypeChecker.Unify

39import Language.PureScript.Types

40

41-- | Check that one type subsumes another, rethrowing errors to provide a better error message

42−subsumes :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m) => Maybe Expr -> Type -> Type -> m (Maybe Expr)

42+subsumes :: (MonadError MultipleErrors m, MonadState CheckState m) => Maybe Expr -> Type -> Type -> m (Maybe Expr)

43subsumes val ty1 ty2 = rethrow (addHint (ErrorInSubsumption ty1 ty2)) $ subsumes' val ty1 ty2

44

45-- | Check tahat one type subsumes another

46−subsumes' :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m) =>

46+subsumes' :: (MonadError MultipleErrors m, MonadState CheckState m) =>

47 Maybe Expr ->

48 Type ->

49 Type ->

src/Language/PureScript/TypeChecker/Synonyms.hs+1−1

@@ -57,7 +57,7 @@ replaceAllTypeSynonyms' env = everywhereOnTypesTopDownM try

57 go c args (TypeApp f arg) = go (c + 1) (arg : args) f

58 go _ _ _ = return Nothing

59

60−replaceAllTypeSynonyms :: (e ~ MultipleErrors, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type

60+replaceAllTypeSynonyms :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m) => Type -> m Type

61replaceAllTypeSynonyms d = do

62 env <- getEnv

63 either throwError return $ replaceAllTypeSynonyms' env d

src/Language/PureScript/TypeChecker/Types.hs+19−19

@@ -61,7 +61,7 @@ import Language.PureScript.Types

61-- | Infer the types of multiple mutually-recursive values, and return elaborated values including

62-- type class dictionaries and type annotations.

63typesOf ::

64− (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

64+ (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

65 ModuleName ->

66 [(Ident, Expr)] ->

67 m [(Ident, (Expr, Type))]

@@ -93,7 +93,7 @@ type TypeData = M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)

93type UntypedData = [(Ident, Type)]

94

95typeDictionaryForBindingGroup ::

96− (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

96+ (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

97 ModuleName ->

98 [(Ident, Expr)] ->

99 m ([(Ident, Expr)], [(Ident, (Expr, Type, Bool))], TypeData, UntypedData)

@@ -118,7 +118,7 @@ typeDictionaryForBindingGroup moduleName vals = do

118 return (untyped, typed, dict, untypedDict)

119

120checkTypedBindingGroupElement ::

121− (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

121+ (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

122 ModuleName ->

123 (Ident, (Expr, Type, Bool)) ->

124 TypeData ->

@@ -137,7 +137,7 @@ checkTypedBindingGroupElement mn (ident, (val', ty, checkType)) dict = do

137 return (ident, (val'', ty''))

138

139typeForBindingGroupElement ::

140− (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

140+ (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

141 Bool ->

142 (Ident, Expr) ->

143 TypeData ->

@@ -168,7 +168,7 @@ overTypes f = let (_, f', _) = everywhereOnValues id g id in f'

168

169-- | Replace type class dictionary placeholders with inferred type class dictionaries

170replaceTypeClassDictionaries ::

171− (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

171+ (MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

172 ModuleName ->

173 Expr ->

174 m Expr

@@ -181,7 +181,7 @@ replaceTypeClassDictionaries mn =

181

182-- | Check the kind of a type, failing if it is not of kind *.

183checkTypeKind ::

184− (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m) =>

184+ (MonadState CheckState m, MonadError MultipleErrors m) =>

185 Type ->

186 Kind ->

187 m ()

@@ -193,7 +193,7 @@ checkTypeKind ty kind = guardWith (errorMessage (ExpectedType ty kind)) $ kind =

193-- This is necessary during type checking to avoid unifying a polymorphic type with a

194-- unification variable.

195instantiatePolyTypeWithUnknowns ::

196− (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m) =>

196+ (MonadState CheckState m, MonadError MultipleErrors m) =>

197 Expr ->

198 Type ->

199 m (Expr, Type)

@@ -207,14 +207,14 @@ instantiatePolyTypeWithUnknowns val ty = return (val, ty)

207

208-- | Infer a type for a value, rethrowing any error to provide a more useful error message

209infer ::

210− (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

210+ (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

211 Expr ->

212 m Expr

213infer val = rethrow (addHint (ErrorInferringType val)) $ infer' val

214

215-- | Infer a type for a value

216infer' ::

217− (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

217+ (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

218 Expr ->

219 m Expr

220infer' v@(Literal (NumericLiteral (Left _))) = return $ TypedValue True v tyInt

@@ -303,7 +303,7 @@ infer' (PositionedValue pos c val) = warnAndRethrowWithPosition pos $ do

303infer' _ = internalError "Invalid argument to infer"

304

305inferLetBinding ::

306− (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

306+ (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

307 [Declaration] ->

308 [Declaration] ->

309 Expr ->

@@ -341,7 +341,7 @@ inferLetBinding _ _ _ _ = internalError "Invalid argument to inferLetBinding"

341

342-- | Infer the types of variables brought into scope by a binder

343inferBinder :: forall m.

344− (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

344+ (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

345 Type ->

346 Binder ->

347 m (M.Map Ident Type)

@@ -420,7 +420,7 @@ binderRequiresMonotype _ = True

420

421-- | Instantiate polytypes only when necessitated by a binder.

422instantiateForBinders ::

423− (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

423+ (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

424 [Expr] ->

425 [CaseAlternative] ->

426 m ([Expr], [Type])

@@ -437,7 +437,7 @@ instantiateForBinders vals cas = unzip <$> zipWithM (\val inst -> do

437-- Check the types of the return values in a set of binders in a case statement

438--

439checkBinders ::

440− (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

440+ (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

441 [Type] ->

442 Type ->

443 [CaseAlternative] ->

@@ -467,7 +467,7 @@ checkBinders nvals ret (CaseAlternative binders result : bs) = do

467-- Check the type of a value, rethrowing errors to provide a better error message

468--

469check ::

470− (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

470+ (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

471 Expr ->

472 Type ->

473 m Expr

@@ -478,7 +478,7 @@ check val ty = rethrow (addHint (ErrorCheckingType val ty)) $ check' val ty

478--

479check'

480 :: forall m

481− . (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

481+ . (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

482 => Expr

483 -> Type

484 -> m Expr

@@ -641,7 +641,7 @@ check' val ty = do

641-- The @lax@ parameter controls whether or not every record member has to be provided. For object updates, this is not the case.

642--

643checkProperties ::

644− (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

644+ (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

645 Expr ->

646 [(String, Expr)] ->

647 Type ->

@@ -673,7 +673,7 @@ checkProperties expr ps row lax = let (ts, r') = rowToList row in go ps ts r' wh

673

674-- | Check the type of a function application, rethrowing errors to provide a better error message

675checkFunctionApplication ::

676− (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

676+ (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

677 Expr ->

678 Type ->

679 Expr ->

@@ -685,7 +685,7 @@ checkFunctionApplication fn fnTy arg ret = rethrow (addHint (ErrorInApplication

685

686-- | Check the type of a function application

687checkFunctionApplication' ::

688− (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

688+ (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

689 Expr ->

690 Type ->

691 Expr ->

@@ -723,7 +723,7 @@ checkFunctionApplication' _ fnTy arg _ = throwError . errorMessage $ CannotApply

723-- | Compute the meet of two types, i.e. the most general type which both types subsume.

724-- TODO: is this really needed?

725meet ::

726− (Functor m, Applicative m, MonadState CheckState m, MonadError MultipleErrors m) =>

726+ (MonadState CheckState m, MonadError MultipleErrors m) =>

727 Expr ->

728 Expr ->

729 Type ->

src/Language/PureScript/TypeChecker/Unify.hs+5−5

@@ -56,7 +56,7 @@ freshType = do

56 return $ TUnknown t

57

58-- | Update the substitution to solve a type constraint

59−solveType :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m) => Int -> Type -> m ()

59+solveType :: (MonadError MultipleErrors m, MonadState CheckState m) => Int -> Type -> m ()

60solveType u t = do

61 occursCheck u t

62 modify $ \cs -> cs { checkSubstitution =

@@ -77,7 +77,7 @@ substituteType sub = everywhereOnTypes go

77 go other = other

78

79-- | Make sure that an unknown does not occur in a type

80−occursCheck :: (Functor m, Applicative m, MonadError MultipleErrors m) => Int -> Type -> m ()

80+occursCheck :: (MonadError MultipleErrors m) => Int -> Type -> m ()

81occursCheck _ TUnknown{} = return ()

82occursCheck u t = void $ everywhereOnTypesM go t

83 where

@@ -93,7 +93,7 @@ unknownsInType t = everythingOnTypes (.) go t []

93 go _ = id

94

95-- | Unify two types, updating the current substitution

96−unifyTypes :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m) => Type -> Type -> m ()

96+unifyTypes :: (MonadError MultipleErrors m, MonadState CheckState m) => Type -> Type -> m ()

97unifyTypes t1 t2 = do

98 sub <- gets checkSubstitution

99 rethrow (addHint (ErrorUnifyingTypes t1 t2)) $ unifyTypes' (substituteType sub t1) (substituteType sub t2)

@@ -139,7 +139,7 @@ unifyTypes t1 t2 = do

139-- trailing row unification variable, if appropriate, otherwise leftover labels result in a unification

140-- error.

141--

142−unifyRows :: forall m. (Functor m, Applicative m, MonadError MultipleErrors m, MonadState CheckState m) => Type -> Type -> m ()

142+unifyRows :: forall m. (MonadError MultipleErrors m, MonadState CheckState m) => Type -> Type -> m ()

143unifyRows r1 r2 =

144 let

145 (s1, r1') = rowToList r1

@@ -205,7 +205,7 @@ replaceVarWithUnknown ident ty = do

205-- |

206-- Replace type wildcards with unknowns

207--

208−replaceTypeWildcards :: (Functor m, Applicative m, MonadWriter MultipleErrors m, MonadState CheckState m) => Type -> m Type

208+replaceTypeWildcards :: (MonadWriter MultipleErrors m, MonadState CheckState m) => Type -> m Type

209replaceTypeWildcards = everywhereOnTypesM replace

210 where

211 replace TypeWildcard = do

src/Language/PureScript/Types.hs+2−2

@@ -248,7 +248,7 @@ everywhereOnTypesTopDown f = go . f

248 go (PrettyPrintForAll args t) = PrettyPrintForAll args (go (f t))

249 go other = f other

250

251−everywhereOnTypesM :: (Functor m, Applicative m, Monad m) => (Type -> m Type) -> Type -> m Type

251+everywhereOnTypesM :: Monad m => (Type -> m Type) -> Type -> m Type

252everywhereOnTypesM f = go

253 where

254 go (TypeApp t1 t2) = (TypeApp <$> go t1 <*> go t2) >>= f

@@ -261,7 +261,7 @@ everywhereOnTypesM f = go

261 go (PrettyPrintForAll args t) = (PrettyPrintForAll args <$> go t) >>= f

262 go other = f other

263

264−everywhereOnTypesTopDownM :: (Functor m, Applicative m, Monad m) => (Type -> m Type) -> Type -> m Type

264+everywhereOnTypesTopDownM :: Monad m => (Type -> m Type) -> Type -> m Type

265everywhereOnTypesTopDownM f = go <=< f

266 where

267 go (TypeApp t1 t2) = TypeApp <$> (f t1 >>= go) <*> (f t2 >>= go)