git.iko.soy/elk
on master help sign in
Get Elm.Header working again
1b0a3bfEvan Czaplicki
src/AST/Source.hs+11−23
compare with master
unifiedsplit
@@ -1,5 +1,4 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
3module AST.Source
2module AST.Source
4 ( Expr, Expr_(..)
3 ( Expr, Expr_(..)
5 , Decl, Decl_(..)
4 , Decl, Decl_(..)
@@ -7,10 +6,10 @@ module AST.Source
7 , Pattern, Pattern_(..)
6 , Pattern, Pattern_(..)
8 , Type, Type_(..)
7 , Type, Type_(..)
9 , Module(..)
8 , Module(..)
9+ , Header(..)
10 , Import(..)
10 , Import(..)
11 , Effects(..)
11 , Effects(..)
12 , Manager(..)
12 , Manager(..)
13− , defaultModule
14 , Exposing(..)
13 , Exposing(..)
15 , Exposed(..)
14 , Exposed(..)
16 , Privacy(..)
15 , Privacy(..)
@@ -130,14 +129,16 @@ data Decl_
130
129
131
130
132data Module decls =
131data Module decls =
133− Module
132+ Module (Maybe Header) [Import] decls
133+
134+
135+data Header
136+ = Header
134− { _name :: N.Name
137+ { _name :: N.Name
135− , _effects :: Effects
138+ , _effects :: Effects
139+ , _exports :: Exposing
136− , _docs :: A.Located (Maybe B.ByteString)
140+ , _docs :: A.Located (Maybe B.ByteString)
137− , _exports :: Exposing
138− , _imports :: [Import]
139− , _decls :: decls
140− }
141+ }
141
142
142
143
143data Import =
144data Import =
@@ -160,19 +161,6 @@ data Manager
160 | Fx (A.Located N.Name) (A.Located N.Name)
161 | Fx (A.Located N.Name) (A.Located N.Name)
161
162
162
163
163−defaultModule :: [Import] -> decls -> Module decls
164−defaultModule imports decls =
165− let zero = R.Position 1 1 in
166− Module
167− { _name = "Main"
168− , _effects = NoEffects
169− , _docs = A.at zero zero Nothing
170− , _exports = Open
171− , _imports = imports
172− , _decls = decls
173− }
174−
175−
176
164
177-- EXPOSING
165-- EXPOSING
178
166
src/AST/Valid.hs+23
@@ -1,4 +1,5 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE OverloadedStrings #-}
2module AST.Valid
3module AST.Valid
3 ( Expr, Expr_(..)
4 ( Expr, Expr_(..)
4 , Def(..)
5 , Def(..)
@@ -10,6 +11,7 @@ module AST.Valid
10 , Effects(..)
11 , Effects(..)
11 , Port(..)
12 , Port(..)
12 , Manager(..)
13 , Manager(..)
14+ , defaultModule
13 )
15 )
14 where
16 where
15
17
@@ -104,3 +106,24 @@ data Manager
104
106
105
107
106data Port = Port (A.Located N.Name) Src.Type
108data Port = Port (A.Located N.Name) Src.Type
109+
110+
111+defaultModule :: Map.Map N.Name Text -> [Src.Import] -> [A.Located Decl] -> [Union] -> [Alias] -> [Binop] -> Module
112+defaultModule docs imports decls unions aliases binop =
113+ Module
114+ { _name = "Main"
115+ , _overview = A.At zero Nothing
116+ , _docs = docs
117+ , _exports = Src.Open
118+ , _imports = imports
119+ , _decls = decls
120+ , _unions = unions
121+ , _aliases = aliases
122+ , _binop = binop
123+ , _effects = NoEffects
124+ }
125+
126+
127+zero :: R.Region
128+zero =
129+ R.Region (R.Position 1 1) (R.Position 1 1)
src/Elm/Header.hs+64−35
@@ -6,15 +6,15 @@ module Elm.Header
6 where
6 where
7
7
8
8
9−import Data.Text (Text)
9+import qualified Data.ByteString as B
10
10
11−import qualified AST.Module as Module
11+import qualified AST.Source as Src
12import qualified Elm.Compiler.Imports as Imports
12import qualified Elm.Compiler.Imports as Imports
13−import qualified Elm.Compiler.Internals as I
14import qualified Elm.Compiler.Module as M
13import qualified Elm.Compiler.Module as M
15−import qualified Elm.Package as Package
14+import qualified Elm.Name as N
15+import qualified Elm.Package as Pkg
16−import qualified Parse.Helpers as Parse (run)
16+import qualified Parse.Primitives as Parser
17−import qualified Parse.Module as Parse (header)
17+import qualified Parse.Module as Module
18import qualified Reporting.Annotation as A
18import qualified Reporting.Annotation as A
19import qualified Reporting.Error as Error
19import qualified Reporting.Error as Error
20
20
@@ -30,34 +30,63 @@ data Tag = Normal | Effect | Port
30-- PARSE
30-- PARSE
31
31
32
32
33−parse :: Package.Name -> Text -> Either I.Error (Maybe (Tag, M.Raw), [M.Raw])
33+parse :: Pkg.Name -> B.ByteString -> Either Error.Error (Maybe (Tag, M.Raw), [M.Raw])
34−parse pkgName sourceCode =
34+parse pkg sourceCode =
35− case Parse.run Parse.header sourceCode of
35+ case Parser.run chompHeader sourceCode of
36− Right header ->
36+ Right (Src.Module header imports _) ->
37− Right $ toSummary pkgName header
37+ Right
38+ ( fmap simplifyHeader header
39+ , toDeps pkg imports
40+ )
38
41
39 Left err ->
42 Left err ->
40− Left (I.Error (A.map Error.Syntax err))
43+ Left (Error.Syntax err)
41−
44+
42−
45+
43−toSummary :: Package.Name -> Module.Header [Module.UserImport] -> (Maybe (Tag, M.Raw), [M.Raw])
46+chompHeader :: Parser.Parser (Src.Module ())
44−toSummary pkgName (Module.Header maybeHeaderDecl imports) =
47+chompHeader =
45− let
48+ Module.module_ $ return ()
46− dependencies =
49+
47− if pkgName == Package.core
50+
51+
52+-- TO DEPS
53+
54+
55+toDeps :: Pkg.Name -> [Src.Import] -> [N.Name]
56+toDeps pkg imports =
57+ if pkg == Pkg.core
48− then map (A.drop . fst . A.drop) imports
58+ then map getName imports
59+ else map getName imports ++ defaultImports
60+
61+
62+getName :: Src.Import -> N.Name
63+getName (Src.Import (A.At _ name) _ _) =
64+ name
65+
66+
67+{-# NOINLINE defaultImports #-}
68+defaultImports :: [N.Name]
69+defaultImports =
49− else map (A.drop . fst . A.drop) imports ++ map fst Imports.defaults
70+ map Imports._name Imports.defaults
50− in
71+
51− case maybeHeaderDecl of
72+
52− Nothing ->
73+
53− ( Nothing, dependencies )
74+-- TO HEADER
54−
75+
55− Just (Module.HeaderDecl sourceTag name _ _ _) ->
76+
56− let
77+simplifyHeader :: Src.Header -> (Tag, N.Name)
57− tag =
78+simplifyHeader (Src.Header name effects _ _) =
79+ ( toTag effects, name )
80+
81+
82+toTag :: Src.Effects -> Tag
83+toTag effects =
58− case sourceTag of
84+ case effects of
85+ Src.NoEffects ->
59− Module.Normal -> Normal
86+ Normal
87+
88+ Src.Ports _ ->
60− Module.Port _ -> Port
89+ Port
61− Module.Effect _ -> Effect
90+
62− in
91+ Src.Manager _ _ ->
63− ( Just (tag, name), dependencies )
92+ Effect
src/Parse/Module.hs+18−17
@@ -25,28 +25,29 @@ import qualified Reporting.Region as R
25
25
26
26
27
27
28−-- HEADER
28+-- MODULE
29
29
30
30
31module_ :: Parser decls -> Parser (Src.Module decls)
31module_ :: Parser decls -> Parser (Src.Module decls)
32module_ chompDecls =
32module_ chompDecls =
33 do freshLine
33 do freshLine
34− oneOf
34+ header <- oneOf [ Just <$> chompHeader, return Nothing ]
35+ imports <- chompImports []
36+ decls <- chompDecls
37+ return (Src.Module header imports decls)
38+
39+
40+chompHeader :: Parser Src.Header
41+chompHeader =
35− [ do start <- P.getPosition
42+ do start <- P.getPosition
36− P.pushContext start E.Module
43+ P.pushContext start E.Module
37− (name, effects) <- chompNameAndEffects
44+ (name, effects) <- chompNameAndEffects
38− P.hint E.Exposing $ Keyword.exposing_
45+ P.hint E.Exposing $ Keyword.exposing_
39− P.spaces
46+ P.spaces
40− exports <- exposing
47+ exports <- exposing
41− P.popContext ()
48+ P.popContext ()
42− docs <- maybeDocComment
49+ docs <- maybeDocComment
43− imports <- chompImports []
44− decls <- chompDecls
45− return (Src.Module name effects docs exports imports decls)
50+ return (Src.Header name effects exports docs)
46− , Src.defaultModule
47− <$> chompImports []
48− <*> chompDecls
49− ]
50
51
51
52
52
53
src/Validate.hs+8−3
@@ -29,10 +29,15 @@ type Result i w a =
29
29
30
30
31validate :: Src.Module [Src.Decl] -> Result i w Valid.Module
31validate :: Src.Module [Src.Decl] -> Result i w Valid.Module
32−validate (Src.Module name srcEffects overview exports imports srcDecls) =
32+validate (Src.Module header imports srcDecls) =
33 do (Stuff decls unions aliases binops ports docs) <- validateDecls srcDecls
33 do (Stuff decls unions aliases binops ports docs) <- validateDecls srcDecls
34+ case header of
35+ Nothing ->
36+ return $ Valid.defaultModule docs imports decls unions aliases binops
37+
38+ Just (Src.Header name srcEffects exports overview) ->
34− effects <- validateEffects srcEffects ports
39+ do effects <- validateEffects srcEffects ports
35− return $ Valid.Module name overview docs exports imports decls unions aliases binops effects
40+ return $ Valid.Module name overview docs exports imports decls unions aliases binops effects
36
41
37
42
38
43