git.iko.soy/elk
on f4401ac help sign in
elk/compiler/src/Reporting/Result.hs
121 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
14import qualified Data.OneOrMore as OneOrMore
15import qualified Reporting.Warning as Warning
19-- RESULT
22newtype Result info warnings error a =
23 Result (
24 forall result.
25 info
26 -> warnings
27 -> (info -> warnings -> OneOrMore.OneOrMore error -> result)
28 -> (info -> warnings -> a -> result)
29 -> result
30 )
33run :: Result () [w] e a -> ([w], Either (OneOrMore.OneOrMore e) a)
34run (Result k) =
35 k () []
36 (\() w e -> (reverse w, Left e))
37 (\() w a -> (reverse w, Right a))
41-- HELPERS
44ok :: a -> Result i w e a
45ok a =
46 Result $ \i w _ good ->
47 good i w a
50warn :: Warning.Warning -> Result i [Warning.Warning] e ()
51warn warning =
52 Result $ \i warnings _ good ->
53 good i (warning:warnings) ()
56throw :: e -> Result i w e a
57throw e =
58 Result $ \i w bad _ ->
59 bad i w (OneOrMore.one e)
62mapError :: (e -> e') -> Result i w e a -> Result i w e' a
63mapError func (Result k) =
64 Result $ \i w bad good ->
65 let
66 bad1 i1 w1 e1 =
67 bad i1 w1 (OneOrMore.map func e1)
68 in
69 k i w bad1 good
73-- FANCY INSTANCE STUFF
76instance Functor (Result i w e) where
77 fmap func (Result k) =
78 Result $ \i w bad good ->
79 let
80 good1 i1 w1 value =
81 good i1 w1 (func value)
82 in
83 k i w bad good1
86instance Applicative (Result i w e) where
87 pure = ok
89 (<*>) (Result kf) (Result kv) =
90 Result $ \i w bad good ->
91 let
92 bad1 i1 w1 e1 =
93 let
94 bad2 i2 w2 e2 = bad i2 w2 (OneOrMore.more e1 e2)
95 good2 i2 w2 _value = bad i2 w2 e1
96 in
97 kv i1 w1 bad2 good2
99 good1 i1 w1 func =
100 let
101 bad2 i2 w2 e2 = bad i2 w2 e2
102 good2 i2 w2 value = good i2 w2 (func value)
103 in
104 kv i1 w1 bad2 good2
105 in
106 kf i w bad1 good1
109instance Monad (Result i w e) where
110 return = ok
112 (>>=) (Result ka) callback =
113 Result $ \i w bad good ->
114 let
115 good1 i1 w1 a =
116 case callback a of
117 Result kb -> kb i1 w1 bad good
118 in
119 ka i w bad good1
121 -- TODO PERF add more specialized definitions?