@@ -1,119 +0,0 @@
1−module Generate.Artifacts
2− ( ignore
3− , write
4− )
5− where
6−
7−
8−import Control.Concurrent (forkIO)
9−import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar)
10−import Control.Monad (foldM, void)
11−import Control.Monad.Except (liftIO)
12−import qualified Data.Binary as Binary
13−import qualified Data.ByteString.UTF8 as BS_UTF8
14−import Data.Map (Map)
15−import qualified Data.Map as Map
16−
17−import qualified Elm.Compiler as Compiler
18−import qualified Elm.ModuleName as ModuleName
19−
20−import File.Compile (Answer(..))
21−import qualified Reporting.Exit.Compile as E
22−import qualified Reporting.Exit as Exit
23−import qualified Reporting.Task as Task
24−import qualified Stuff.Paths as Path
25−
26−
27−
28−-- IGNORE
29−
30−
31−ignore :: Map ModuleName.Raw Answer -> Task.Task (Map ModuleName.Raw Compiler.Artifacts)
32−ignore answers =
33− let
34− ignorer _name result =
35− return result
36− in
37− gather ignorer answers
38−
39−
40−
41−-- WRITE
42−
43−
44−write :: FilePath -> Map ModuleName.Raw Answer -> Task.Task (Map ModuleName.Raw Compiler.Artifacts)
45−write root answers =
46− let
47− writer name result@(Compiler.Artifacts elmi elmo) =
48− do mvar <- newEmptyMVar
49− void $ forkIO $
50− do Binary.encodeFile (Path.elmi root name) elmi
51− Binary.encodeFile (Path.elmo root name) elmo
52− putMVar mvar result
53− return mvar
54− in
55− do mvars <- gather writer answers
56− liftIO $ traverse readMVar mvars
57−
58−
59−
60−-- GATHER
61−
62−
63−gather :: OnGood a -> Map ModuleName.Raw Answer -> Task.Task (Map ModuleName.Raw a)
64−gather onGood answers =
65− do summary <- liftIO $
66− foldM (gatherHelp onGood) (Right Map.empty) (Map.toList answers)
67−
68− case summary of
69− Left (err, errors) ->
70− Task.throw (Exit.Compile err errors)
71−
72− Right results ->
73− return results
74−
75−
76−type OnGood a = ModuleName.Raw -> Compiler.Artifacts -> IO a
77−
78−
79−gatherHelp :: OnGood a -> Summary a -> (ModuleName.Raw, Answer) -> IO (Summary a)
80−gatherHelp onGood summary (name, answer) =
81− case answer of
82− Blocked ->
83− return summary
84−
85− Bad path time src errors ->
86− do let err = E.Exit name path time (BS_UTF8.toString src) errors
87− return (addErr err summary)
88−
89− Good result ->
90− do value <- onGood name result
91− return (addOk name value summary)
92−
93−
94−
95−-- DICT RESULT
96−
97−
98−type Summary a =
99− Either (E.Exit, [E.Exit]) (Map ModuleName.Raw a)
100−
101−
102−addOk :: ModuleName.Raw -> a -> Summary a -> Summary a
103−addOk name result acc =
104− case acc of
105− Left _ ->
106− acc
107−
108− Right results ->
109− Right (Map.insert name result results)
110−
111−
112−addErr :: E.Exit -> Summary a -> Summary a
113−addErr err acc =
114− case acc of
115− Left (e, es) ->
116− Left (err, e:es)
117−
118− Right _ ->
119− Left (err, [])