on master help sign in
Make error reporting parallel
b4657b9Evan Czaplicki
src/Compile.hs+4−4
@@ -7,7 +7,7 @@ import Elm.Utils ((|>))
7import qualified Parse.Helpers as Parse
7import qualified Parse.Helpers as Parse
8import qualified Parse.Parse as Parse
8import qualified Parse.Parse as Parse
9import qualified Reporting.Error as Error
9import qualified Reporting.Error as Error
10−import qualified Reporting.Task as Task
10+import qualified Reporting.Result as Result
11import qualified Reporting.Warning as Warning
11import qualified Reporting.Warning as Warning
12import qualified Type.Inference as TI
12import qualified Type.Inference as TI
13import qualified Transform.Canonicalize as Canonical
13import qualified Transform.Canonicalize as Canonical
@@ -18,7 +18,7 @@ compile
18 -> String
18 -> String
19 -> Module.Interfaces
19 -> Module.Interfaces
20 -> String
20 -> String
21− -> Task.Task Warning.Warning Error.Error Module.CanonicalModule
21+ -> Result.Result Warning.Warning Error.Error Module.CanonicalModule
22
22
23compile user projectName interfaces source =
23compile user projectName interfaces source =
24 do
24 do
@@ -29,7 +29,7 @@ compile user projectName interfaces source =
29
29
30 -- Parse the source code
30 -- Parse the source code
31 validModule <-
31 validModule <-
32− Task.mapError Error.Syntax $
32+ Result.mapError Error.Syntax $
33 Parse.program needsDefaults (getOpTable interfaces) source
33 Parse.program needsDefaults (getOpTable interfaces) source
34
34
35 -- Canonicalize all variables, pinning down where they came from.
35 -- Canonicalize all variables, pinning down where they came from.
@@ -38,7 +38,7 @@ compile user projectName interfaces source =
38
38
39 -- Run type inference on the program.
39 -- Run type inference on the program.
40 types <-
40 types <-
41− Task.from Error.Type $
41+ Result.from Error.Type $
42 TI.infer interfaces canonicalModule
42 TI.infer interfaces canonicalModule
43
43
44 -- Add the real list of tyes
44 -- Add the real list of tyes
src/Elm/Compiler.hs+46−9
@@ -3,6 +3,8 @@
3module Elm.Compiler
3module Elm.Compiler
4 ( version, rawVersion
4 ( version, rawVersion
5 , parseDependencies, compile
5 , parseDependencies, compile
6+ , Error, errorToString, errorToJson
7+ , Warning, warningToString, warningToJson
6 ) where
8 ) where
7
9
8import Control.Monad.Error.Class (MonadError, throwError)
10import Control.Monad.Error.Class (MonadError, throwError)
@@ -16,7 +18,9 @@ import qualified Generate.JavaScript as JS
16import qualified Parse.Helpers as Help
18import qualified Parse.Helpers as Help
17import qualified Parse.Module as Parse
19import qualified Parse.Module as Parse
18import qualified Reporting.Annotation as A
20import qualified Reporting.Annotation as A
19−import qualified Reporting.Task as Task
21+import qualified Reporting.Error as Error
22+import qualified Reporting.Result as Result
23+import qualified Reporting.Warning as Warning
20
24
21
25
22-- VERSION
26-- VERSION
@@ -57,17 +61,50 @@ compile
57 -> String
61 -> String
58 -> String
62 -> String
59 -> Map.Map PublicModule.Name PublicModule.Interface
63 -> Map.Map PublicModule.Name PublicModule.Interface
60− -> Either String (PublicModule.Interface, String)
64+ -> ([Warning], Either [Error] (PublicModule.Interface, String))
61compile user packageName source interfaces =
65compile user packageName source interfaces =
62 let unwrappedInterfaces =
66 let unwrappedInterfaces =
63− Map.mapKeysMonotonic (\(PublicModule.Name name) -> name) interfaces
67+ Map.mapKeysMonotonic (\(PublicModule.Name name) -> name) interfaces
64
68
65− task =
69+ (Result.Result warnings rawResult) =
66− Compile.compile user packageName unwrappedInterfaces source
70+ Compile.compile user packageName unwrappedInterfaces source
67 in
71 in
68− case Task.run task of
72+ (,) (map Warning warnings) $
69− (Right modul, _warnings) ->
73+ case rawResult of
74+ Result.Ok modul ->
70 Right (Module.toInterface modul, JS.generate modul)
75 Right (Module.toInterface modul, JS.generate modul)
71
76
72− (Left _docs, _warnings) ->
77+ Result.Err errors ->
73− Left [error "TODO:compile"]
78+ Left (map Error errors)
79+
80+
81+-- ERRORS
82+
83+newtype Error = Error (A.Located Error.Error)
84+
85+
86+errorToString :: Error -> String
87+errorToString (Error err) =
88+ Error.toString err
89+
90+
91+errorToJson :: Error -> String
92+errorToJson (Error err) =
93+ Error.toJson err
94+
95+
96+-- WARNINGS
97+
98+newtype Warning = Warning (A.Located Warning.Warning)
99+
100+
101+warningToString :: Warning -> String
102+warningToString (Warning warning) =
103+ Warning.toString warning
104+
105+
106+warningToJson :: Warning -> String
107+warningToJson (Warning warning) =
108+ Warning.toJson warning
109+
110+
src/Parse/Parse.hs+8−8
@@ -14,7 +14,7 @@ import qualified Parse.Module as Module
14import qualified Parse.Declaration as Decl
14import qualified Parse.Declaration as Decl
15import qualified Reporting.Region as R
15import qualified Reporting.Region as R
16import qualified Reporting.Error.Syntax as Error
16import qualified Reporting.Error.Syntax as Error
17−import qualified Reporting.Task as Task
17+import qualified Reporting.Result as Result
18import qualified Transform.AddDefaultImports as DefaultImports
18import qualified Transform.AddDefaultImports as DefaultImports
19import qualified Validate
19import qualified Validate
20
20
@@ -23,7 +23,7 @@ program
23 :: Bool
23 :: Bool
24 -> OpTable
24 -> OpTable
25 -> String
25 -> String
26− -> Task.Task wrn Error.Error M.ValidModule
26+ -> Result.Result wrn Error.Error M.ValidModule
27program needsDefaults table src =
27program needsDefaults table src =
28 do (M.Module names filePath exports imports sourceDecls) <-
28 do (M.Module names filePath exports imports sourceDecls) <-
29 parseWithTable table src programParser
29 parseWithTable table src programParser
@@ -63,7 +63,7 @@ freshDef =
63
63
64-- RUN PARSERS
64-- RUN PARSERS
65
65
66−parse :: String -> IParser a -> Task.Task wrn Error.Error a
66+parse :: String -> IParser a -> Result.Result wrn Error.Error a
67parse source parser =
67parse source parser =
68 case iParse parser source of
68 case iParse parser source of
69 Right result ->
69 Right result ->
@@ -73,14 +73,14 @@ parse source parser =
73 let pos = R.fromSourcePos (Parsec.errorPos err)
73 let pos = R.fromSourcePos (Parsec.errorPos err)
74 msgs = Parsec.errorMessages err
74 msgs = Parsec.errorMessages err
75 in
75 in
76− Task.throw (R.Region pos pos) (Error.Parse msgs)
76+ Result.throw (R.Region pos pos) (Error.Parse msgs)
77
77
78
78
79parseWithTable
79parseWithTable
80 :: OpTable
80 :: OpTable
81 -> String
81 -> String
82 -> IParser a
82 -> IParser a
83− -> Task.Task wrn Error.Error a
83+ -> Result.Result wrn Error.Error a
84parseWithTable table source parser =
84parseWithTable table source parser =
85 do infixInfoList <- parse source parseFixities
85 do infixInfoList <- parse source parseFixities
86
86
@@ -97,7 +97,7 @@ parseWithTable table source parser =
97makeInfixTable
97makeInfixTable
98 :: Map.Map String (Int, D.Assoc)
98 :: Map.Map String (Int, D.Assoc)
99 -> [(String, InfixInfo)]
99 -> [(String, InfixInfo)]
100− -> Task.Task wrn Error.Error (Map.Map String (Int, D.Assoc))
100+ -> Result.Result wrn Error.Error (Map.Map String (Int, D.Assoc))
101makeInfixTable table newInfo =
101makeInfixTable table newInfo =
102 let add (op, info) dict =
102 let add (op, info) dict =
103 Map.insertWith (++) op [info] dict
103 Map.insertWith (++) op [info] dict
@@ -112,11 +112,11 @@ makeInfixTable table newInfo =
112
112
113 [InfixInfo region info] ->
113 [InfixInfo region info] ->
114 if Map.member op table
114 if Map.member op table
115− then Task.throw region (Error.InfixDuplicate op)
115+ then Result.throw region (Error.InfixDuplicate op)
116 else return info
116 else return info
117
117
118 InfixInfo region _ : _ ->
118 InfixInfo region _ : _ ->
119− Task.throw region (Error.InfixDuplicate op)
119+ Result.throw region (Error.InfixDuplicate op)
120 in
120 in
121 Map.union table <$> T.sequenceA (Map.mapWithKey check infoTable)
121 Map.union table <$> T.sequenceA (Map.mapWithKey check infoTable)
122
122
src/Reporting/Error.hs+12−10
@@ -3,11 +3,12 @@ module Reporting.Error where
3
3
4import Data.Aeson ((.=))
4import Data.Aeson ((.=))
5import qualified Data.Aeson as Json
5import qualified Data.Aeson as Json
6+import qualified Data.ByteString.Lazy.Char8 as BS
6
7
8+import qualified Reporting.Annotation as A
7import qualified Reporting.Error.Canonicalize as Canonicalize
9import qualified Reporting.Error.Canonicalize as Canonicalize
8import qualified Reporting.Error.Syntax as Syntax
10import qualified Reporting.Error.Syntax as Syntax
9import qualified Reporting.Error.Type as Type
11import qualified Reporting.Error.Type as Type
10−import qualified Reporting.Region as R
11
12
12
13
13-- ALL POSSIBLE ERRORS
14-- ALL POSSIBLE ERRORS
@@ -20,8 +21,8 @@ data Error
20
21
21-- TO STRING
22-- TO STRING
22
23
23−toString :: R.Region -> Error -> String
24+toString :: A.Located Error -> String
24−toString region err =
25+toString (A.A region err) =
25 case err of
26 case err of
26 Syntax syntaxError ->
27 Syntax syntaxError ->
27 Syntax.toString region syntaxError
28 Syntax.toString region syntaxError
@@ -35,8 +36,8 @@ toString region err =
35
36
36-- JSON
37-- JSON
37
38
38−toJson :: R.Region -> Error -> Json.Value
39+toJson :: A.Located Error -> String
39−toJson region err =
40+toJson (A.A region err) =
40 let json =
41 let json =
41 case err of
42 case err of
42 Syntax syntaxError ->
43 Syntax syntaxError ->
@@ -48,8 +49,9 @@ toJson region err =
48 Type typeError ->
49 Type typeError ->
49 Type.toJson typeError
50 Type.toJson typeError
50 in
51 in
52+ BS.unpack $ Json.encode $
51− Json.object
53+ Json.object
52− [ "tag" .= ("error" :: String)
54+ [ "tag" .= ("error" :: String)
53− , "region" .= region
55+ , "region" .= region
54− , "error" .= json
56+ , "error" .= json
55− ]
57+ ]
src/Reporting/Result.hsnew file+108
@@ -0,0 +1,108 @@
1+module Reporting.Result where
2+
3+import qualified Control.Applicative as A
4+import qualified Control.Monad as M
5+import Control.Monad.Except (Except, runExcept)
6+
7+import qualified Reporting.Annotation as A
8+import qualified Reporting.Region as R
9+
10+
11+-- TASK
12+
13+data Result warning error result =
14+ Result [A.Located warning] (RawResult [A.Located error] result)
15+
16+data RawResult e a
17+ = Ok a
18+ | Err e
19+
20+
21+-- HELPERS
22+
23+ok :: a -> Result w e a
24+ok value =
25+ Result [] (Ok value)
26+
27+
28+throw :: R.Region -> e -> Result w e a
29+throw region err =
30+ Result [] (Err [A.A region err])
31+
32+
33+throwMany :: [A.Located e] -> Result w e a
34+throwMany errors =
35+ Result [] (Err errors)
36+
37+
38+from :: (e -> e') -> Except [A.Located e] a -> Result w e' a
39+from f except =
40+ case runExcept except of
41+ Right answer ->
42+ ok answer
43+
44+ Left errors ->
45+ throwMany (map (A.map f) errors)
46+
47+
48+mapError :: (e -> e') -> Result w e a -> Result w e' a
49+mapError f (Result warnings rawResult) =
50+ Result warnings $
51+ case rawResult of
52+ Ok v ->
53+ Ok v
54+
55+ Err msgs ->
56+ Err (map (A.map f) msgs)
57+
58+
59+addWarnings :: [A.Located w] -> Result w e a -> Result w e a
60+addWarnings newWarnings (Result warnings rawResult) =
61+ Result (newWarnings ++ warnings) rawResult
62+
63+
64+-- EXTRA FANCY HELPERS
65+
66+instance M.Functor (Result w e) where
67+ fmap func (Result warnings rawResult) =
68+ case rawResult of
69+ Ok a ->
70+ Result warnings (Ok (func a))
71+
72+ Err msgs ->
73+ Result warnings (Err msgs)
74+
75+
76+instance A.Applicative (Result w e) where
77+ pure value =
78+ ok value
79+
80+ (<*>) (Result warnings resultFunc) (Result warnings' resultVal) =
81+ Result (warnings ++ warnings') $
82+ case (resultFunc, resultVal) of
83+ (Ok func, Ok val) ->
84+ Ok (func val)
85+
86+ (Err msgs, Err msgs') ->
87+ Err (msgs ++ msgs')
88+
89+ (Err msgs, _) ->
90+ Err msgs
91+
92+ (_, Err msgs) ->
93+ Err msgs
94+
95+
96+instance M.Monad (Result w e) where
97+ return value =
98+ ok value
99+
100+ (>>=) (Result warnings rawResult) callback =
101+ case rawResult of
102+ Err msg ->
103+ Result warnings (Err msg)
104+
105+ Ok value ->
106+ let (Result warnings' rawResult') = callback value
107+ in
108+ Result (warnings ++ warnings') rawResult'
src/Reporting/Task.hsdeleted−51
@@ -1,51 +0,0 @@
1−module Reporting.Task where
2−
3−import Control.Monad.Except (Except, ExceptT, runExcept, runExceptT, throwError, withExceptT)
4−import qualified Control.Monad.State as State
5−
6−import qualified Reporting.Annotation as A
7−import qualified Reporting.Region as R
8−
9−
10−-- TASK
11−
12−type Task warning error result =
13− ExceptT [A.Located error] (State.State [A.Located warning]) result
14−
15−
16−-- RUN TASKS
17−
18−run :: Task w e a -> (Either [A.Located e] a, [A.Located w])
19−run task =
20− State.runState (runExceptT task) []
21−
22−
23−-- WARNINGS
24−
25−addWarnings :: [A.Located w] -> Task w e ()
26−addWarnings warnings =
27− State.modify (warnings++)
28−
29−
30−-- ERRORS
31−
32−throw :: R.Region -> e -> Task w e a
33−throw region err =
34− throwError [A.A region err]
35−
36−
37−mapError :: (e -> e') -> Task w e a -> Task w e' a
38−mapError f task =
39− withExceptT (map (A.map f)) task
40−
41−
42−from :: (e -> e') -> Except [A.Located e] a -> Task w e' a
43−from f except =
44− case runExcept except of
45− Right answer ->
46− return answer
47−
48− Left errors ->
49− throwError (map (A.map f) errors)
50−
51−
src/Reporting/Warning.hs+20−1
@@ -2,7 +2,26 @@ module Reporting.Warning where
2
2
3import qualified AST.Module as Module
3import qualified AST.Module as Module
4
4
5+import qualified Reporting.Annotation as A
6+
5
7
6data Warning
8data Warning
7 = UnusedImport Module.Name
9 = UnusedImport Module.Name
8− | MissingTypeAnnotation String
10+ | MissingTypeAnnotation String
11+
12+
13+-- TO STRING
14+
15+toString :: A.Located Warning -> String
16+toString (A.A region warning) =
17+ case warning of
18+ _ -> error "Warning.toString" region
19+
20+
21+-- TO JSON
22+
23+toJson :: A.Located Warning -> String
24+toJson (A.A region warning) =
25+ case warning of
26+ _ -> error "Warning.toJson" region
27+
src/Transform/Canonicalize.hs+6−5
@@ -1,7 +1,6 @@
1module Transform.Canonicalize (module') where
1module Transform.Canonicalize (module') where
2
2
3import Control.Applicative ((<$>),(<*>))
3import Control.Applicative ((<$>),(<*>))
4−import Control.Monad.Except (throwError)
5import qualified Data.List as List
4import qualified Data.List as List
6import qualified Data.Map as Map
5import qualified Data.Map as Map
7import qualified Data.Maybe as Maybe
6import qualified Data.Maybe as Maybe
@@ -22,7 +21,7 @@ import qualified AST.Variable as Var
22import qualified Reporting.Annotation as A
21import qualified Reporting.Annotation as A
23import qualified Reporting.Error as Error
22import qualified Reporting.Error as Error
24import qualified Reporting.Error.Canonicalize as CError
23import qualified Reporting.Error.Canonicalize as CError
25−import qualified Reporting.Task as Task
24+import qualified Reporting.Result as R
26import qualified Reporting.Warning as Warning
25import qualified Reporting.Warning as Warning
27import qualified Transform.Canonicalize.Environment as Env
26import qualified Transform.Canonicalize.Environment as Env
28import qualified Transform.Canonicalize.Port as Port
27import qualified Transform.Canonicalize.Port as Port
@@ -39,19 +38,21 @@ import qualified Transform.Declaration as Transform
39module'
38module'
40 :: Module.Interfaces
39 :: Module.Interfaces
41 -> Module.ValidModule
40 -> Module.ValidModule
42− -> Task.Task Warning.Warning Error.Error Module.CanonicalModule
41+ -> R.Result Warning.Warning Error.Error Module.CanonicalModule
43module' interfaces modul@(Module.Module _ _ _ (_, imports) _) =
42module' interfaces modul@(Module.Module _ _ _ (_, imports) _) =
44 let (Result.Result uses rawResults) =
43 let (Result.Result uses rawResults) =
45 moduleHelp interfaces modul
44 moduleHelp interfaces modul
46
45
46+ unusedImportWarnings =
47+ Maybe.mapMaybe (warnUnusedImport uses) imports
47 in
48 in
48− do Task.addWarnings (Maybe.mapMaybe (warnUnusedImport uses) imports)
49+ R.addWarnings unusedImportWarnings $
49 case rawResults of
50 case rawResults of
50 Result.Ok canonicalModule ->
51 Result.Ok canonicalModule ->
51 return canonicalModule
52 return canonicalModule
52
53
53 Result.Err msgs ->
54 Result.Err msgs ->
54− throwError (map (A.map Error.Canonicalize) msgs)
55+ R.throwMany (map (A.map Error.Canonicalize) msgs)
55
56
56
57
57moduleHelp
58moduleHelp
src/Validate.hs+21−21
@@ -17,14 +17,14 @@ import Elm.Utils ((|>))
17import qualified Reporting.Annotation as A
17import qualified Reporting.Annotation as A
18import qualified Reporting.Error.Syntax as Error
18import qualified Reporting.Error.Syntax as Error
19import qualified Reporting.Region as R
19import qualified Reporting.Region as R
20−import qualified Reporting.Task as Task
20+import qualified Reporting.Result as Result
21
21
22
22
23-- VALIDATE DECLARATIONS
23-- VALIDATE DECLARATIONS
24
24
25declarations
25declarations
26 :: [D.SourceDecl]
26 :: [D.SourceDecl]
27− -> Task.Task wrn Error.Error [D.ValidDecl]
27+ -> Result.Result wrn Error.Error [D.ValidDecl]
28declarations sourceDecls =
28declarations sourceDecls =
29 do validDecls <- validateDecls sourceDecls
29 do validDecls <- validateDecls sourceDecls
30 (\_ _ -> validDecls)
30 (\_ _ -> validDecls)
@@ -34,7 +34,7 @@ declarations sourceDecls =
34
34
35validateDecls
35validateDecls
36 :: [D.SourceDecl]
36 :: [D.SourceDecl]
37− -> Task.Task wrn Error.Error [D.ValidDecl]
37+ -> Result.Result wrn Error.Error [D.ValidDecl]
38validateDecls sourceDecls =
38validateDecls sourceDecls =
39 case sourceDecls of
39 case sourceDecls of
40 [] ->
40 [] ->
@@ -47,7 +47,7 @@ validateDecls sourceDecls =
47validateDeclsHelp
47validateDeclsHelp
48 :: D.SourceDecl
48 :: D.SourceDecl
49 -> [D.SourceDecl]
49 -> [D.SourceDecl]
50− -> Task.Task wrn Error.Error [D.ValidDecl]
50+ -> Result.Result wrn Error.Error [D.ValidDecl]
51validateDeclsHelp (A.A region decl) decls =
51validateDeclsHelp (A.A region decl) decls =
52 let addRest validDecl =
52 let addRest validDecl =
53 (:) (A.A region validDecl) <$> validateDecls decls
53 (:) (A.A region validDecl) <$> validateDecls decls
@@ -74,7 +74,7 @@ validateDeclsHelp (A.A region decl) decls =
74defHelp
74defHelp
75 :: Source.Def
75 :: Source.Def
76 -> [D.SourceDecl]
76 -> [D.SourceDecl]
77− -> Task.Task wrn Error.Error [D.ValidDecl]
77+ -> Result.Result wrn Error.Error [D.ValidDecl]
78defHelp (A.A region def) decls =
78defHelp (A.A region def) decls =
79 let addRest def' rest =
79 let addRest def' rest =
80 (:) (A.A region (D.Definition def')) <$> validateDecls rest
80 (:) (A.A region (D.Definition def')) <$> validateDecls rest
@@ -94,7 +94,7 @@ defHelp (A.A region def) decls =
94 addRest def' rest
94 addRest def' rest
95
95
96 _ ->
96 _ ->
97− Task.throw region (Error.TypeWithoutDefinition name)
97+ Result.throw region (Error.TypeWithoutDefinition name)
98
98
99
99
100-- VALIDATE PORTS IN DECLARATIONS
100-- VALIDATE PORTS IN DECLARATIONS
@@ -103,14 +103,14 @@ portHelp
103 :: R.Region
103 :: R.Region
104 -> D.SourcePort
104 -> D.SourcePort
105 -> [D.SourceDecl]
105 -> [D.SourceDecl]
106− -> Task.Task wrn Error.Error [D.ValidDecl]
106+ -> Result.Result wrn Error.Error [D.ValidDecl]
107portHelp region port decls =
107portHelp region port decls =
108 let addRest port' rest =
108 let addRest port' rest =
109 (:) (A.A region (D.Port port')) <$> validateDecls rest
109 (:) (A.A region (D.Port port')) <$> validateDecls rest
110 in
110 in
111 case port of
111 case port of
112 D.PortDefinition name _ ->
112 D.PortDefinition name _ ->
113− Task.throw region (Error.PortWithoutAnnotation name)
113+ Result.throw region (Error.PortWithoutAnnotation name)
114
114
115 D.PortAnnotation name tipe ->
115 D.PortAnnotation name tipe ->
116 case decls of
116 case decls of
@@ -126,7 +126,7 @@ portHelp region port decls =
126
126
127-- VALIDATE DEFINITIONS
127-- VALIDATE DEFINITIONS
128
128
129−definitions :: [Source.Def] -> Task.Task wrn Error.Error [Valid.Def]
129+definitions :: [Source.Def] -> Result.Result wrn Error.Error [Valid.Def]
130definitions sourceDefs =
130definitions sourceDefs =
131 do validDefs <- definitionsHelp sourceDefs
131 do validDefs <- definitionsHelp sourceDefs
132 let patterns = map (\(Valid.Definition p _ _) -> p) validDefs
132 let patterns = map (\(Valid.Definition p _ _) -> p) validDefs
@@ -134,7 +134,7 @@ definitions sourceDefs =
134 return validDefs
134 return validDefs
135
135
136
136
137−definitionsHelp :: [Source.Def] -> Task.Task wrn Error.Error [Valid.Def]
137+definitionsHelp :: [Source.Def] -> Result.Result wrn Error.Error [Valid.Def]
138definitionsHelp sourceDefs =
138definitionsHelp sourceDefs =
139 case sourceDefs of
139 case sourceDefs of
140 [] ->
140 [] ->
@@ -154,12 +154,12 @@ definitionsHelp sourceDefs =
154 (:) def <$> definitionsHelp rest'
154 (:) def <$> definitionsHelp rest'
155
155
156 _ ->
156 _ ->
157− Task.throw region (Error.TypeWithoutDefinition name)
157+ Result.throw region (Error.TypeWithoutDefinition name)
158
158
159
159
160-- VALIDATE EXPRESSIONS
160-- VALIDATE EXPRESSIONS
161
161
162−expression :: Source.Expr -> Task.Task wrn Error.Error Valid.Expr
162+expression :: Source.Expr -> Result.Result wrn Error.Error Valid.Expr
163expression (A.A ann sourceExpression) =
163expression (A.A ann sourceExpression) =
164 A.A ann <$>
164 A.A ann <$>
165 case sourceExpression of
165 case sourceExpression of
@@ -250,14 +250,14 @@ expression (A.A ann sourceExpression) =
250 return (Task name expr' tipe)
250 return (Task name expr' tipe)
251
251
252
252
253−second :: (a, Source.Expr) -> Task.Task wrn Error.Error (a, Valid.Expr)
253+second :: (a, Source.Expr) -> Result.Result wrn Error.Error (a, Valid.Expr)
254second (value, expr) =
254second (value, expr) =
255 (,) value <$> expression expr
255 (,) value <$> expression expr
256
256
257
257
258both
258both
259 :: (Source.Expr, Source.Expr)
259 :: (Source.Expr, Source.Expr)
260− -> Task.Task wrn Error.Error (Valid.Expr, Valid.Expr)
260+ -> Result.Result wrn Error.Error (Valid.Expr, Valid.Expr)
261both (expr1, expr2) =
261both (expr1, expr2) =
262 (,) <$> expression expr1 <*> expression expr2
262 (,) <$> expression expr1 <*> expression expr2
263
263
@@ -267,7 +267,7 @@ both (expr1, expr2) =
267detectDuplicates
267detectDuplicates
268 :: (String -> Error.Error)
268 :: (String -> Error.Error)
269 -> [A.Located String]
269 -> [A.Located String]
270− -> Task.Task wrn Error.Error ()
270+ -> Result.Result wrn Error.Error ()
271detectDuplicates tag names =
271detectDuplicates tag names =
272 let add (A.A region name) dict =
272 let add (A.A region name) dict =
273 Map.insertWith (++) name [region] dict
273 Map.insertWith (++) name [region] dict
@@ -278,7 +278,7 @@ detectDuplicates tag names =
278 check (name, regions) =
278 check (name, regions) =
279 case regions of
279 case regions of
280 _ : region : _ ->
280 _ : region : _ ->
281− Task.throw region (tag name)
281+ Result.throw region (tag name)
282
282
283 _ ->
283 _ ->
284 return ()
284 return ()
@@ -288,13 +288,13 @@ detectDuplicates tag names =
288
288
289defDuplicates
289defDuplicates
290 :: [Pattern.RawPattern]
290 :: [Pattern.RawPattern]
291− -> Task.Task wrn Error.Error ()
291+ -> Result.Result wrn Error.Error ()
292defDuplicates patterns =
292defDuplicates patterns =
293 concatMap Pattern.boundVars patterns
293 concatMap Pattern.boundVars patterns
294 |> detectDuplicates Error.DuplicateDefinition
294 |> detectDuplicates Error.DuplicateDefinition
295
295
296
296
297−declDuplicates :: [D.ValidDecl] -> Task.Task wrn Error.Error ()
297+declDuplicates :: [D.ValidDecl] -> Result.Result wrn Error.Error ()
298declDuplicates decls =
298declDuplicates decls =
299 let (valueLists, typeLists) = unzip (map extractValues decls)
299 let (valueLists, typeLists) = unzip (map extractValues decls)
300 in
300 in
@@ -339,7 +339,7 @@ extractValues (A.A region decl) =
339
339
340-- UNBOUND TYPE VARIABLES
340-- UNBOUND TYPE VARIABLES
341
341
342−checkDecl :: D.ValidDecl -> Task.Task wrn Error.Error ()
342+checkDecl :: D.ValidDecl -> Result.Result wrn Error.Error ()
343checkDecl (A.A _ decl) =
343checkDecl (A.A _ decl) =
344 case decl of
344 case decl of
345 D.Definition _ ->
345 D.Definition _ ->
@@ -358,14 +358,14 @@ checkDecl (A.A _ decl) =
358 return ()
358 return ()
359
359
360
360
361−checkTypeVars :: String -> [String] -> Type.Raw -> Task.Task wrn Error.Error ()
361+checkTypeVars :: String -> [String] -> Type.Raw -> Result.Result wrn Error.Error ()
362checkTypeVars name boundVars tipe =
362checkTypeVars name boundVars tipe =
363 let bounds = Set.fromList boundVars
363 let bounds = Set.fromList boundVars
364
364
365 check (A.A region free) =
365 check (A.A region free) =
366 if Set.member free bounds
366 if Set.member free bounds
367 then return ()
367 then return ()
368− else Task.throw region (Error.UnboundTypeVar name free)
368+ else Result.throw region (Error.UnboundTypeVar name free)
369 in
369 in
370 F.traverse_ check (freeVars tipe)
370 F.traverse_ check (freeVars tipe)
371
371