git.iko.soy/elk
on f25154e help sign in
elk/builder/src/File/Header.hs
203 lines 5.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module File.Header
4 ( Info(..)
5 , readModule
6 , readOneFile
7 , readManyFiles
8 , readSource
9 )
10 where
12import Control.Monad.Except (liftIO)
13import qualified Data.ByteString as BS
14import qualified Data.Map as Map
15import qualified Data.Time.Calendar as Day
16import qualified Data.Time.Clock as Time
17import qualified System.Directory as Dir
19import qualified AST.Source as Src
20import qualified Elm.Compiler.Imports as Imports
21import qualified Elm.ModuleName as ModuleName
22import qualified Elm.Package as Pkg
23import qualified Elm.Project.Json as Project
24import Elm.Project.Json (Project)
25import Elm.Project.Summary (Summary(..))
26import qualified File.IO as IO
27import qualified Parse.Module as Module
28import Parse.Utils (Parser)
29import qualified Parse.Primitives as P
30import qualified Reporting.Annotation as A
31import qualified Reporting.Exit as Exit
32import qualified Reporting.Exit.Crawl as E
33import qualified Reporting.Task as Task
37-- INFO
40data Info =
41 Info
42 { _path :: FilePath
43 , _time :: Time.UTCTime
44 , _source :: BS.ByteString
45 , _imports :: [ModuleName.Raw]
46 }
49atRoot :: Task.Task_ E.Problem a -> Task.Task_ E.Exit a
50atRoot task =
51 Task.mapError (\problem -> E.DependencyProblems problem []) task
54-- READ MODULE
57readModule :: Summary -> ModuleName.Raw -> FilePath -> Task.Task_ E.Problem (ModuleName.Raw, Info)
58readModule summary expectedName path =
59 do time <- liftIO $ Dir.getModificationTime path
60 source <- liftIO $ IO.readUtf8 path
61 (maybeName, info) <- parse (_project summary) path time source
62 name <- checkName path expectedName maybeName
63 return (name, info)
66checkName :: FilePath -> ModuleName.Raw -> Maybe ModuleName.Raw -> Task.Task_ E.Problem ModuleName.Raw
67checkName path expectedName maybeName =
68 case maybeName of
69 Nothing ->
70 Task.throw (E.ModuleNameMissing path expectedName)
72 Just actualName ->
73 if expectedName == actualName
74 then return expectedName
75 else Task.throw (E.ModuleNameMismatch path expectedName actualName)
79-- READ ONE FILE
82readOneFile :: Summary -> FilePath -> Task.Task (Maybe ModuleName.Raw, Info)
83readOneFile summary path =
84 Task.mapError Exit.Crawl $
85 do (time, source) <- readOneHelp path
86 atRoot $ parse (_project summary) path time source
89readOneHelp :: FilePath -> Task.Task_ E.Exit (Time.UTCTime, BS.ByteString)
90readOneHelp path =
91 do exists <- liftIO $ IO.exists path
92 if exists
93 then liftIO $ (,) <$> Dir.getModificationTime path <*> IO.readUtf8 path
94 else Task.throw $ E.RootFileNotFound path
98-- READ MANY FILES
101readManyFiles :: Summary -> FilePath -> [FilePath] -> Task.Task ((ModuleName.Raw, Info), [(ModuleName.Raw, Info)])
102readManyFiles summary file files =
103 Task.mapError Exit.Crawl $
104 do info <- readManyFilesHelp summary file
105 infos <- traverse (readManyFilesHelp summary) files
106 let nameTable = foldr insert Map.empty (info:infos)
107 _ <- Map.traverseWithKey detectDuplicateNames nameTable
108 return (info, infos)
109 where
110 append (x,xs) (y,ys) = (x, xs ++ y : ys)
111 insert (k,v) dict = Map.insertWith append k (v, []) dict
114readManyFilesHelp :: Summary -> FilePath -> Task.Task_ E.Exit (ModuleName.Raw, Info)
115readManyFilesHelp summary path =
116 do (time, source) <- readOneHelp path
117 (maybeName, info) <- atRoot $ parse (_project summary) path time source
118 case maybeName of
119 Nothing ->
120 Task.throw (E.RootNameless path)
122 Just name ->
123 return (name, info)
126detectDuplicateNames :: ModuleName.Raw -> (Info, [Info]) -> Task.Task_ E.Exit ()
127detectDuplicateNames name (info, otherInfos) =
128 case otherInfos of
129 [] ->
130 return ()
132 _ ->
133 Task.throw (E.RootModuleNameDuplicate name (map _path (info : otherInfos)))
138-- READ SOURCE
141readSource :: Project -> BS.ByteString -> Task.Task (Maybe ModuleName.Raw, Info)
142readSource project source =
143 Task.mapError Exit.Crawl $
144 atRoot $ parse project "elm" fakeTime source
147fakeTime :: Time.UTCTime
148fakeTime =
149 Time.UTCTime (Day.fromGregorian 3000 1 1) 0
153-- PARSE HEADER
156parse :: Project -> FilePath -> Time.UTCTime -> BS.ByteString -> Task.Task_ E.Problem (Maybe ModuleName.Raw, Info)
157parse project path time source =
158 -- TODO get regions on data extracted here
159 case P.fromByteString parser source of
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
168 do maybeName <- checkTag project path maybeHeader
169 return ( maybeName, Info path time source deps )
171 P.Err _ _ _ _ ->
172 Task.throw (error "TODO give an error on bad headers / stop having a double parse")
175parser :: Parser (Maybe Module.Header, [Src.Import])
176parser =
177 do Module.freshLine
178 header <- Module.chompHeader
179 Module.maybeSkipDocComment
180 imports <- Module.chompImports []
181 return (header, imports)
184checkTag :: Project -> FilePath -> Maybe Module.Header -> Task.Task_ E.Problem (Maybe ModuleName.Raw)
185checkTag project path maybeHeader =
186 case maybeHeader of
187 Nothing ->
188 return Nothing
190 Just (Module.Header name effects _) ->
191 case effects of
192 Module.NoEffects _ ->
193 return (Just name)
195 Module.Ports _ ->
196 case project of
197 Project.App _ -> return (Just name)
198 Project.Pkg _ -> Task.throw (E.PortsInPackage path name)
200 Module.Manager _ _ ->
201 if Project.isPlatformPackage project
202 then return (Just name)
203 else Task.throw (E.EffectsUnexpected path name)