module Shrun.Data.Result
  ( Result (..),
  )
where

import Control.Applicative (Applicative (pure, (<*>)))
import Control.Category ((.))
import Control.Monad (Monad ((>>=)), MonadFail (fail))
import Data.Eq (Eq)
import Data.Foldable (Foldable (foldr))
import Data.Functor (Functor, (<$>))
import Data.Monoid (Monoid (mempty))
import Data.Semigroup (Semigroup ((<>)))
import Data.String (IsString (fromString))
import Data.Traversable (Traversable (sequenceA, traverse))
import Text.Show (Show)

-- | Either with custom MonadFail and fail-fast Semigroup instances.
data Result e a
  = Err e
  | Ok a
  deriving stock (Result e a -> Result e a -> Bool
(Result e a -> Result e a -> Bool)
-> (Result e a -> Result e a -> Bool) -> Eq (Result e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => Result e a -> Result e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => Result e a -> Result e a -> Bool
== :: Result e a -> Result e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => Result e a -> Result e a -> Bool
/= :: Result e a -> Result e a -> Bool
Eq, (forall a b. (a -> b) -> Result e a -> Result e b)
-> (forall a b. a -> Result e b -> Result e a)
-> Functor (Result e)
forall a b. a -> Result e b -> Result e a
forall a b. (a -> b) -> Result e a -> Result e b
forall e a b. a -> Result e b -> Result e a
forall e a b. (a -> b) -> Result e a -> Result e b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall e a b. (a -> b) -> Result e a -> Result e b
fmap :: forall a b. (a -> b) -> Result e a -> Result e b
$c<$ :: forall e a b. a -> Result e b -> Result e a
<$ :: forall a b. a -> Result e b -> Result e a
Functor, Int -> Result e a -> ShowS
[Result e a] -> ShowS
Result e a -> String
(Int -> Result e a -> ShowS)
-> (Result e a -> String)
-> ([Result e a] -> ShowS)
-> Show (Result e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Result e a -> ShowS
forall e a. (Show e, Show a) => [Result e a] -> ShowS
forall e a. (Show e, Show a) => Result e a -> String
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Result e a -> ShowS
showsPrec :: Int -> Result e a -> ShowS
$cshow :: forall e a. (Show e, Show a) => Result e a -> String
show :: Result e a -> String
$cshowList :: forall e a. (Show e, Show a) => [Result e a] -> ShowS
showList :: [Result e a] -> ShowS
Show)

instance (Semigroup a) => Semigroup (Result e a) where
  Err e
x <> :: Result e a -> Result e a -> Result e a
<> Result e a
_ = e -> Result e a
forall e a. e -> Result e a
Err e
x
  Result e a
_ <> Err e
y = e -> Result e a
forall e a. e -> Result e a
Err e
y
  Ok a
x <> Ok a
y = a -> Result e a
forall e a. a -> Result e a
Ok (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y)

instance (Monoid a) => Monoid (Result e a) where
  mempty :: Result e a
mempty = a -> Result e a
forall e a. a -> Result e a
Ok a
forall a. Monoid a => a
mempty

instance Applicative (Result e) where
  pure :: forall a. a -> Result e a
pure = a -> Result e a
forall e a. a -> Result e a
Ok

  Err e
x <*> :: forall a b. Result e (a -> b) -> Result e a -> Result e b
<*> Result e a
_ = e -> Result e b
forall e a. e -> Result e a
Err e
x
  Result e (a -> b)
_ <*> Err e
x = e -> Result e b
forall e a. e -> Result e a
Err e
x
  Ok a -> b
f <*> Ok a
x = b -> Result e b
forall e a. a -> Result e a
Ok (a -> b
f a
x)

instance Monad (Result e) where
  Err e
x >>= :: forall a b. Result e a -> (a -> Result e b) -> Result e b
>>= a -> Result e b
_ = e -> Result e b
forall e a. e -> Result e a
Err e
x
  Ok a
x >>= a -> Result e b
f = a -> Result e b
f a
x

instance Foldable (Result e) where
  foldr :: forall a b. (a -> b -> b) -> b -> Result e a -> b
foldr a -> b -> b
_ b
e (Err e
_) = b
e
  foldr a -> b -> b
f b
e (Ok a
x) = a -> b -> b
f a
x b
e

instance Traversable (Result e) where
  sequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
Result e (f a) -> f (Result e a)
sequenceA (Err e
x) = Result e a -> f (Result e a)
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (e -> Result e a
forall e a. e -> Result e a
Err e
x)
  sequenceA (Ok f a
x) = a -> Result e a
forall e a. a -> Result e a
Ok (a -> Result e a) -> f a -> f (Result e a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x

  traverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Result e a -> f (Result e b)
traverse a -> f b
_ (Err e
x) = Result e b -> f (Result e b)
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (e -> Result e b
forall e a. e -> Result e a
Err e
x)
  traverse a -> f b
f (Ok a
x) = b -> Result e b
forall e a. a -> Result e a
Ok (b -> Result e b) -> f b -> f (Result e b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

instance (IsString e) => MonadFail (Result e) where
  fail :: forall a. String -> Result e a
fail = e -> Result e a
forall e a. e -> Result e a
Err (e -> Result e a) -> (String -> e) -> String -> Result e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> e
forall a. IsString a => String -> a
fromString