@@ -0,0 +1,44 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE DeriveFunctor #-}
3+
4+module Database.PostgreSQL.Simple.Ok where
5+
6+import Control.Applicative
7+import Control.Exception
8+import Data.Typeable
9+
10+-- FIXME: [SomeException] should probably be a difference list
11+
12+data Ok a = Errors [SomeException] | Ok !a
13+ deriving(Show, Typeable, Functor)
14+
15+instance Eq a => Eq (Ok a) where
16+ Errors _ == Errors _ = True
17+ Ok a == Ok b = a == b
18+ _ == _ = False
19+
20+instance Applicative Ok where
21+ pure = Ok
22+
23+ Errors es <*> _ = Errors es
24+ _ <*> Errors es = Errors es
25+ Ok f <*> Ok a = Ok (f a)
26+
27+instance Alternative Ok where
28+ empty = Errors []
29+
30+ a@(Ok _) <|> _ = a
31+ Errors _ <|> b@(Ok _) = b
32+ Errors as <|> Errors bs = Errors (as ++ bs)
33+
34+instance Monad Ok where
35+ return = Ok
36+
37+ Errors es >>= _ = Errors es
38+ Ok a >>= f = f a
39+ -- TODO: add a definition for "fail", akin to
40+
41+ -- fail str = Errors [SomeException (error str)]
42+
43+ -- but *correct*, as this will throw an exception if you try to
44+ -- examine the exception.