{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE CPP #-}

module Data.Predicate.Result where

import Control.Applicative
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import qualified Control.Monad.Fail as Fail
#endif
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Prelude

-- | A 'Bool'-like type where each branch--@Fail@ and @Okay@--carries
-- some metadata.
data Result f t
    = Fail f
    | Okay !Double t
    deriving (Result f t -> Result f t -> Bool
(Result f t -> Result f t -> Bool)
-> (Result f t -> Result f t -> Bool) -> Eq (Result f t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall f t. (Eq f, Eq t) => Result f t -> Result f t -> Bool
/= :: Result f t -> Result f t -> Bool
$c/= :: forall f t. (Eq f, Eq t) => Result f t -> Result f t -> Bool
== :: Result f t -> Result f t -> Bool
$c== :: forall f t. (Eq f, Eq t) => Result f t -> Result f t -> Bool
Eq, Eq (Result f t)
Eq (Result f t)
-> (Result f t -> Result f t -> Ordering)
-> (Result f t -> Result f t -> Bool)
-> (Result f t -> Result f t -> Bool)
-> (Result f t -> Result f t -> Bool)
-> (Result f t -> Result f t -> Bool)
-> (Result f t -> Result f t -> Result f t)
-> (Result f t -> Result f t -> Result f t)
-> Ord (Result f t)
Result f t -> Result f t -> Bool
Result f t -> Result f t -> Ordering
Result f t -> Result f t -> Result f t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall f t. (Ord f, Ord t) => Eq (Result f t)
forall f t. (Ord f, Ord t) => Result f t -> Result f t -> Bool
forall f t. (Ord f, Ord t) => Result f t -> Result f t -> Ordering
forall f t.
(Ord f, Ord t) =>
Result f t -> Result f t -> Result f t
min :: Result f t -> Result f t -> Result f t
$cmin :: forall f t.
(Ord f, Ord t) =>
Result f t -> Result f t -> Result f t
max :: Result f t -> Result f t -> Result f t
$cmax :: forall f t.
(Ord f, Ord t) =>
Result f t -> Result f t -> Result f t
>= :: Result f t -> Result f t -> Bool
$c>= :: forall f t. (Ord f, Ord t) => Result f t -> Result f t -> Bool
> :: Result f t -> Result f t -> Bool
$c> :: forall f t. (Ord f, Ord t) => Result f t -> Result f t -> Bool
<= :: Result f t -> Result f t -> Bool
$c<= :: forall f t. (Ord f, Ord t) => Result f t -> Result f t -> Bool
< :: Result f t -> Result f t -> Bool
$c< :: forall f t. (Ord f, Ord t) => Result f t -> Result f t -> Bool
compare :: Result f t -> Result f t -> Ordering
$ccompare :: forall f t. (Ord f, Ord t) => Result f t -> Result f t -> Ordering
$cp1Ord :: forall f t. (Ord f, Ord t) => Eq (Result f t)
Ord, Int -> Result f t -> ShowS
[Result f t] -> ShowS
Result f t -> String
(Int -> Result f t -> ShowS)
-> (Result f t -> String)
-> ([Result f t] -> ShowS)
-> Show (Result f t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall f t. (Show f, Show t) => Int -> Result f t -> ShowS
forall f t. (Show f, Show t) => [Result f t] -> ShowS
forall f t. (Show f, Show t) => Result f t -> String
showList :: [Result f t] -> ShowS
$cshowList :: forall f t. (Show f, Show t) => [Result f t] -> ShowS
show :: Result f t -> String
$cshow :: forall f t. (Show f, Show t) => Result f t -> String
showsPrec :: Int -> Result f t -> ShowS
$cshowsPrec :: forall f t. (Show f, Show t) => Int -> Result f t -> ShowS
Show)

instance Functor (Result f) where
    fmap :: (a -> b) -> Result f a -> Result f b
fmap a -> b
f (Okay Double
d a
x) = Double -> b -> Result f b
forall f t. Double -> t -> Result f t
Okay Double
d (a -> b
f a
x)
    fmap a -> b
_ (Fail   f
x) = f -> Result f b
forall f t. f -> Result f t
Fail f
x

instance Applicative (Result f) where
    pure :: a -> Result f a
pure  = a -> Result f a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: Result f (a -> b) -> Result f a -> Result f b
(<*>) = Result f (a -> b) -> Result f a -> Result f b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (Result f) where
    return :: a -> Result f a
return           = Double -> a -> Result f a
forall f t. Double -> t -> Result f t
Okay Double
0
    (Okay Double
_ a
x) >>= :: Result f a -> (a -> Result f b) -> Result f b
>>= a -> Result f b
k = a -> Result f b
k a
x
    (Fail   f
x) >>= a -> Result f b
_ = f -> Result f b
forall f t. f -> Result f t
Fail f
x

result :: (f -> a) -> (Double -> t -> a) -> Result f t -> a
result :: (f -> a) -> (Double -> t -> a) -> Result f t -> a
result f -> a
f Double -> t -> a
_ (Fail   f
x) = f -> a
f f
x
result f -> a
_ Double -> t -> a
g (Okay Double
d t
x) = Double -> t -> a
g Double
d t
x

fromEither :: Either f t -> Result f t
fromEither :: Either f t -> Result f t
fromEither = (f -> Result f t) -> (t -> Result f t) -> Either f t -> Result f t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either f -> Result f t
forall f t. f -> Result f t
Fail t -> Result f t
forall (m :: * -> *) a. Monad m => a -> m a
return

toEither :: Result f t -> Either f t
toEither :: Result f t -> Either f t
toEither = (f -> Either f t)
-> (Double -> t -> Either f t) -> Result f t -> Either f t
forall f a t. (f -> a) -> (Double -> t -> a) -> Result f t -> a
result f -> Either f t
forall a b. a -> Either a b
Left (\Double
_ t
x -> t -> Either f t
forall a b. b -> Either a b
Right t
x)

newtype ResultT f m t = ResultT { ResultT f m t -> m (Result f t)
runResultT :: m (Result f t) }

instance Monad m => Functor (ResultT f m) where
    fmap :: (a -> b) -> ResultT f m a -> ResultT f m b
fmap a -> b
f = m (Result f b) -> ResultT f m b
forall f (m :: * -> *) t. m (Result f t) -> ResultT f m t
ResultT (m (Result f b) -> ResultT f m b)
-> (ResultT f m a -> m (Result f b))
-> ResultT f m a
-> ResultT f m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result f a -> Result f b) -> m (Result f a) -> m (Result f b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((a -> b) -> Result f a -> Result f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (m (Result f a) -> m (Result f b))
-> (ResultT f m a -> m (Result f a))
-> ResultT f m a
-> m (Result f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultT f m a -> m (Result f a)
forall f (m :: * -> *) t. ResultT f m t -> m (Result f t)
runResultT

instance Monad m => Applicative (ResultT f m) where
    pure :: a -> ResultT f m a
pure  = a -> ResultT f m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: ResultT f m (a -> b) -> ResultT f m a -> ResultT f m b
(<*>) = ResultT f m (a -> b) -> ResultT f m a -> ResultT f m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Monad (ResultT f m) where
    return :: a -> ResultT f m a
return  = m (Result f a) -> ResultT f m a
forall f (m :: * -> *) t. m (Result f t) -> ResultT f m t
ResultT (m (Result f a) -> ResultT f m a)
-> (a -> m (Result f a)) -> a -> ResultT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result f a -> m (Result f a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result f a -> m (Result f a))
-> (a -> Result f a) -> a -> m (Result f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Result f a
forall (m :: * -> *) a. Monad m => a -> m a
return
    ResultT f m a
m >>= :: ResultT f m a -> (a -> ResultT f m b) -> ResultT f m b
>>= a -> ResultT f m b
k = m (Result f b) -> ResultT f m b
forall f (m :: * -> *) t. m (Result f t) -> ResultT f m t
ResultT (m (Result f b) -> ResultT f m b)
-> m (Result f b) -> ResultT f m b
forall a b. (a -> b) -> a -> b
$ ResultT f m a -> m (Result f a)
forall f (m :: * -> *) t. ResultT f m t -> m (Result f t)
runResultT ResultT f m a
m m (Result f a) -> (Result f a -> m (Result f b)) -> m (Result f b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Result f a
a -> case Result f a
a of
        Okay Double
_ a
x -> ResultT f m b -> m (Result f b)
forall f (m :: * -> *) t. ResultT f m t -> m (Result f t)
runResultT (a -> ResultT f m b
k a
x)
        Fail   f
x -> Result f b -> m (Result f b)
forall (m :: * -> *) a. Monad m => a -> m a
return (f -> Result f b
forall f t. f -> Result f t
Fail f
x)

#if !MIN_VERSION_base(4,13,0)
instance Fail.MonadFail m => Fail.MonadFail (ResultT f m) where
    fail = ResultT . Fail.fail
#else
instance MonadFail m => MonadFail (ResultT f m) where
    fail :: String -> ResultT f m a
fail = m (Result f a) -> ResultT f m a
forall f (m :: * -> *) t. m (Result f t) -> ResultT f m t
ResultT (m (Result f a) -> ResultT f m a)
-> (String -> m (Result f a)) -> String -> ResultT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m (Result f a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
#endif

instance MonadTrans (ResultT f) where
    lift :: m a -> ResultT f m a
lift = m (Result f a) -> ResultT f m a
forall f (m :: * -> *) t. m (Result f t) -> ResultT f m t
ResultT (m (Result f a) -> ResultT f m a)
-> (m a -> m (Result f a)) -> m a -> ResultT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Result f a) -> m a -> m (Result f a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Result f a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance MonadIO m => MonadIO (ResultT f m) where
    liftIO :: IO a -> ResultT f m a
liftIO = m a -> ResultT f m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ResultT f m a) -> (IO a -> m a) -> IO a -> ResultT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

resultT :: Monad m => (f -> m a) -> (Double -> t -> m a) -> ResultT f m t -> m a
resultT :: (f -> m a) -> (Double -> t -> m a) -> ResultT f m t -> m a
resultT f -> m a
f Double -> t -> m a
g (ResultT m (Result f t)
m) = m (Result f t)
m m (Result f t) -> (Result f t -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Result f t
a -> case Result f t
a of
    Fail   f
x -> f -> m a
f f
x
    Okay Double
d t
x -> Double -> t -> m a
g Double
d t
x

resultT' :: Monad m => (f -> m a) -> (t -> m a) -> ResultT f m t -> m a
resultT' :: (f -> m a) -> (t -> m a) -> ResultT f m t -> m a
resultT' f -> m a
f t -> m a
g = (f -> m a) -> (Double -> t -> m a) -> ResultT f m t -> m a
forall (m :: * -> *) f a t.
Monad m =>
(f -> m a) -> (Double -> t -> m a) -> ResultT f m t -> m a
resultT f -> m a
f (\Double
_ t
x -> t -> m a
g t
x)

mapResultT :: (m (Result f t) -> n (Result f' t')) -> ResultT f m t -> ResultT f' n t'
mapResultT :: (m (Result f t) -> n (Result f' t'))
-> ResultT f m t -> ResultT f' n t'
mapResultT m (Result f t) -> n (Result f' t')
f ResultT f m t
m = n (Result f' t') -> ResultT f' n t'
forall f (m :: * -> *) t. m (Result f t) -> ResultT f m t
ResultT (n (Result f' t') -> ResultT f' n t')
-> n (Result f' t') -> ResultT f' n t'
forall a b. (a -> b) -> a -> b
$ m (Result f t) -> n (Result f' t')
f (ResultT f m t -> m (Result f t)
forall f (m :: * -> *) t. ResultT f m t -> m (Result f t)
runResultT ResultT f m t
m)

hoistResult :: Monad m => Result f t -> ResultT f m t
hoistResult :: Result f t -> ResultT f m t
hoistResult = m (Result f t) -> ResultT f m t
forall f (m :: * -> *) t. m (Result f t) -> ResultT f m t
ResultT (m (Result f t) -> ResultT f m t)
-> (Result f t -> m (Result f t)) -> Result f t -> ResultT f m t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result f t -> m (Result f t)
forall (m :: * -> *) a. Monad m => a -> m a
return

okay :: Monad m => Double -> t -> ResultT f m t
okay :: Double -> t -> ResultT f m t
okay Double
d = Result f t -> ResultT f m t
forall (m :: * -> *) f t. Monad m => Result f t -> ResultT f m t
hoistResult (Result f t -> ResultT f m t)
-> (t -> Result f t) -> t -> ResultT f m t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> t -> Result f t
forall f t. Double -> t -> Result f t
Okay Double
d

throwF :: Monad m => f -> ResultT f m t
throwF :: f -> ResultT f m t
throwF = Result f t -> ResultT f m t
forall (m :: * -> *) f t. Monad m => Result f t -> ResultT f m t
hoistResult (Result f t -> ResultT f m t)
-> (f -> Result f t) -> f -> ResultT f m t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> Result f t
forall f t. f -> Result f t
Fail