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