git.iko.soy/elk
on 54dfb21 help sign in
elk/src/Reporting/Result.hs
139 lines 3.1 kB history raw
1module Reporting.Result where
3import Control.Applicative ((<|>))
4import qualified Control.Monad as M
5import Control.Monad.Except (Except, runExcept)
7import qualified Reporting.Annotation as A
8import qualified Reporting.Region as R
9import qualified Reporting.PrettyPrint as P
12-- TASK
14data Result warning error result =
15 Result
16 (Maybe P.Dealiaser, [A.Located warning])
17 (RawResult [A.Located error] result)
20data RawResult e a
21 = Ok a
22 | Err e
25-- HELPERS
27ok :: a -> Result w e a
28ok value =
29 Result (Nothing, []) (Ok value)
32throw :: R.Region -> e -> Result w e a
33throw region err =
34 Result (Nothing, []) (Err [A.A region err])
37throwMany :: [A.Located e] -> Result w e a
38throwMany errors =
39 Result (Nothing, []) (Err errors)
42from :: (e -> e') -> Except [A.Located e] a -> Result w e' a
43from f except =
44 case runExcept except of
45 Right answer ->
46 ok answer
48 Left errors ->
49 throwMany (map (A.map f) errors)
52mapError :: (e -> e') -> Result w e a -> Result w e' a
53mapError f (Result warnings rawResult) =
54 Result warnings $
55 case rawResult of
56 Ok v ->
57 Ok v
59 Err msgs ->
60 Err (map (A.map f) msgs)
63warn :: R.Region -> w -> Result w e ()
64warn region warning =
65 Result (Nothing, [A.A region warning]) (Ok ())
68addWarnings :: [A.Located w] -> Result w e a -> Result w e a
69addWarnings newWarnings (Result (dealiaser, warnings) rawResult) =
70 Result (dealiaser, newWarnings ++ warnings) rawResult
73addDealiaser :: P.Dealiaser -> Result w e a -> Result w e a
74addDealiaser dealiaser (Result (_, warnings) rawResult) =
75 Result (Just dealiaser, warnings) rawResult
78destruct :: (e -> b) -> (a -> b) -> RawResult e a -> b
79destruct errFunc okFunc rawResult =
80 case rawResult of
81 Ok answer ->
82 okFunc answer
84 Err errors ->
85 errFunc errors
88-- EXTRA FANCY HELPERS
90instance M.Functor (Result w e) where
91 fmap func (Result warnings rawResult) =
92 case rawResult of
93 Ok a ->
94 Result warnings (Ok (func a))
96 Err msgs ->
97 Result warnings (Err msgs)
100instance Applicative (Result w e) where
101 pure value =
102 ok value
104 (<*>) (Result context resultFunc) (Result context' resultVal) =
105 Result (merge context context') $
106 case (resultFunc, resultVal) of
107 (Ok func, Ok val) ->
108 Ok (func val)
110 (Err msgs, Err msgs') ->
111 Err (msgs ++ msgs')
113 (Err msgs, _) ->
114 Err msgs
116 (_, Err msgs) ->
117 Err msgs
120instance M.Monad (Result w e) where
121 return value =
122 ok value
124 (>>=) (Result context rawResult) callback =
125 case rawResult of
126 Err msg ->
127 Result context (Err msg)
129 Ok value ->
130 let (Result context' rawResult') = callback value
131 in
132 Result (merge context context') rawResult'
135merge :: (Maybe a, [b]) -> (Maybe a, [b]) -> (Maybe a, [b])
136merge (dealiaser, warnings) (dealiaser', warnings') =
137 ( dealiaser <|> dealiaser'
138 , warnings ++ warnings'
139 )