git.iko.soy/elk
on master help sign in
elk/builder/src/Reporting/Task.hs
114 lines 1.8 kB history raw
1{-# LANGUAGE Rank2Types #-}
2module Reporting.Task
3 ( Task
4 , run
5 , throw
6 , mapError
7 --
8 , io
9 , mio
10 , eio
11 )
12 where
16-- TASKS
19newtype Task x a =
20 Task
21 (
22 forall result. (a -> IO result) -> (x -> IO result) -> IO result
23 )
26run :: Task x a -> IO (Either x a)
27run (Task task) =
28 task (return . Right) (return . Left)
31throw :: x -> Task x a
32throw x =
33 Task $ \_ err -> err x
36mapError :: (x -> y) -> Task x a -> Task y a
37mapError func (Task task) =
38 Task $ \ok err ->
39 task ok (err . func)
43-- IO
46{-# INLINE io #-}
47io :: IO a -> Task x a
48io work =
49 Task $ \ok _ -> work >>= ok
52mio :: x -> IO (Maybe a) -> Task x a
53mio x work =
54 Task $ \ok err ->
55 do result <- work
56 case result of
57 Just a -> ok a
58 Nothing -> err x
61eio :: (x -> y) -> IO (Either x a) -> Task y a
62eio func work =
63 Task $ \ok err ->
64 do result <- work
65 case result of
66 Right a -> ok a
67 Left x -> err (func x)
71-- INSTANCES
74instance Functor (Task x) where
75 {-# INLINE fmap #-}
76 fmap func (Task taskA) =
77 Task $ \ok err ->
78 let
79 okA arg = ok (func arg)
80 in
81 taskA okA err
84instance Applicative (Task x) where
85 {-# INLINE pure #-}
86 pure a =
87 Task $ \ok _ -> ok a
89 {-# INLINE (<*>) #-}
90 (<*>) (Task taskFunc) (Task taskArg) =
91 Task $ \ok err ->
92 let
93 okFunc func =
94 let
95 okArg arg = ok (func arg)
96 in
97 taskArg okArg err
98 in
99 taskFunc okFunc err
102instance Monad (Task x) where
103 {-# INLINE return #-}
104 return = pure
106 {-# INLINE (>>=) #-}
107 (>>=) (Task taskA) callback =
108 Task $ \ok err ->
109 let
110 okA a =
111 case callback a of
112 Task taskB -> taskB ok err
113 in
114 taskA okA err