git.iko.soy/elk
on 6a96e21 help sign in
elk/builder/src/File/Artifacts.hs
138 lines 3.2 kB history raw
1module File.Artifacts
2 ( ignore
3 , write
4 , writeDocs
5 )
6 where
9import Control.Concurrent (forkIO)
10import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar)
11import Control.Monad (foldM, void)
12import Control.Monad.Except (liftIO)
13import qualified Data.Binary as Binary
14import Data.Map (Map)
15import qualified Data.Map as Map
16import qualified Data.Maybe as Maybe
17import qualified Data.Text.Encoding as Text
19import qualified Elm.Compiler as Compiler
20import qualified Elm.Compiler.Module as Module
21import qualified Elm.Docs as Docs
22import qualified Json.Encode as Encode
24import File.Compile (Answer(..))
25import qualified Reporting.Exit.Compile as E
26import qualified Reporting.Exit as Exit
27import qualified Reporting.Task as Task
28import qualified Stuff.Paths as Path
32-- IGNORE
35ignore :: Map Module.Raw Answer -> Task.Task (Map Module.Raw Compiler.Artifacts)
36ignore answers =
37 let
38 ignorer _name result =
39 return result
40 in
41 gather ignorer answers
45-- WRITE
48write :: FilePath -> Map Module.Raw Answer -> Task.Task (Map Module.Raw Compiler.Artifacts)
49write root answers =
50 let
51 writer name result@(Compiler.Artifacts elmi elmo _) =
52 do mvar <- newEmptyMVar
53 void $ forkIO $
54 do Binary.encodeFile (Path.elmi root name) elmi
55 Binary.encodeFile (Path.elmo root name) elmo
56 putMVar mvar result
57 return mvar
58 in
59 do mvars <- gather writer answers
60 liftIO $ traverse readMVar mvars
63writeDocs :: Map Module.Raw Compiler.Artifacts -> FilePath -> Task.Task Docs.Documentation
64writeDocs results path =
65 let
66 getDocs (Compiler.Artifacts _ _ docs) =
67 docs
68 in
69 case Maybe.mapMaybe getDocs (Map.elems results) of
70 [] ->
71 return Map.empty
73 docs ->
74 do liftIO $ Encode.writeUgly path $ Encode.list Docs.encode docs
75 return $ Docs.toDict docs
79-- GATHER
82gather :: OnGood a -> Map Module.Raw Answer -> Task.Task (Map Module.Raw a)
83gather onGood answers =
84 do summary <- liftIO $
85 foldM (gatherHelp onGood) (Right Map.empty) (Map.toList answers)
87 case summary of
88 Left (err, errors) ->
89 Task.throw (Exit.Compile err errors)
91 Right results ->
92 return results
95type OnGood a = Module.Raw -> Compiler.Artifacts -> IO a
98gatherHelp :: OnGood a -> Summary a -> (Module.Raw, Answer) -> IO (Summary a)
99gatherHelp onGood summary (name, answer) =
100 case answer of
101 Blocked ->
102 return summary
104 Bad path time src errors ->
105 do let err = E.Exit name path time (Text.decodeUtf8 src) errors
106 return (addErr err summary)
108 Good result ->
109 do value <- onGood name result
110 return (addOk name value summary)
114-- DICT RESULT
117type Summary a =
118 Either (E.Exit, [E.Exit]) (Map Module.Raw a)
121addOk :: Module.Raw -> a -> Summary a -> Summary a
122addOk name result acc =
123 case acc of
124 Left _ ->
125 acc
127 Right results ->
128 Right (Map.insert name result results)
131addErr :: E.Exit -> Summary a -> Summary a
132addErr err acc =
133 case acc of
134 Left (e, es) ->
135 Left (err, e:es)
137 Right _ ->
138 Left (err, [])