@@ -8,7 +8,6 @@ import qualified Data.Traversable as T
88import qualified Data.Foldable as T
99
1010import AST.Expression.General (Expr'(..), dummyLet)
11−import AST.Module (Body(..))
1211import Elm.Utils ((|>))
1312
1413import qualified AST.Declaration as D
@@ -19,7 +18,6 @@ import qualified AST.Module.Name as ModuleName
1918import qualified AST.Pattern as P
2019import qualified AST.Type as Type
2120import qualified AST.Variable as Var
22−import qualified Docs.AST as Docs
2321import qualified Docs.Centralize as Docs
2422import qualified Reporting.Annotation as A
2523import qualified Reporting.Error as Error
@@ -37,115 +35,105 @@ import qualified Canonicalize.Type as Canonicalize
3735import qualified Canonicalize.Variable as Canonicalize
3836
3937
38+
4039-- MODULES
4140
41+
4242module'
4343 :: [ModuleName.Canonical]
4444 -> Module.Interfaces
45− -> Module.ValidModule
46− -> R.Result Warning.Warning Error.Error Module.CanonicalModule
45+ -> Module.Valid
46+ -> R.Result Warning.Warning Error.Error Module.Canonical
4747module' canonicalImports interfaces modul =
4848 let
49+ (Module.Valid docs exports imports decls effects) =
50+ Module.info modul
51+
4952 importDict =
5053 canonicalImports
5154 |> map (\cName -> (ModuleName._module cName, cName))
5255 |> Map.fromList
5356
57+ canonicalDeclsResult =
58+ Setup.environment importDict interfaces modul
59+ `Result.andThen` \env -> (,) env <$> T.traverse (declaration env) decls
60+
5461 (Result.Result uses rawResults) =
55− moduleHelp importDict interfaces modul
62+ (,)
63+ <$> canonicalDeclsResult
64+ <*> resolveExports (concatMap declToValue decls) exports
5665 in
57− case rawResults of
58− Result.Ok (env, almostCanonicalModule) ->
59− R.addDealiaser (Env.toDealiaser env) $
60− filterImports uses almostCanonicalModule
66+ case rawResults of
67+ Result.Err msgs ->
68+ R.throwMany (map (A.map Error.Canonicalize) msgs)
6169
62− Result.Err msgs ->
63− R.throwMany (map (A.map Error.Canonicalize) msgs)
70+ Result.Ok ((env, canonicalDecls), canonicalExports) ->
71+ let
72+ nakedDecls =
73+ map A.drop canonicalDecls
6474
75+ centralizedDocs =
76+ A.map (fmap (Docs.centralize canonicalDecls)) docs
6577
66−type AlmostCanonicalModule =
67− Module.Module
68− Docs.Centralized
69− ([Module.DefaultImport], [Module.UserImport])
70− [Var.Value]
71− (Module.Body Canonical.Expr)
78+ program =
79+ Sort.definitions (dummyLet (Decls.toExpr (Module.name modul) canonicalDecls))
7280
81+ fixities =
82+ [ (assoc,level,op) | D.Fixity assoc level op <- nakedDecls ]
7383
74−moduleHelp
75− :: Map.Map ModuleName.Raw ModuleName.Canonical
76− -> Module.Interfaces
77− -> Module.ValidModule
78− -> Result.ResultErr (Env.Environment, AlmostCanonicalModule)
79−moduleHelp importDict interfaces modul@(Module.Module _ _ _ comment exports _ decls) =
80− canonicalModule
81− <$> canonicalDeclsResult
82− <*> resolveExports locals exports
83− where
84− canonicalModule (env, canonicalDecls) canonicalExports =
85− (,) env $
86− modul
87− { Module.docs = A.map (fmap (Docs.centralize canonicalDecls)) comment
88− , Module.exports = canonicalExports
89− , Module.body = body canonicalDecls
90− }
91−
92− locals :: [Var.Value]
93− locals =
94− concatMap declToValue decls
84+ aliases =
85+ Map.fromList [ (name,(tvs,alias)) | D.Alias name tvs alias <- nakedDecls ]
9586
96− canonicalDeclsResult =
97− Setup.environment importDict interfaces modul
98− `Result.andThen` \env -> (,) env <$> T.traverse (declaration env) decls
99−
100− body :: [D.CanonicalDecl] -> Module.Body Canonical.Expr
101− body decls =
102− let nakedDecls = map A.drop decls
87+ unions =
88+ Map.fromList [ (name,(vars,ctors)) | D.Union name vars ctors <- nakedDecls ]
10389 in
104− Module.Body
105− { program =
106− let expr = Decls.toExpr (Module.name modul) decls
107− in
108− Sort.definitions (dummyLet expr)
109−
110− , types =
111− Map.empty
112−
113− , unions =
114− Map.fromList [ (name,(vars,ctors)) | D.Datatype name vars ctors <- nakedDecls ]
90+ R.addDealiaser (Env.toDealiaser env) $
91+ do canonicalImports <- filterImports uses imports
92+ return $ modul {
93+ Module.info =
94+ Module.Info
95+ { Module.docs = centralizedDocs
96+ , Module.exports = canonicalExports
97+ , Module.imports = canonicalImports
98+ , Module.program = program
99+ , Module.types = Map.empty
100+ , Module.fixities = fixities
101+ , Module.aliases = aliases
102+ , Module.unions = unions
103+ , Module.effects = error "TODO"
104+ }
105+ }
115106
116− , fixities =
117− [ (assoc,level,op) | D.Fixity assoc level op <- nakedDecls ]
118−
119− , aliases =
120− Map.fromList [ (name,(tvs,alias)) | D.TypeAlias name tvs alias <- nakedDecls ]
121− }
122107
123108
124109-- IMPORTS
125110
111+
126112filterImports
127113 :: Set.Set ModuleName.Raw
128− -> AlmostCanonicalModule
129− -> R.Result Warning.Warning e Module.CanonicalModule
130−filterImports uses modul@(Module.Module _ _ _ _ _ (defaults, imports) _) =
131− do reducedImports <-
132− Maybe.catMaybes <$> T.traverse checkImport imports
133−
134− return $ modul
135− { Module.imports =
136− Set.toList (Set.fromList (map fst defaults ++ reducedImports))
137− }
138− where
114+ -> ([Module.DefaultImport], [Module.UserImport])
115+ -> R.Result Warning.Warning e [ModuleName.Raw]
116+filterImports uses (defaults, imports) =
117+ let
139118 checkImport (A.A region (name, _method)) =
140119 if Set.member name uses then
141− return (Just name)
120+ return (Just name)
121+
142122 else
143− do R.warn region (Warning.UnusedImport name)
144− return Nothing
123+ do R.warn region (Warning.UnusedImport name)
124+ return Nothing
125+ in
126+ do reducedImports <-
127+ Maybe.catMaybes <$> T.traverse checkImport imports
128+
129+ return $
130+ Set.toList (Set.fromList (map fst defaults ++ reducedImports))
131+
145132
146133
147134-- EXPORTS
148135
136+
149137resolveExports
150138 :: [Var.Value]
151139 -> Var.Listing (A.Located Var.Value)
@@ -153,6 +141,7 @@ resolveExports
153141resolveExports fullList (Var.Listing partialList open) =
154142 if open then
155143 Result.ok fullList
144+
156145 else
157146 let
158147 (allValues, allAliases, allAdts) =
@@ -259,8 +248,10 @@ allUnique statedExports =
259248 T.traverse_ id (Map.mapWithKey isUnique locations)
260249
261250
251+
262252-- GROUPING VALUES
263253
254+
264255maybeUnzip3 :: [(Maybe a, Maybe b, Maybe c)] -> ([a],[b],[c])
265256maybeUnzip3 tuples =
266257 let (as, bs, cs) = unzip3 tuples
@@ -304,16 +295,16 @@ splitLocatedValue (A.A region value) =
304295
305296-- DECLARATIONS
306297
307−declToValue :: D.ValidDecl -> [Var.Value]
298+declToValue :: D.Valid -> [Var.Value]
308299declToValue (A.A _ decl) =
309300 case decl of
310− D.Definition (Valid.Definition pattern _ _) ->
301+ D.Def (Valid.Definition pattern _ _) ->
311302 map Var.Value (P.boundVarList pattern)
312303
313− D.Datatype name _tvs ctors ->
304+ D.Union name _tvs ctors ->
314305 [ Var.Union name (Var.Listing (map fst ctors) False) ]
315306
316− D.TypeAlias name _ tipe ->
307+ D.Alias name _ tipe ->
317308 case tipe of
318309 A.A _ (Type.RRecord _ Nothing) ->
319310 [ Var.Alias name, Var.Value name ]
@@ -324,29 +315,26 @@ declToValue (A.A _ decl) =
324315 _ -> []
325316
326317
327−declaration
328− :: Env.Environment
329− -> D.ValidDecl
330− -> Result.ResultErr D.CanonicalDecl
331−declaration env (A.A ann@(region,_) decl) =
332− A.A ann <$>
318+declaration :: Env.Environment -> D.Valid -> Result.ResultErr D.Canonical
319+declaration env (A.A ann decl) =
320+ A.A ann <$>
333321 case decl of
334− D.Definition (Valid.Definition pat expr typ) ->
335− D.Definition <$> (
322+ D.Def (Valid.Definition pat expr typ) ->
323+ D.Def <$> (
336324 Canonical.Definition Canonical.dummyFacts
337325 <$> pattern env pat
338326 <*> expression env expr
339327 <*> T.traverse (regionType env) typ
340328 )
341329
342− D.Datatype name tvars ctors ->
343− D.Datatype name tvars <$> T.traverse canonicalize' ctors
330+ D.Union name tvars ctors ->
331+ D.Union name tvars <$> T.traverse canonicalizeArgs ctors
344332 where
345− canonicalize' (ctor,args) =
333+ canonicalizeArgs (ctor, args) =
346334 (,) ctor <$> T.traverse (Canonicalize.tipe env) args
347335
348− D.TypeAlias name tvars expanded ->
349− D.TypeAlias name tvars
336+ D.Alias name tvars expanded ->
337+ D.Alias name tvars
350338 <$> Canonicalize.tipe env expanded
351339
352340 D.Fixity assoc prec op ->
@@ -442,10 +430,7 @@ expression env (A.A region validExpr) =
442430 Result.ok (GLShader uid src tipe)
443431
444432
445−pattern
446− :: Env.Environment
447− -> P.RawPattern
448− -> Result.ResultErr P.CanonicalPattern
433+pattern :: Env.Environment -> P.Raw -> Result.ResultErr P.Canonical
449434pattern env (A.A region ptrn) =
450435 A.A region <$>
451436 case ptrn of