git.iko.soy/elk
on 00a3069 help sign in
elk/src/Reporting/Result.hs
123 lines 2.3 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE Rank2Types #-}
3module Reporting.Result
4 ( Result(..)
5 , run
6 , ok
7 , warn
8 , throw
9 , mapError
10 )
11 where
14-- TODO try adding INLINE to warn, throw, (>>=), etc.
17import qualified Data.OneOrMore as OneOrMore
18import qualified Reporting.Warning as Warning
22-- RESULT
25newtype Result info warnings error a =
26 Result (
27 forall result.
28 info
29 -> warnings
30 -> (info -> warnings -> OneOrMore.OneOrMore error -> result)
31 -> (info -> warnings -> a -> result)
32 -> result
33 )
36run :: Result () [w] e a -> ([w], Either [e] a)
37run (Result k) =
38 k () []
39 (\() w e -> (reverse w, Left (OneOrMore.toList e)))
40 (\() w a -> (reverse w, Right a))
44-- HELPERS
47{-# INLINE ok #-}
48ok :: a -> Result i w e a
49ok a =
50 Result $ \i w _ good ->
51 good i w a
54warn :: Warning.Warning -> Result i [Warning.Warning] e ()
55warn warning =
56 Result $ \i warnings _ good ->
57 good i (warning:warnings) ()
60throw :: e -> Result i w e a
61throw e =
62 Result $ \i w bad _ ->
63 bad i w (OneOrMore.one e)
66mapError :: (e -> e') -> Result i w e a -> Result i w e' a
67mapError func (Result k) =
68 Result $ \i w bad good ->
69 let
70 bad1 i1 w1 e1 =
71 bad i1 w1 (OneOrMore.map func e1)
72 in
73 k i w bad1 good
77-- FANCY INSTANCE STUFF
80instance Functor (Result i w e) where
81 fmap func (Result k) =
82 Result $ \i w bad good ->
83 let
84 good1 i1 w1 value =
85 good i1 w1 (func value)
86 in
87 k i w bad good1
90instance Applicative (Result i w e) where
91 pure = ok
93 (<*>) (Result kf) (Result kv) =
94 Result $ \i w bad good ->
95 let
96 bad1 i1 w1 e1 =
97 let
98 bad2 i2 w2 e2 = bad i2 w2 (OneOrMore.more e1 e2)
99 good2 i2 w2 _value = bad i2 w2 e1
100 in
101 kv i1 w1 bad2 good2
103 good1 i1 w1 func =
104 let
105 bad2 i2 w2 e2 = bad i2 w2 e2
106 good2 i2 w2 value = good i2 w2 (func value)
107 in
108 kv i1 w1 bad2 good2
109 in
110 kf i w bad1 good1
113instance Monad (Result i w e) where
114 return = ok
116 (>>=) (Result ka) callback =
117 Result $ \i w bad good ->
118 let
119 good1 i1 w1 a =
120 case callback a of
121 Result kb -> kb i1 w1 bad good
122 in
123 ka i w bad good1