Error.icl 2.31 KB
Newer Older
1
implementation module Data.Error
Jeroen Henrix's avatar
Jeroen Henrix committed
2 3

import StdMisc
4
import Data.Functor, Data.Maybe, Data.GenEq
5 6
import Control.Monad
import Control.Applicative
7 8 9 10 11
	
instance Functor (MaybeError a)
where
	fmap f (Ok x)		= Ok (f x)
	fmap f (Error x)	= Error x
Jeroen Henrix's avatar
Jeroen Henrix committed
12

13 14 15 16 17 18
instance pure (MaybeError a)
where
	pure x = Ok x

instance <*> (MaybeError a)
where
19 20 21 22 23 24 25
    (<*>) (Error e) _ = Error e
    (<*>) (Ok f)    r = fmap f r

instance Monad (MaybeError e) where
    bind (Error l) _ = Error l
    bind (Ok r) k = k r

26 27
derive gEq MaybeError

Jeroen Henrix's avatar
Jeroen Henrix committed
28 29 30 31 32 33 34 35
isOk		:: !(MaybeError a b) -> Bool
isOk		(Ok _) 		= True
isOk		(Error _)	= False

isError		:: !(MaybeError a b) -> Bool
isError		(Ok _) 		= False
isError		(Error _)	= True

36
fromOk		:: !(MaybeError .a .b) -> .b
37
fromOk		(Ok b) 		= b
Jeroen Henrix's avatar
Jeroen Henrix committed
38 39
fromOk		(Error _)	= abort "Data.Error.fromOk: argument is Error"

40
fromError	:: !(MaybeError .a .b) -> .a
41
fromError	(Error a) 	= a
Jeroen Henrix's avatar
Jeroen Henrix committed
42 43
fromError	(Ok _)		= abort "Data.Error.fromError: argument is Ok"

44
liftError :: !(MaybeError .a .b) -> (MaybeError .a .c)
45
liftError	(Error a)	= Error a
Jeroen Henrix's avatar
Jeroen Henrix committed
46
liftError	(Ok _)		= abort "Data.Error.liftError: argument is Ok"
47 48 49 50

mb2error :: !e !(Maybe a) -> MaybeError e a
mb2error error mbV = maybe (Error error) Ok mbV

51
okSt :: *st (.a *st -> *st) !(MaybeError .e .a) -> *st
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
52 53 54
okSt st f (Error _) = st
okSt st f (Ok x)    = f x st

55 56 57 58
error2mb :: !(MaybeError e a) -> Maybe a
error2mb (Error _) = Nothing
error2mb (Ok a)  = Just a

59 60
seqErrors :: !(MaybeError e a) (a -> MaybeError e b) -> MaybeError e b
seqErrors a bfunc = case a of
61 62 63 64 65 66 67 68 69 70
	Ok a	= bfunc a
	Error e	= Error e

combineErrors :: !(MaybeError e a) (MaybeError e b) (a b -> MaybeError e c) -> MaybeError e c
combineErrors a b combf = case a of
	Error e = Error e
	Ok a = case b of
		Error e	= Error e
		Ok b	= combf a b
		
71
seqErrorsSt :: !(.st -> (MaybeError e a,.st)) (a .st -> u:(MaybeError e b, .st)) !.st -> v:(MaybeError e b, !.st), [u <= v]
72 73 74 75 76 77 78
seqErrorsSt aop bop st
	# (a,st) = aop st
	= case a of
		Error e = (Error e,st)
		Ok a	= bop a st

		
79
combineErrorsSt :: !(.st -> (MaybeError e a, .st)) (.st -> (MaybeError e b, .st)) (a b -> MaybeError e c) !.st -> (!MaybeError e c, !.st)
80 81 82 83 84 85 86 87 88
combineErrorsSt aop bop combf st
	# (a,st) = aop st
	= case a of
		Error e = (Error e,st)
		Ok a
			# (b,st) = bop st
			= case b of
				Error e = (Error e, st)
				Ok b	= (combf a b, st)