git.iko.soy/elk
on 49f58cf help sign in
elk/builder/src/File/Header.hs
191 lines 5.0 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 Elm.Compiler.Module as Module
20import qualified Elm.Header as Header
22import qualified Elm.Project.Json as Project
23import Elm.Project.Json (Project)
24import Elm.Project.Summary (Summary(..))
25import qualified File.IO as IO
26import qualified Reporting.Exit as Exit
27import qualified Reporting.Exit.Crawl as E
28import qualified Reporting.Task as Task
32-- INFO
35data Info =
36 Info
37 { _path :: FilePath
38 , _time :: Time.UTCTime
39 , _source :: BS.ByteString
40 , _imports :: [Module.Raw]
41 }
44atRoot :: Task.Task_ E.Problem a -> Task.Task_ E.Exit a
45atRoot task =
46 Task.mapError (\problem -> E.DependencyProblems problem []) task
49-- READ MODULE
52readModule :: Summary -> Module.Raw -> FilePath -> Task.Task_ E.Problem (Module.Raw, Info)
53readModule summary expectedName path =
54 do time <- liftIO $ Dir.getModificationTime path
55 source <- liftIO $ IO.readUtf8 path
56 (maybeName, info) <- parse (_project summary) path time source
57 name <- checkName path expectedName maybeName
58 return (name, info)
61checkName :: FilePath -> Module.Raw -> Maybe Module.Raw -> Task.Task_ E.Problem Module.Raw
62checkName path expectedName maybeName =
63 case maybeName of
64 Nothing ->
65 Task.throw (E.ModuleNameMissing path expectedName)
67 Just actualName ->
68 if expectedName == actualName
69 then return expectedName
70 else Task.throw (E.ModuleNameMismatch path expectedName actualName)
74-- READ ONE FILE
77readOneFile :: Summary -> FilePath -> Task.Task (Maybe Module.Raw, Info)
78readOneFile summary path =
79 Task.mapError Exit.Crawl $
80 do (time, source) <- readOneHelp path
81 atRoot $ parse (_project summary) path time source
84readOneHelp :: FilePath -> Task.Task_ E.Exit (Time.UTCTime, BS.ByteString)
85readOneHelp path =
86 do exists <- IO.exists path
87 if exists
88 then liftIO $ (,) <$> Dir.getModificationTime path <*> IO.readUtf8 path
89 else Task.throw $ E.RootFileNotFound path
93-- READ MANY FILES
96readManyFiles :: Summary -> FilePath -> [FilePath] -> Task.Task ((Module.Raw, Info), [(Module.Raw, Info)])
97readManyFiles summary file files =
98 Task.mapError Exit.Crawl $
99 do info <- readManyFilesHelp summary file
100 infos <- traverse (readManyFilesHelp summary) files
101 let nameTable = foldr insert Map.empty (info:infos)
102 _ <- Map.traverseWithKey detectDuplicateNames nameTable
103 return (info, infos)
104 where
105 append (x,xs) (y,ys) = (x, xs ++ y : ys)
106 insert (k,v) dict = Map.insertWith append k (v, []) dict
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 -> (Info, [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)