git.iko.soy/elk
on master help sign in
Shuffle code to make Elm.Compiler work again
2277745Evan Czaplicki
src/Compile.hs+48−4
compare with master
unifiedsplit
@@ -1,6 +1,8 @@
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2module Compile
2module Compile
3+ ( DocsFlag(..)
3− ( compile
4+ , compile
5+ , Artifacts(..)
4 )
6 )
5 where
7 where
6
8
@@ -12,6 +14,7 @@ import qualified AST.Canonical as Can
12import qualified AST.Optimized as Opt
14import qualified AST.Optimized as Opt
13import qualified AST.Module.Name as ModuleName
15import qualified AST.Module.Name as ModuleName
14import qualified Canonicalize.Module as Canonicalize
16import qualified Canonicalize.Module as Canonicalize
17+import qualified Elm.Docs as Docs
15import qualified Elm.Interface as I
18import qualified Elm.Interface as I
16import qualified Elm.Name as N
19import qualified Elm.Name as N
17import qualified Elm.Package as Pkg
20import qualified Elm.Package as Pkg
@@ -40,8 +43,16 @@ type ImportDict =
40 Map.Map N.Name ModuleName.Canonical
43 Map.Map N.Name ModuleName.Canonical
41
44
42
45
46+data Artifacts =
47+ Artifacts
48+ { _elmi :: I.Interface
49+ , _elmo :: Opt.Graph
50+ , _docs :: Maybe Docs.Module
51+ }
52+
53+
43−compile :: Pkg.Name -> ImportDict -> I.Interfaces -> BS.ByteString -> Result i (I.Interface, Opt.Graph)
54+compile :: DocsFlag -> Pkg.Name -> ImportDict -> I.Interfaces -> BS.ByteString -> Result i Artifacts
44−compile pkg importDict interfaces source =
55+compile flag pkg importDict interfaces source =
45 do
56 do
46 valid <- Result.mapError Error.Syntax $
57 valid <- Result.mapError Error.Syntax $
47 Parse.program source
58 Parse.program source
@@ -60,7 +71,19 @@ compile pkg importDict interfaces source =
60
71
61 let (Optimize.Graph fields graph) = Optimize.optimize canonical
72 let (Optimize.Graph fields graph) = Optimize.optimize canonical
62
73
74+ documentation <-
75+ genaretaDocs flag canonical
76+
77+ Result.ok $
78+ Artifacts
63− Result.ok (I.fromModule annotations canonical, Opt.Graph mains graph fields)
79+ { _elmi = I.fromModule annotations canonical
80+ , _elmo = Opt.Graph mains graph fields
81+ , _docs = documentation
82+ }
83+
84+
85+
86+-- TYPE INFERENCE
64
87
65
88
66runTypeInference :: Can.Module -> Result i (Map.Map N.Name Can.Annotation)
89runTypeInference :: Can.Module -> Result i (Map.Map N.Name Can.Annotation)
@@ -73,6 +96,10 @@ runTypeInference canonical =
73 Result.ok annotations
96 Result.ok annotations
74
97
75
98
99+
100+-- EXHAUSTIVENESS CHECK
101+
102+
76exhaustivenessCheck :: Can.Module -> Result i ()
103exhaustivenessCheck :: Can.Module -> Result i ()
77exhaustivenessCheck canonical =
104exhaustivenessCheck canonical =
78 case PatternMatches.check canonical of
105 case PatternMatches.check canonical of
@@ -81,3 +108,20 @@ exhaustivenessCheck canonical =
81
108
82 Right () ->
109 Right () ->
83 Result.ok ()
110 Result.ok ()
111+
112+
113+
114+-- DOCUMENTATION
115+
116+
117+data DocsFlag = YesDocs | NoDocs
118+
119+
120+genaretaDocs :: DocsFlag -> Can.Module -> Result.Result i w Error.Error (Maybe Docs.Module)
121+genaretaDocs flag modul =
122+ case flag of
123+ NoDocs ->
124+ Result.ok Nothing
125+
126+ YesDocs ->
127+ Just <$> Docs.fromModule modul
src/Elm/Compiler.hs+39−85
@@ -1,36 +1,31 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Elm.Compiler
2module Elm.Compiler
3 ( version
3 ( version
4− , compile, Context(..), Result(..)
4+ , Context(..)
5− , generate, JS.Target(..)
5+ , Compile.Artifacts(..)
6+ , compile
7+ , Localizer
6− , Localizer, dummyLocalizer
8+ , dummyLocalizer
9+ , Error.Error
10+ , errorToDoc
7− , I.Error, errorToDoc, errorToJson
11+ , errorToJson
12+ , Warning.Warning
13+ , warningToDoc
8− , I.Warning, warningToDoc, warningToJson
14+ , warningToJson
9 )
15 )
10 where
16 where
11
17
12import qualified Data.Aeson as Json
18import qualified Data.Aeson as Json
19+import qualified Data.ByteString as BS
13import qualified Data.Map as Map
20import qualified Data.Map as Map
14−import Data.Text (Text)
15−import qualified Data.ByteString.Builder as BS
16import Text.PrettyPrint.ANSI.Leijen (Doc)
21import Text.PrettyPrint.ANSI.Leijen (Doc)
17
22
18−import qualified AST.Module as Module
19−import qualified AST.Module.Name as ModuleName
20import qualified Compile
23import qualified Compile
21−import qualified Docs.Check as Docs
22−import qualified Elm.Compiler.Internals as I
23import qualified Elm.Compiler.Module as M
24import qualified Elm.Compiler.Module as M
24−import qualified Elm.Compiler.Objects.Internal as Obj
25import qualified Elm.Compiler.Version
25import qualified Elm.Compiler.Version
26−import qualified Elm.Docs as Docs
26+import qualified Elm.Package as Pkg
27−import qualified Elm.Package as Package
28−import qualified Generate.JavaScript as JS
29−import qualified Reporting.Annotation as A
30−import qualified Reporting.Bag as Bag
31import qualified Reporting.Error as Error
27import qualified Reporting.Error as Error
32import qualified Reporting.Render.Type as RenderType
28import qualified Reporting.Render.Type as RenderType
33−import qualified Reporting.Report as Report
34import qualified Reporting.Result as Result
29import qualified Reporting.Result as Result
35import qualified Reporting.Warning as Warning
30import qualified Reporting.Warning as Warning
36
31
@@ -39,75 +34,34 @@ import qualified Reporting.Warning as Warning
39-- VERSION
34-- VERSION
40
35
41
36
42−version :: Package.Version
37+version :: Pkg.Version
43version =
38version =
44 Elm.Compiler.Version.version
39 Elm.Compiler.Version.version
45
40
46
41
47
42
48−-- COMPILATION
43+-- COMPILE
49−
50−
51−{-| Compiles Elm source code to JavaScript. -}
52−compile :: Context -> Text -> (Localizer, [I.Warning], Either [I.Error] Result)
53−compile (Context packageName exposed importDict interfaces) source =
54− let
55− (Result.Result oneLocalizer warnings answer) =
56− do modul <- Compile.compile packageName importDict interfaces source
57− docs <- Result.format id (docsGen exposed modul)
58−
59− let iface = Module.toInterface modul
60− let objs = Obj.fromModule modul
61−
62− return (Result docs iface objs)
63− in
64− ( Result.oneToValue dummyLocalizer Localizer oneLocalizer
65− , Bag.toList I.Warning warnings
66− , Result.answerToEither I.Error id answer
67− )
68
44
69
45
70data Context =
46data Context =
71 Context
47 Context
72− { _package :: Package.Name
48+ { _package :: Pkg.Name
73 , _exposed :: Bool
49 , _exposed :: Bool
74 , _imports :: Map.Map M.Raw M.Canonical
50 , _imports :: Map.Map M.Raw M.Canonical
75 , _interfaces :: M.Interfaces
51 , _interfaces :: M.Interfaces
76 }
52 }
77
53
78
54
79−data Result =
55+compile :: Context -> BS.ByteString -> (Localizer, [Warning.Warning], Either [Error.Error] Compile.Artifacts)
80− Result
56+compile (Context pkg exposed importDict interfaces) source =
81− { _docs :: Maybe Docs.Module
57+ let
82− , _iface :: M.Interface
58+ docsFlag =
83− , _objs :: Obj.Graph
59+ if exposed then Compile.YesDocs else Compile.NoDocs
84− }
85−
86−
87−
88−-- DOCUMENTATION
89−
90−
91−docsGen :: Bool -> Module.Optimized -> Result.Result () w Error.Error (Maybe Docs.Module)
92−docsGen isExposed (Module.Module name info) =
93− if not isExposed then
94− Result.ok Nothing
95−
96− else
97− let
98− toDocs checked =
99− Just (Docs.Module (ModuleName._module name) checked)
100− in
101− toDocs <$> Docs.check (Module.exports info) (Module.docs info)
102−
103−
104−
105−-- CODE GENERATION
106−
107
60
108−generate :: Bool -> JS.Target -> Obj.Graph -> Obj.Roots -> BS.Builder
61+ (warnings, errorOrArtifacts) =
109−generate =
62+ Result.run $ Compile.compile docsFlag pkg importDict interfaces source
110− JS.generate
63+ in
64+ ( dummyLocalizer, warnings, errorOrArtifacts )
111
65
112
66
113
67
@@ -115,37 +69,37 @@ generate =
115
69
116
70
117newtype Localizer =
71newtype Localizer =
118− Localizer RenderType.Localizer
72+ Localizer RenderType.Localizer
119
73
120
74
121dummyLocalizer :: Localizer
75dummyLocalizer :: Localizer
122dummyLocalizer =
76dummyLocalizer =
123− Localizer Map.empty
77+ Localizer Map.empty
124
78
125
79
126
80
127-- ERRORS
81-- ERRORS
128
82
129
83
130−errorToDoc :: Localizer -> String -> Text -> I.Error -> Doc
84+errorToDoc :: Localizer -> String -> String -> Error.Error -> Doc
131−errorToDoc (Localizer localizer) location source (I.Error (A.A region err)) =
85+errorToDoc (Localizer localizer) location source err =
132− Report.toDoc location region (Error.toReport localizer err) source
86+ error "TODO Report.toDoc" location (Error.toReport localizer err) source
133
87
134
88
135−errorToJson :: Localizer -> String -> I.Error -> Json.Value
89+errorToJson :: Localizer -> String -> Error.Error -> Json.Value
136−errorToJson (Localizer localizer) location (I.Error err) =
90+errorToJson (Localizer localizer) location err =
137− Error.toJson localizer location err
91+ error "TODO Error.toJson" localizer location err
138
92
139
93
140
94
141-- WARNINGS
95-- WARNINGS
142
96
143
97
144−warningToDoc :: Localizer -> String -> Text -> I.Warning -> Doc
98+warningToDoc :: Localizer -> String -> String -> Warning.Warning -> Doc
145−warningToDoc (Localizer localizer) location source (I.Warning (A.A region wrn)) =
99+warningToDoc (Localizer localizer) location source warning =
146− Report.toDoc location region (Warning.toReport localizer wrn) source
100+ error "TODO Report.toDoc" location (Warning.toReport localizer warning) source
147
101
148
102
149−warningToJson :: Localizer -> String -> I.Warning -> Json.Value
103+warningToJson :: Localizer -> String -> Warning.Warning -> Json.Value
150−warningToJson (Localizer localizer) location (I.Warning wrn) =
104+warningToJson (Localizer localizer) location warning =
151− Warning.toJson localizer location wrn
105+ error "TODO Warning.toJson" localizer location warning
src/Elm/Compiler/Objects.hs+8−6
@@ -1,6 +1,8 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Elm.Compiler.Objects
2module Elm.Compiler.Objects
3+ ( JS.Mode(..)
4+ , JS.generate
3− ( Gen.Roots
5+ , JS.Roots
4 , mains
6 , mains
5 , value
7 , value
6 , Opt.Graph
8 , Opt.Graph
@@ -18,21 +20,21 @@ import qualified Data.Text as Text
18
20
19import qualified AST.Optimized as Opt
21import qualified AST.Optimized as Opt
20import qualified AST.Module.Name as ModuleName
22import qualified AST.Module.Name as ModuleName
21−import qualified Generate.JavaScript as Gen
23+import qualified Generate.JavaScript as JS
22
24
23
25
24
26
25-- ROOTS
27-- ROOTS
26
28
27
29
28−mains :: [ModuleName.Canonical] -> Gen.Roots
30+mains :: [ModuleName.Canonical] -> JS.Roots
29mains =
31mains =
30− Gen.Mains
32+ JS.Mains
31
33
32
34
33−value :: ModuleName.Canonical -> String -> Gen.Roots
35+value :: ModuleName.Canonical -> String -> JS.Roots
34value home name =
36value home name =
35− Gen.Value home (Text.pack name)
37+ JS.Value home (Text.pack name)
36
38
37
39
38
40
src/Elm/Docs.hs+3−3
@@ -4,7 +4,7 @@ module Elm.Docs
4 ( Documentation
4 ( Documentation
5 , toDict
5 , toDict
6 , Module(..)
6 , Module(..)
7− , fromCanonical
7+ , fromModule
8 , Union(..)
8 , Union(..)
9 , Alias(..)
9 , Alias(..)
10 , Value(..)
10 , Value(..)
@@ -270,8 +270,8 @@ precDecoder =
270-- FROM MODULE
270-- FROM MODULE
271
271
272
272
273−fromCanonical :: Can.Module -> Result.Result i w Error.Error Module
273+fromModule :: Can.Module -> Result.Result i w Error.Error Module
274−fromCanonical (Can.Module name docs exports decls unions aliases binops effects) =
274+fromModule (Can.Module name docs exports decls unions aliases binops effects) =
275 case exports of
275 case exports of
276 Can.ExportEverything ->
276 Can.ExportEverything ->
277 Result.throw $ Error.Docs $ E.ImplicitExposing
277 Result.throw $ Error.Docs $ E.ImplicitExposing
src/Generate/JavaScript.hs+27−22
@@ -1,8 +1,9 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript
3module Generate.JavaScript
4− ( generate
4+ ( Mode(..)
5 , Roots(..)
5 , Roots(..)
6+ , generate
6 )
7 )
7 where
8 where
8
9
@@ -28,29 +29,34 @@ import qualified Generate.JavaScript.Name as Name
28-- GENERATE
29-- GENERATE
29
30
30
31
32+data Mode = Debug | Prod
33+
34+
31data Roots
35data Roots
32 = Mains [ModuleName.Canonical]
36 = Mains [ModuleName.Canonical]
33 | Value ModuleName.Canonical N.Name
37 | Value ModuleName.Canonical N.Name
34
38
35
39
36−generate :: Bool -> Name.Target -> Opt.Graph -> Roots -> Either [ModuleName.Canonical] B.Builder
40+generate :: Mode -> Name.Target -> Opt.Graph -> Roots -> Either [ModuleName.Canonical] B.Builder
37−generate debug target (Opt.Graph mains nodes fields) roots =
41+generate mode target (Opt.Graph mains nodes fields) roots =
38 case roots of
42 case roots of
39 Value home name ->
43 Value home name ->
40 Right $ stateToBuilder $
44 Right $ stateToBuilder $
41− addGlobal (toMode debug target fields) nodes emptyState (Opt.Global home name)
45+ addGlobal (toRealMode mode target fields) nodes emptyState (Opt.Global home name)
42
46
43 Mains modules ->
47 Mains modules ->
44− generateMain (toMode debug target fields) nodes
48+ generateMain (toRealMode mode target fields) nodes
45 <$> verifyMains mains modules
49 <$> verifyMains mains modules
46
50
47
51
48−toMode :: Bool -> Name.Target -> Map.Map N.Name Int -> Name.Mode
52+toRealMode :: Mode -> Name.Target -> Map.Map N.Name Int -> Name.Mode
49−toMode debug target fields =
53+toRealMode mode target fields =
50− if debug then
54+ case mode of
55+ Debug ->
51− Name.Debug target
56+ Name.Debug target
52− else
57+
58+ Prod ->
53− Name.Prod target (Name.shortenFieldNames fields)
59+ Name.Prod target (Name.shortenFieldNames fields)
54
60
55
61
56
62
@@ -78,11 +84,10 @@ stateToBuilder (State revBuilders _) =
78-- ADD DEPENDENCIES
84-- ADD DEPENDENCIES
79
85
80
86
81−type Mode = Name.Mode
82type Graph = Map.Map Opt.Global Opt.Node
87type Graph = Map.Map Opt.Global Opt.Node
83
88
84
89
85−addGlobal :: Mode -> Graph -> State -> Opt.Global -> State
90+addGlobal :: Name.Mode -> Graph -> State -> Opt.Global -> State
86addGlobal mode graph state@(State builders seen) global =
91addGlobal mode graph state@(State builders seen) global =
87 if Set.member global seen then
92 if Set.member global seen then
88 state
93 state
@@ -91,7 +96,7 @@ addGlobal mode graph state@(State builders seen) global =
91 State builders (Set.insert global seen)
96 State builders (Set.insert global seen)
92
97
93
98
94−addGlobalHelp :: Mode -> Graph -> Opt.Global -> State -> State
99+addGlobalHelp :: Name.Mode -> Graph -> Opt.Global -> State -> State
95addGlobalHelp mode graph global state =
100addGlobalHelp mode graph global state =
96 let
101 let
97 addDeps deps someState =
102 addDeps deps someState =
@@ -163,7 +168,7 @@ var (Opt.Global home name) code =
163-- GENERATE CYCLES
168-- GENERATE CYCLES
164
169
165
170
166−generateCycle :: Mode -> Opt.Global -> [(N.Name, Opt.Expr)] -> JS.Stmt
171+generateCycle :: Name.Mode -> Opt.Global -> [(N.Name, Opt.Expr)] -> JS.Stmt
167generateCycle mode (Opt.Global home _) cycle =
172generateCycle mode (Opt.Global home _) cycle =
168 let
173 let
169 safeDefs = map (generateSafeCycle mode home) cycle
174 safeDefs = map (generateSafeCycle mode home) cycle
@@ -173,7 +178,7 @@ generateCycle mode (Opt.Global home _) cycle =
173 JS.Block (safeDefs ++ realDefs)
178 JS.Block (safeDefs ++ realDefs)
174
179
175
180
176−generateSafeCycle :: Mode -> ModuleName.Canonical -> (N.Name, Opt.Expr) -> JS.Stmt
181+generateSafeCycle :: Name.Mode -> ModuleName.Canonical -> (N.Name, Opt.Expr) -> JS.Stmt
177generateSafeCycle mode home (name, expr) =
182generateSafeCycle mode home (name, expr) =
178 JS.FunctionStmt (Name.fromCycle home name) [] $
183 JS.FunctionStmt (Name.fromCycle home name) [] $
179 Expr.codeToStmtList (Expr.generate mode expr)
184 Expr.codeToStmtList (Expr.generate mode expr)
@@ -196,12 +201,12 @@ generateRealCycle home (name, _) =
196-- GENERATE KERNEL
201-- GENERATE KERNEL
197
202
198
203
199−generateKernel :: Mode -> [Opt.KChunk] -> B.Builder
204+generateKernel :: Name.Mode -> [Opt.KChunk] -> B.Builder
200generateKernel mode chunks =
205generateKernel mode chunks =
201 List.foldl' (addChunk mode) mempty chunks
206 List.foldl' (addChunk mode) mempty chunks
202
207
203
208
204−addChunk :: Mode -> B.Builder -> Opt.KChunk -> B.Builder
209+addChunk :: Name.Mode -> B.Builder -> Opt.KChunk -> B.Builder
205addChunk mode builder chunk =
210addChunk mode builder chunk =
206 case chunk of
211 case chunk of
207 Opt.JS javascript ->
212 Opt.JS javascript ->
@@ -240,7 +245,7 @@ addChunk mode builder chunk =
240-- GENERATE PORTS
245-- GENERATE PORTS
241
246
242
247
243−generatePort :: Mode -> Opt.Global -> N.Name -> Opt.Expr -> JS.Stmt
248+generatePort :: Name.Mode -> Opt.Global -> N.Name -> Opt.Expr -> JS.Stmt
244generatePort mode (Opt.Global home name) makePort converter =
249generatePort mode (Opt.Global home name) makePort converter =
245 let
250 let
246 definition =
251 definition =
@@ -257,7 +262,7 @@ generatePort mode (Opt.Global home name) makePort converter =
257
262
258
263
259
264
260−generateManager :: Mode -> Graph -> Opt.Global -> Opt.EffectsType -> State -> State
265+generateManager :: Name.Mode -> Graph -> Opt.Global -> Opt.EffectsType -> State -> State
261generateManager mode graph (Opt.Global home@(ModuleName.Canonical _ moduleName) _) effectsType state =
266generateManager mode graph (Opt.Global home@(ModuleName.Canonical _ moduleName) _) effectsType state =
262 let
267 let
263 managerLVar =
268 managerLVar =
@@ -327,7 +332,7 @@ type Mains =
327 Map.Map ModuleName.Canonical Opt.Main
332 Map.Map ModuleName.Canonical Opt.Main
328
333
329
334
330−generateMain :: Mode -> Graph -> Mains -> B.Builder
335+generateMain :: Name.Mode -> Graph -> Mains -> B.Builder
331generateMain mode graph mains =
336generateMain mode graph mains =
332 mconcat
337 mconcat
333 [ stateToBuilder $ Map.foldrWithKey (addMain mode graph) emptyState mains
338 [ stateToBuilder $ Map.foldrWithKey (addMain mode graph) emptyState mains
@@ -335,7 +340,7 @@ generateMain mode graph mains =
335 ]
340 ]
336
341
337
342
338−addMain :: Mode -> Graph -> ModuleName.Canonical -> main -> State -> State
343+addMain :: Name.Mode -> Graph -> ModuleName.Canonical -> main -> State -> State
339addMain mode graph home _ state =
344addMain mode graph home _ state =
340 addGlobal mode graph state (Opt.Global home "main")
345 addGlobal mode graph state (Opt.Global home "main")
341
346
src/Reporting/Result.hs+2−2
@@ -33,10 +33,10 @@ newtype Result info warnings error a =
33 )
33 )
34
34
35
35
36−run :: Result () [w] e a -> ([w], Either (OneOrMore.OneOrMore e) a)
36+run :: Result () [w] e a -> ([w], Either [e] a)
37run (Result k) =
37run (Result k) =
38 k () []
38 k () []
39− (\() w e -> (reverse w, Left e))
39+ (\() w e -> (reverse w, Left (OneOrMore.toList e)))
40 (\() w a -> (reverse w, Right a))
40 (\() w a -> (reverse w, Right a))
41
41
42
42