git.iko.soy/elk
on 2ce0625 help sign in
elk/builder/src/File/Header.hs
190 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 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.Error2 as Error
29import qualified Reporting.Error.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.Error 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 Error.Crawl $
82 do (time, source) <- readOneHelp path
83 atRoot $ parse (_project summary) path time source
86readOneHelp :: FilePath -> Task.Task_ E.Error (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 -> NonEmpty FilePath -> Task.Task (NonEmpty (Module.Raw, Info))
99readManyFiles summary files =
100 Task.mapError Error.Crawl $
101 do infos <- traverse (readManyFilesHelp summary) files
102 let insert (name, info) dict = Map.insertWith (<>) name (info :| []) dict
103 let nameTable = foldr insert Map.empty infos
104 _ <- Map.traverseWithKey detectDuplicateNames nameTable
105 return infos
108readManyFilesHelp :: Summary -> FilePath -> Task.Task_ E.Error (Module.Raw, Info)
109readManyFilesHelp summary path =
110 do (time, source) <- readOneHelp path
111 (maybeName, info) <- atRoot $ parse (_project summary) path time source
112 case maybeName of
113 Nothing ->
114 Task.throw (E.RootNameless path)
116 Just name ->
117 return (name, info)
120detectDuplicateNames :: Module.Raw -> NonEmpty Info -> Task.Task_ E.Error ()
121detectDuplicateNames name (info :| otherInfos) =
122 case otherInfos of
123 [] ->
124 return ()
126 _ ->
127 Task.throw (E.RootModuleNameDuplicate name (map _path (info : otherInfos)))
132-- READ SOURCE
135readSource :: Project -> BS.ByteString -> Task.Task (Maybe Module.Raw, Info)
136readSource project source =
137 Task.mapError Error.Crawl $
138 atRoot $ parse project "elm" fakeTime source
141fakeTime :: Time.UTCTime
142fakeTime =
143 Time.UTCTime (Day.fromGregorian 3000 1 1) 0
147-- PARSE HEADER
150parse :: Project -> FilePath -> Time.UTCTime -> BS.ByteString -> Task.Task_ E.Problem (Maybe Module.Raw, Info)
151parse project path time source =
152 -- TODO get regions on data extracted here
153 case Header.parse (Project.getName project) source of
154 Right (maybeDecl, deps) ->
155 do maybeName <- checkTag project path maybeDecl
156 return ( maybeName, Info path time source deps )
158 Left msg ->
159 Task.throw (E.BadHeader path source msg)
162checkTag :: Project -> FilePath -> Maybe (Header.Tag, Module.Raw) -> Task.Task_ E.Problem (Maybe Module.Raw)
163checkTag project path maybeDecl =
164 case maybeDecl of
165 Nothing ->
166 return Nothing
168 Just (tag, name) ->
169 let
170 success =
171 return (Just name)
172 in
173 case tag of
174 Header.Normal ->
175 success
177 Header.Port ->
178 case project of
179 Project.App _ ->
180 success
182 Project.Pkg _ ->
183 Task.throw (E.PortsInPackage path name)
185 Header.Effect ->
186 if Project.isPlatformPackage project then
187 success
189 else
190 Task.throw (E.EffectsUnexpected path name)