git.iko.soy/elk
on 9b0c310 help sign in
elk/src/Reporting/Result.hs
108 lines 2.3 kB history raw
1module Reporting.Result where
3import qualified Control.Applicative as A
4import qualified Control.Monad as M
5import Control.Monad.Except (Except, runExcept)
7import qualified Reporting.Annotation as A
8import qualified Reporting.Region as R
11-- TASK
13data Result warning error result =
14 Result [A.Located warning] (RawResult [A.Located error] result)
16data RawResult e a
17 = Ok a
18 | Err e
21-- HELPERS
23ok :: a -> Result w e a
24ok value =
25 Result [] (Ok value)
28throw :: R.Region -> e -> Result w e a
29throw region err =
30 Result [] (Err [A.A region err])
33throwMany :: [A.Located e] -> Result w e a
34throwMany errors =
35 Result [] (Err errors)
38from :: (e -> e') -> Except [A.Located e] a -> Result w e' a
39from f except =
40 case runExcept except of
41 Right answer ->
42 ok answer
44 Left errors ->
45 throwMany (map (A.map f) errors)
48mapError :: (e -> e') -> Result w e a -> Result w e' a
49mapError f (Result warnings rawResult) =
50 Result warnings $
51 case rawResult of
52 Ok v ->
53 Ok v
55 Err msgs ->
56 Err (map (A.map f) msgs)
59addWarnings :: [A.Located w] -> Result w e a -> Result w e a
60addWarnings newWarnings (Result warnings rawResult) =
61 Result (newWarnings ++ warnings) rawResult
64-- EXTRA FANCY HELPERS
66instance M.Functor (Result w e) where
67 fmap func (Result warnings rawResult) =
68 case rawResult of
69 Ok a ->
70 Result warnings (Ok (func a))
72 Err msgs ->
73 Result warnings (Err msgs)
76instance A.Applicative (Result w e) where
77 pure value =
78 ok value
80 (<*>) (Result warnings resultFunc) (Result warnings' resultVal) =
81 Result (warnings ++ warnings') $
82 case (resultFunc, resultVal) of
83 (Ok func, Ok val) ->
84 Ok (func val)
86 (Err msgs, Err msgs') ->
87 Err (msgs ++ msgs')
89 (Err msgs, _) ->
90 Err msgs
92 (_, Err msgs) ->
93 Err msgs
96instance M.Monad (Result w e) where
97 return value =
98 ok value
100 (>>=) (Result warnings rawResult) callback =
101 case rawResult of
102 Err msg ->
103 Result warnings (Err msg)
105 Ok value ->
106 let (Result warnings' rawResult') = callback value
107 in
108 Result (warnings ++ warnings') rawResult'