git.iko.soy/elk
on master help sign in
Decouple reporting from tasks, tasks are just for error tracking
29b966fEvan Czaplicki
builder/src/Reporting/Task.hs+27−80
compare with master
unifiedsplit
@@ -1,78 +1,34 @@
1−{-# LANGUAGE OverloadedStrings, Rank2Types #-}
1+{-# LANGUAGE Rank2Types #-}
2module Reporting.Task
2module Reporting.Task
3 ( Task
3 ( Task
4 , run
4 , run
5 , throw
5 , throw
6− -- progress
6+ --
7− , notify
8− , ask
9− -- io
10 , io
7 , io
11 , eio
8 , eio
12− , withKey
13 )
9 )
14 where
10 where
15
11
16
12
17−import qualified System.Exit as Exit
18−
19−import qualified Reporting.Doc as D
20−import qualified Reporting.Exit as Exit
21−import qualified Reporting.Progress as Progress
22−
23−
24
13
25-- TASKS
14-- TASKS
26
15
27
16
28−newtype Task a =
17+newtype Task x a =
29 Task
18 Task
30 (
19 (
31− forall result.
20+ forall result. (a -> IO result) -> (x -> IO result) -> IO result
32− Env
33− -> (a -> IO result)
34− -> (Exit.Exit -> IO result)
35− -> IO result
36 )
21 )
37
22
38
23
39−data Env =
24+run :: Task x a -> IO (Either x a)
40− Env
41− { _tell :: Progress.Progress -> IO ()
42− , _ask :: D.Doc -> IO Bool
43− }
44−
45−
46−run :: Progress.Reporter -> Task a -> IO ()
47−run (Progress.Reporter pTell pAsk pEnd) (Task task) =
25+run (Task task) =
48− task (Env pTell pAsk)
26+ task (return . Right) (return . Left)
49− (\_ ->
50− do pEnd Nothing
51− return ()
52− )
53− (\exit ->
54− do pEnd (Just exit)
55− Exit.exitFailure
56− )
57−
58−
59−throw :: Exit.Exit -> Task a
60−throw exit =
61− Task $ \_ _ err -> err exit
62−
63
27
64
28
65−-- PROGRESS
29+throw :: x -> Task x a
66−
30+throw x =
67−
31+ Task $ \_ err -> err x
68−notify :: Progress.Progress -> Task ()
69−notify progress =
70− Task $ \(Env pTell _) ok _ -> pTell progress >>= ok
71−
72−
73−ask :: D.Doc -> Task Bool
74−ask question =
75− Task $ \(Env _ pAsk) ok _ -> pAsk question >>= ok
76
32
77
33
78
34
@@ -80,71 +36,62 @@ ask question =
80
36
81
37
82{-# INLINE io #-}
38{-# INLINE io #-}
83−io :: IO a -> Task a
39+io :: IO a -> Task x a
84io work =
40io work =
85− Task $ \_ ok _ -> work >>= ok
41+ Task $ \ok _ -> work >>= ok
86
42
87
43
88−eio :: (x -> Exit.Exit) -> IO (Either x a) -> Task a
44+eio :: (x -> y) -> IO (Either x a) -> Task y a
89eio func work =
45eio func work =
90− Task $ \_ ok err ->
46+ Task $ \ok err ->
91 do result <- work
47 do result <- work
92 case result of
48 case result of
93 Right a -> ok a
49 Right a -> ok a
94− Left e -> err (func e)
50+ Left x -> err (func x)
95−
96−
97−withKey :: (Progress.Key -> IO (Either Exit.Exit a)) -> Task a
98−withKey callback =
99− Task $ \(Env pTell _) ok err ->
100− do result <- callback (Progress.Key pTell)
101− case result of
102− Right a -> ok a
103− Left e -> err e
104
51
105
52
106
53
107-- INSTANCES
54-- INSTANCES
108
55
109
56
110−instance Functor Task where
57+instance Functor (Task x) where
111 {-# INLINE fmap #-}
58 {-# INLINE fmap #-}
112 fmap func (Task taskA) =
59 fmap func (Task taskA) =
113− Task $ \env ok err ->
60+ Task $ \ok err ->
114 let
61 let
115 okA arg = ok (func arg)
62 okA arg = ok (func arg)
116 in
63 in
117− taskA env okA err
64+ taskA okA err
118
65
119
66
120−instance Applicative Task where
67+instance Applicative (Task x) where
121 {-# INLINE pure #-}
68 {-# INLINE pure #-}
122 pure a =
69 pure a =
123− Task $ \_ ok _ -> ok a
70+ Task $ \ok _ -> ok a
124
71
125 {-# INLINE (<*>) #-}
72 {-# INLINE (<*>) #-}
126 (<*>) (Task taskFunc) (Task taskArg) =
73 (<*>) (Task taskFunc) (Task taskArg) =
127− Task $ \env ok err ->
74+ Task $ \ok err ->
128 let
75 let
129 okFunc func =
76 okFunc func =
130 let
77 let
131 okArg arg = ok (func arg)
78 okArg arg = ok (func arg)
132 in
79 in
133− taskArg env okArg err
80+ taskArg okArg err
134 in
81 in
135− taskFunc env okFunc err
82+ taskFunc okFunc err
136
83
137
84
138−instance Monad Task where
85+instance Monad (Task x) where
139 {-# INLINE return #-}
86 {-# INLINE return #-}
140 return = pure
87 return = pure
141
88
142 {-# INLINE (>>=) #-}
89 {-# INLINE (>>=) #-}
143 (>>=) (Task taskA) callback =
90 (>>=) (Task taskA) callback =
144− Task $ \env ok err ->
91+ Task $ \ok err ->
145 let
92 let
146 okA a =
93 okA a =
147 case callback a of
94 case callback a of
148− Task taskB -> taskB env ok err
95+ Task taskB -> taskB ok err
149 in
96 in
150− taskA env okA err
97+ taskA okA err