git.iko.soy/elk
on f25154e help sign in
elk/builder/src/File/Plan.hs
197 lines 4.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module File.Plan
4 ( plan
5 , Info(..)
6 )
7 where
10import Control.Concurrent (forkIO)
11import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
12import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, readMVar)
13import Control.Monad (foldM, void, when)
14import Control.Monad.Except (liftIO)
15import qualified Data.Binary as Binary
16import qualified Data.ByteString as BS
17import qualified Data.Map as Map
18import qualified Data.Time.Clock as Time
19import qualified System.Directory as Dir
21import qualified Elm.Interface as I
22import qualified Elm.ModuleName as ModuleName
23import qualified Elm.Package as Pkg
24import qualified Elm.Project.Json as Project
25import qualified Elm.Project.Summary as Summary
26import qualified File.Crawl as Crawl
27import qualified File.Header as Header
28import qualified Reporting.Task as Task
29import qualified Stuff.Paths
33-- PLAN
36type Dict value = Map.Map ModuleName.Raw value
39plan :: Summary.Summary -> Crawl.Result -> Task.Task (Dict Info, I.Interfaces)
40plan (Summary.Summary root project _ ifaces _) (Crawl.Graph _ locals _ foreigns _) =
41 liftIO $
42 do queue <- newChan
43 let env = Env queue root (Project.getName project)
45 mvar <- newEmptyMVar
46 statusMVars <- Map.traverseWithKey (getStatus env mvar foreigns) locals
47 putMVar mvar statusMVars
49 void $ forkIO $
50 do graph <- Map.traverseMaybeWithKey (\_ -> readMVar) statusMVars
51 writeChan queue (EndLoop graph)
53 ifaceLoader queue ifaces
56data Env =
57 Env
58 { _queue :: Chan Msg
59 , _root :: FilePath
60 , _pkg :: Pkg.Name
61 }
65-- STATUS
68type Status = Maybe Info
69 -- Nothing == clean
70 -- Just info == dirty
73data Info =
74 Info
75 { _path :: FilePath
76 , _time :: Time.UTCTime
77 , _src :: BS.ByteString
78 , _clean :: [ModuleName.Raw]
79 , _dirty :: [ModuleName.Raw]
80 , _foreign :: [ModuleName.Canonical] -- TODO is this needed?
81 }
85-- GET STATUS
88getStatus
89 :: Env
90 -> MVar (Dict (MVar Status))
91 -> Dict Pkg.Canonical
92 -> ModuleName.Raw
93 -> Header.Info
94 -> IO (MVar Status)
95getStatus env statusMVars foreigns name (Header.Info path time src deps) =
96 do mvar <- newEmptyMVar
98 void $ forkIO $ putMVar mvar =<<
99 do statuses <- readMVar statusMVars
100 info <- foldM (addDep statuses foreigns) (Info path time src [] [] []) deps
102 let elmi = Stuff.Paths.elmi (_root env) name
104 case _dirty info of
105 _ : _ ->
106 do remove elmi
107 return (Just info)
109 [] ->
110 do freshElmi <- isFresh time elmi
111 if name /= "Main" && freshElmi
112 then
113 do let canonical = ModuleName.Canonical (_pkg env) name
114 writeChan (_queue env) (Get canonical elmi)
115 return Nothing
116 else
117 do remove elmi
118 return (Just info)
120 return mvar
123addDep :: Dict (MVar Status) -> Dict Pkg.Canonical -> Info -> ModuleName.Raw -> IO Info
124addDep locals foreigns info name =
125 case Map.lookup name locals of
126 Just mvar ->
127 do status <- readMVar mvar
128 case status of
129 Nothing ->
130 return $ info { _clean = name : _clean info }
132 Just _ ->
133 return $ info { _dirty = name : _dirty info }
135 Nothing ->
136 case Map.lookup name foreigns of
137 Just (Pkg.Canonical pkg _vsn) ->
138 return $ info { _foreign = ModuleName.Canonical pkg name : _foreign info }
140 Nothing ->
141 return info -- must be native
145-- IS FRESH
148isFresh :: Time.UTCTime -> FilePath -> IO Bool
149isFresh srcTime cachedFile =
150 andM
151 [ Dir.doesFileExist cachedFile
152 , do cacheTime <- Dir.getModificationTime cachedFile
153 return (cacheTime >= srcTime)
154 ]
157andM :: [IO Bool] -> IO Bool
158andM checks =
159 case checks of
160 [] ->
161 return True
163 check : otherChecks ->
164 do bool <- check
165 if bool then andM otherChecks else return False
168remove :: FilePath -> IO ()
169remove path =
170 do exists <- Dir.doesFileExist path
171 when exists (Dir.removeFile path)
175-- INTERFACE LOADER
178data Msg
179 = EndLoop (Dict Info)
180 | Get ModuleName.Canonical FilePath
183ifaceLoader :: Chan Msg -> I.Interfaces -> IO (Dict Info, I.Interfaces)
184ifaceLoader queue ifaces =
185 do msg <- readChan queue
186 case msg of
187 EndLoop dirty ->
188 return ( dirty, ifaces )
190 Get canonical elmi ->
191 case Map.lookup canonical ifaces of
192 Just _ ->
193 ifaceLoader queue ifaces
195 Nothing ->
196 do iface <- Binary.decodeFile elmi
197 ifaceLoader queue $ Map.insert canonical iface ifaces