git.iko.soy/elk
on bf25326 help sign in
elk/builder/src/File/Header.hs
191 lines 5.1 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 Data.List.NonEmpty (NonEmpty((:|)))
15import qualified Data.Map as Map
16import Data.Semigroup ((<>))
17import qualified Data.Time.Calendar as Day
18import qualified Data.Time.Clock as Time
19import qualified System.Directory as Dir
21import qualified Elm.Compiler.Module as Module
22import qualified Elm.Header as Header
24import qualified Elm.Project.Json as Project
25import Elm.Project.Json (Project)
26import Elm.Project.Summary (Summary(..))
27import qualified File.IO as IO
28import qualified Reporting.Exit as Exit
29import qualified Reporting.Exit.Crawl as E
30import qualified Reporting.Task as Task
34-- INFO
37data Info =
38 Info
39 { _path :: FilePath
40 , _time :: Time.UTCTime
41 , _source :: BS.ByteString
42 , _imports :: [Module.Raw]
43 }
46atRoot :: Task.Task_ E.Problem a -> Task.Task_ E.Exit a
47atRoot task =
48 Task.mapError (\problem -> E.DependencyProblems problem []) task
51-- READ MODULE
54readModule :: Summary -> Module.Raw -> FilePath -> Task.Task_ E.Problem (Module.Raw, Info)
55readModule summary expectedName path =
56 do time <- liftIO $ Dir.getModificationTime path
57 source <- liftIO $ IO.readUtf8 path
58 (maybeName, info) <- parse (_project summary) path time source
59 name <- checkName path expectedName maybeName
60 return (name, info)
63checkName :: FilePath -> Module.Raw -> Maybe Module.Raw -> Task.Task_ E.Problem Module.Raw
64checkName path expectedName maybeName =
65 case maybeName of
66 Nothing ->
67 Task.throw (E.ModuleNameMissing path expectedName)
69 Just actualName ->
70 if expectedName == actualName
71 then return expectedName
72 else Task.throw (E.ModuleNameMismatch path expectedName actualName)
76-- READ ONE FILE
79readOneFile :: Summary -> FilePath -> Task.Task (Maybe Module.Raw, Info)
80readOneFile summary path =
81 Task.mapError Exit.Crawl $
82 do (time, source) <- readOneHelp path
83 atRoot $ parse (_project summary) path time source
86readOneHelp :: FilePath -> Task.Task_ E.Exit (Time.UTCTime, BS.ByteString)
87readOneHelp path =
88 do exists <- IO.exists path
89 if exists
90 then liftIO $ (,) <$> Dir.getModificationTime path <*> IO.readUtf8 path
91 else Task.throw $ E.RootFileNotFound path
95-- READ MANY FILES
98readManyFiles :: Summary -> FilePath -> [FilePath] -> Task.Task ((Module.Raw, Info), [(Module.Raw, Info)])
99readManyFiles summary file files =
100 Task.mapError Exit.Crawl $
101 do info <- readManyFilesHelp summary file
102 infos <- traverse (readManyFilesHelp summary) files
103 let insert (name, info) dict = Map.insertWith (<>) name (info :| []) dict
104 let nameTable = foldr insert Map.empty (info:infos)
105 _ <- Map.traverseWithKey detectDuplicateNames nameTable
106 return (info, infos)
109readManyFilesHelp :: Summary -> FilePath -> Task.Task_ E.Exit (Module.Raw, Info)
110readManyFilesHelp summary path =
111 do (time, source) <- readOneHelp path
112 (maybeName, info) <- atRoot $ parse (_project summary) path time source
113 case maybeName of
114 Nothing ->
115 Task.throw (E.RootNameless path)
117 Just name ->
118 return (name, info)
121detectDuplicateNames :: Module.Raw -> NonEmpty Info -> Task.Task_ E.Exit ()
122detectDuplicateNames name (info :| otherInfos) =
123 case otherInfos of
124 [] ->
125 return ()
127 _ ->
128 Task.throw (E.RootModuleNameDuplicate name (map _path (info : otherInfos)))
133-- READ SOURCE
136readSource :: Project -> BS.ByteString -> Task.Task (Maybe Module.Raw, Info)
137readSource project source =
138 Task.mapError Exit.Crawl $
139 atRoot $ parse project "elm" fakeTime source
142fakeTime :: Time.UTCTime
143fakeTime =
144 Time.UTCTime (Day.fromGregorian 3000 1 1) 0
148-- PARSE HEADER
151parse :: Project -> FilePath -> Time.UTCTime -> BS.ByteString -> Task.Task_ E.Problem (Maybe Module.Raw, Info)
152parse project path time source =
153 -- TODO get regions on data extracted here
154 case Header.parse (Project.getName project) source of
155 Right (maybeDecl, deps) ->
156 do maybeName <- checkTag project path maybeDecl
157 return ( maybeName, Info path time source deps )
159 Left msg ->
160 Task.throw (E.BadHeader path time source msg)
163checkTag :: Project -> FilePath -> Maybe (Header.Tag, Module.Raw) -> Task.Task_ E.Problem (Maybe Module.Raw)
164checkTag project path maybeDecl =
165 case maybeDecl of
166 Nothing ->
167 return Nothing
169 Just (tag, name) ->
170 let
171 success =
172 return (Just name)
173 in
174 case tag of
175 Header.Normal ->
176 success
178 Header.Port ->
179 case project of
180 Project.App _ ->
181 success
183 Project.Pkg _ ->
184 Task.throw (E.PortsInPackage path name)
186 Header.Effect ->
187 if Project.isPlatformPackage project then
188 success
190 else
191 Task.throw (E.EffectsUnexpected path name)