on master help sign in
Collapse Elm.Header into File.Header
07acefeEvan Czaplicki
builder/src/File/Header.hs+42−29
@@ -16,12 +16,18 @@ import qualified Data.Time.Calendar as Day
16import qualified Data.Time.Clock as Time
16import qualified Data.Time.Clock as Time
17import qualified System.Directory as Dir
17import qualified System.Directory as Dir
18
18
19−import qualified Elm.Header as Header
19+import qualified AST.Source as Src
20+import qualified Elm.Compiler.Imports as Imports
20import qualified Elm.ModuleName as ModuleName
21import qualified Elm.ModuleName as ModuleName
22+import qualified Elm.Package as Pkg
21import qualified Elm.Project.Json as Project
23import qualified Elm.Project.Json as Project
22import Elm.Project.Json (Project)
24import Elm.Project.Json (Project)
23import Elm.Project.Summary (Summary(..))
25import Elm.Project.Summary (Summary(..))
24import qualified File.IO as IO
26import qualified File.IO as IO
27+import qualified Parse.Module as Module
28+import Parse.Utils (Parser)
29+import qualified Parse.Primitives as P
30+import qualified Reporting.Annotation as A
25import qualified Reporting.Exit as Exit
31import qualified Reporting.Exit as Exit
26import qualified Reporting.Exit.Crawl as E
32import qualified Reporting.Exit.Crawl as E
27import qualified Reporting.Task as Task
33import qualified Reporting.Task as Task
@@ -82,7 +88,7 @@ readOneFile summary path =
82
88
83readOneHelp :: FilePath -> Task.Task_ E.Exit (Time.UTCTime, BS.ByteString)
89readOneHelp :: FilePath -> Task.Task_ E.Exit (Time.UTCTime, BS.ByteString)
84readOneHelp path =
90readOneHelp path =
85− do exists <- IO.exists path
91+ do exists <- liftIO $ IO.exists path
86 if exists
92 if exists
87 then liftIO $ (,) <$> Dir.getModificationTime path <*> IO.readUtf8 path
93 then liftIO $ (,) <$> Dir.getModificationTime path <*> IO.readUtf8 path
88 else Task.throw $ E.RootFileNotFound path
94 else Task.throw $ E.RootFileNotFound path
@@ -150,41 +156,48 @@ fakeTime =
150parse :: Project -> FilePath -> Time.UTCTime -> BS.ByteString -> Task.Task_ E.Problem (Maybe ModuleName.Raw, Info)
156parse :: Project -> FilePath -> Time.UTCTime -> BS.ByteString -> Task.Task_ E.Problem (Maybe ModuleName.Raw, Info)
151parse project path time source =
157parse project path time source =
152 -- TODO get regions on data extracted here
158 -- TODO get regions on data extracted here
153− case Header.parse (Project.getName project) source of
159+ case P.fromByteString parser source of
154− Right (maybeDecl, deps) ->
160+ P.Ok (maybeHeader, imports) _ ->
161+ let
162+ deps =
163+ map (\(Src.Import (A.At _ name) _ _) -> name) $
164+ if Project.getName project == Pkg.core
165+ then imports
166+ else Imports.addDefaults imports
167+ in
155− do maybeName <- checkTag project path maybeDecl
168+ do maybeName <- checkTag project path maybeHeader
156 return ( maybeName, Info path time source deps )
169 return ( maybeName, Info path time source deps )
157
170
158− Left msg ->
171+ P.Err _ _ _ _ ->
159− Task.throw (E.BadHeader path time source msg)
172+ Task.throw (error "TODO give an error on bad headers / stop having a double parse")
173+
174+
175+parser :: Parser (Maybe Module.Header, [Src.Import])
176+parser =
177+ do Module.freshLine
178+ header <- Module.chompHeader
179+ Module.maybeSkipDocComment
180+ imports <- Module.chompImports []
181+ return (header, imports)
160
182
161
183
162−checkTag :: Project -> FilePath -> Maybe (Header.Tag, ModuleName.Raw) -> Task.Task_ E.Problem (Maybe ModuleName.Raw)
184+checkTag :: Project -> FilePath -> Maybe Module.Header -> Task.Task_ E.Problem (Maybe ModuleName.Raw)
163−checkTag project path maybeDecl =
185+checkTag project path maybeHeader =
164− case maybeDecl of
186+ case maybeHeader of
165 Nothing ->
187 Nothing ->
166 return Nothing
188 return Nothing
167
189
168− Just (tag, name) ->
190+ Just (Module.Header name effects _) ->
169− let
191+ case effects of
170− success =
192+ Module.NoEffects _ ->
171 return (Just name)
193 return (Just name)
172− in
173− case tag of
174− Header.Normal ->
175− success
176
194
177− Header.Port ->
195+ Module.Ports _ ->
178 case project of
196 case project of
179− Project.App _ ->
197+ Project.App _ -> return (Just name)
180− success
181−
182− Project.Pkg _ ->
183− Task.throw (E.PortsInPackage path name)
198+ Project.Pkg _ -> Task.throw (E.PortsInPackage path name)
184−
185− Header.Effect ->
186− if Project.isPlatformPackage project then
187− success
188
199
189− else
200+ Module.Manager _ _ ->
201+ if Project.isPlatformPackage project
202+ then return (Just name)
190− Task.throw (E.EffectsUnexpected path name)
203+ else Task.throw (E.EffectsUnexpected path name)
compiler/src/Elm/Header.hsdeleted−73
@@ -1,73 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−module Elm.Header
3− ( Tag(..)
4− , parse
5− )
6− where
7−
8−
9−import qualified Data.ByteString as B
10−import qualified Data.Name as Name
11−
12−import qualified AST.Source as Src
13−import qualified Elm.ModuleName as ModuleName
14−import qualified Elm.Package as Pkg
15−import qualified Parse.Primitives as Parser
16−import qualified Parse.Module as Module
17−import qualified Reporting.Annotation as A
18−import qualified Reporting.Error as Error
19−
20−
21−
22−-- HEADER TAGS
23−
24−
25−data Tag = Normal | Effect | Port
26−
27−
28−
29−-- PARSE
30−
31−
32−parse :: Pkg.Name -> B.ByteString -> Either Error.Error (Maybe (Tag, ModuleName.Raw), [ModuleName.Raw])
33−parse pkgName sourceCode =
34− let
35− headerParser =
36− Module.module_ pkgName (return ())
37− in
38− case Parser.run headerParser sourceCode of
39− Right (Src.Module header imports _) ->
40− Right
41− ( fmap simplifyHeader header
42− , map getName imports
43− )
44−
45− Left err ->
46− Left (Error.Syntax err)
47−
48−
49−getName :: Src.Import -> Name.Name
50−getName (Src.Import (A.At _ name) _ _) =
51− name
52−
53−
54−
55−-- TO HEADER
56−
57−
58−simplifyHeader :: Src.Header -> (Tag, Name.Name)
59−simplifyHeader (Src.Header name effects _ _) =
60− ( toTag effects, name )
61−
62−
63−toTag :: Src.Effects -> Tag
64−toTag effects =
65− case effects of
66− Src.NoEffects ->
67− Normal
68−
69− Src.Ports _ ->
70− Port
71−
72− Src.Manager _ _ ->
73− Effect