module Generics.SOP.Util.PartialResult (
Partial(..)
, runPartial
, partialResult
, lift
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
data Partial (f :: * -> *) (a :: *) =
Fail [String]
| PZero a
| PSucc (f (Partial f a))
partialResult :: Monad f => Partial f a -> Partial f a
partialResult :: forall (f :: * -> *) a. Monad f => Partial f a -> Partial f a
partialResult = forall (f :: * -> *) a. f (Partial f a) -> Partial f a
PSucc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
instance Functor f => Functor (Partial f) where
fmap :: forall a b. (a -> b) -> Partial f a -> Partial f b
fmap a -> b
_ (Fail [String]
e) = forall (f :: * -> *) a. [String] -> Partial f a
Fail [String]
e
fmap a -> b
f (PZero a
a) = forall (f :: * -> *) a. a -> Partial f a
PZero (a -> b
f a
a)
fmap a -> b
f (PSucc f (Partial f a)
pa) = forall (f :: * -> *) a. f (Partial f a) -> Partial f a
PSucc (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) f (Partial f a)
pa)
instance Functor f => Monad (Partial f) where
return :: forall a. a -> Partial f a
return = forall (f :: * -> *) a. a -> Partial f a
PZero
#if !MIN_VERSION_base(4,13,0)
fail = Fail . return
#endif
Fail [String]
e >>= :: forall a b. Partial f a -> (a -> Partial f b) -> Partial f b
>>= a -> Partial f b
_ = forall (f :: * -> *) a. [String] -> Partial f a
Fail [String]
e
PZero a
a >>= a -> Partial f b
f = a -> Partial f b
f a
a
PSucc f (Partial f a)
fa >>= a -> Partial f b
f = forall (f :: * -> *) a. f (Partial f a) -> Partial f a
PSucc (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Partial f b
f) f (Partial f a)
fa)
#if MIN_VERSION_base(4,13,0)
instance Functor f => MonadFail (Partial f) where
fail :: forall a. String -> Partial f a
fail = forall (f :: * -> *) a. [String] -> Partial f a
Fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
#endif
instance (MonadPlus f, Functor f) => MonadPlus (Partial f) where
mzero :: forall a. Partial f a
mzero = forall (f :: * -> *) a. [String] -> Partial f a
Fail []
Fail [String]
a mplus :: forall a. Partial f a -> Partial f a -> Partial f a
`mplus` Fail [String]
b = forall (f :: * -> *) a. [String] -> Partial f a
Fail ([String]
a forall a. [a] -> [a] -> [a]
++ [String]
b)
Fail [String]
_ `mplus` Partial f a
b = Partial f a
b
Partial f a
a `mplus` Fail [String]
_ = Partial f a
a
PZero a
a `mplus` PZero a
_ = forall (f :: * -> *) a. a -> Partial f a
PZero a
a
PZero a
_ `mplus` PSucc f (Partial f a)
b = forall (f :: * -> *) a. f (Partial f a) -> Partial f a
PSucc f (Partial f a)
b
PSucc f (Partial f a)
a `mplus` PZero a
_ = forall (f :: * -> *) a. f (Partial f a) -> Partial f a
PSucc f (Partial f a)
a
PSucc f (Partial f a)
a `mplus` PSucc f (Partial f a)
b = forall (f :: * -> *) a. f (Partial f a) -> Partial f a
PSucc (f (Partial f a)
a forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` f (Partial f a)
b)
instance MonadTrans Partial where
lift :: forall (m :: * -> *) a. Monad m => m a -> Partial m a
lift m a
ma = forall (f :: * -> *) a. f (Partial f a) -> Partial f a
PSucc (forall (f :: * -> *) a. a -> Partial f a
PZero forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
ma)
instance Functor f => Applicative (Partial f) where
pure :: forall a. a -> Partial f a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
Partial f (a -> b)
f <*> :: forall a b. Partial f (a -> b) -> Partial f a -> Partial f b
<*> Partial f a
a = do a -> b
f' <- Partial f (a -> b)
f ; a
a' <- Partial f a
a ; forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f' a
a')
instance (MonadPlus f, Functor f) => Alternative (Partial f) where
empty :: forall a. Partial f a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: forall a. Partial f a -> Partial f a -> Partial f a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
runPartial :: Monad m => ([String] -> m a) -> Partial m a -> m a
runPartial :: forall (m :: * -> *) a.
Monad m =>
([String] -> m a) -> Partial m a -> m a
runPartial [String] -> m a
failWith = Partial m a -> m a
go
where
go :: Partial m a -> m a
go (PZero a
a) = forall (m :: * -> *) a. Monad m => a -> m a
return a
a
go (PSucc m (Partial m a)
fa) = m (Partial m a)
fa forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Partial m a -> m a
go
go (Fail [String]
es) = [String] -> m a
failWith [String]
es