{-# LANGUAGE UndecidableInstances #-}

module Navi.Data.Result
  ( Result (..),
    ResultDefault,

    -- * Elimination
    onResult,
    onErr,
    onOk,
    errorErr,
    failErr,
    throwErr,
  )
where

import Control.DeepSeq (NFData)
import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow (throwM))
import Data.Bifoldable (Bifoldable (bifoldMap))
import Data.Bifunctor (Bifunctor (bimap))
import Data.Bitraversable (Bitraversable (bitraverse))
import Data.String (IsString (fromString))
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Optics.Core (An_Iso, LabelOptic, iso)
import Optics.Label (LabelOptic (labelOptic))
import Prelude

-- | General type for error handling, with convenient MonadFail instance.
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, (forall x. Result e a -> Rep (Result e a) x)
-> (forall x. Rep (Result e a) x -> Result e a)
-> Generic (Result e a)
forall x. Rep (Result e a) x -> Result e a
forall x. Result e a -> Rep (Result e a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e a x. Rep (Result e a) x -> Result e a
forall e a x. Result e a -> Rep (Result e a) x
$cfrom :: forall e a x. Result e a -> Rep (Result e a) x
from :: forall x. Result e a -> Rep (Result e a) x
$cto :: forall e a x. Rep (Result e a) x -> Result e a
to :: forall x. Rep (Result e a) x -> Result e a
Generic, 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)
  deriving anyclass (Result e a -> ()
(Result e a -> ()) -> NFData (Result e a)
forall a. (a -> ()) -> NFData a
forall e a. (NFData e, NFData a) => Result e a -> ()
$crnf :: forall e a. (NFData e, NFData a) => Result e a -> ()
rnf :: Result e a -> ()
NFData)

instance
  ( k ~ An_Iso,
    x ~ Either e a,
    y ~ Either e a
  ) =>
  LabelOptic "eitherIso" k (Result e a) (Result e a) x y
  where
  labelOptic :: Optic k NoIx (Result e a) (Result e a) x y
labelOptic =
    (Result e a -> x)
-> (y -> Result e a) -> Iso (Result e a) (Result e a) x y
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
      (\case Ok a
x -> a -> Either e a
forall a b. b -> Either a b
Right a
x; Err e
x -> e -> Either e a
forall a b. a -> Either a b
Left e
x)
      (\case Right a
x -> a -> Result e a
forall e a. a -> Result e a
Ok a
x; Left e
x -> e -> Result e a
forall e a. e -> Result e a
Err e
x)

type ResultDefault = Result String

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
f b
e = (e -> b) -> (a -> b) -> Result e a -> b
forall e b a. (e -> b) -> (a -> b) -> Result e a -> b
onResult (b -> e -> b
forall a b. a -> b -> a
const b
e) (a -> b -> b
`f` b
e)

instance Traversable (Result e) where
  sequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
Result e (f a) -> f (Result e a)
sequenceA = (e -> f (Result e a))
-> (f a -> f (Result e a)) -> Result e (f a) -> f (Result e a)
forall e b a. (e -> b) -> (a -> b) -> Result e a -> b
onResult (Result e a -> f (Result e a)
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result e a -> f (Result e a))
-> (e -> Result e a) -> e -> f (Result e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Result e a
forall e a. e -> Result e a
Err) ((a -> Result e a) -> f a -> f (Result e a)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Result e a
forall e a. a -> Result e a
Ok)

  traverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Result e a -> f (Result e b)
traverse a -> f b
f = (e -> f (Result e b))
-> (a -> f (Result e b)) -> Result e a -> f (Result e b)
forall e b a. (e -> b) -> (a -> b) -> Result e a -> b
onResult (Result e b -> f (Result e b)
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result e b -> f (Result e b))
-> (e -> Result e b) -> e -> f (Result e b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Result e b
forall e a. e -> Result e a
Err) ((b -> Result e b) -> f b -> f (Result e b)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Result e b
forall e a. a -> Result e a
Ok (f b -> f (Result e b)) -> (a -> f b) -> a -> f (Result e b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f)

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
. String -> e
forall a. IsString a => String -> a
fromString

instance Bifunctor Result where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Result a c -> Result b d
bimap a -> b
f c -> d
g = (a -> Result b d) -> (c -> Result b d) -> Result a c -> Result b d
forall e b a. (e -> b) -> (a -> b) -> Result e a -> b
onResult (b -> Result b d
forall e a. e -> Result e a
Err (b -> Result b d) -> (a -> b) -> a -> Result b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (d -> Result b d
forall e a. a -> Result e a
Ok (d -> Result b d) -> (c -> d) -> c -> Result b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g)

instance Bifoldable Result where
  bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Result a b -> m
bifoldMap = (a -> m) -> (b -> m) -> Result a b -> m
forall e b a. (e -> b) -> (a -> b) -> Result e a -> b
onResult

instance Bitraversable Result where
  bitraverse :: forall (f :: Type -> Type) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Result a b -> f (Result c d)
bitraverse a -> f c
f b -> f d
g = (a -> f (Result c d))
-> (b -> f (Result c d)) -> Result a b -> f (Result c d)
forall e b a. (e -> b) -> (a -> b) -> Result e a -> b
onResult ((c -> Result c d) -> f c -> f (Result c d)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> Result c d
forall e a. e -> Result e a
Err (f c -> f (Result c d)) -> (a -> f c) -> a -> f (Result c d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f c
f) ((d -> Result c d) -> f d -> f (Result c d)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap d -> Result c d
forall e a. a -> Result e a
Ok (f d -> f (Result c d)) -> (b -> f d) -> b -> f (Result c d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> f d
g)

-- | Eliminates 'Err' via 'error'.
errorErr :: (HasCallStack) => ResultDefault a -> a
errorErr :: forall a. HasCallStack => ResultDefault a -> a
errorErr = (String -> a) -> Result String a -> a
forall e a. (e -> a) -> Result e a -> a
onErr String -> a
forall a. HasCallStack => String -> a
error

-- | Eliminates 'Err' via 'MonadFail'.
failErr :: (MonadFail m) => ResultDefault a -> m a
failErr :: forall (m :: Type -> Type) a. MonadFail m => ResultDefault a -> m a
failErr = (String -> m a) -> (a -> m a) -> Result String a -> m a
forall e b a. (e -> b) -> (a -> b) -> Result e a -> b
onResult String -> m a
forall a. String -> m a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail a -> m a
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure

-- | Eliminates 'Err' via 'MonadThrow'.
throwErr ::
  ( Exception e,
    HasCallStack,
    MonadThrow m
  ) =>
  Result e a -> m a
throwErr :: forall e (m :: Type -> Type) a.
(Exception e, HasCallStack, MonadThrow m) =>
Result e a -> m a
throwErr = (e -> m a) -> (a -> m a) -> Result e a -> m a
forall e b a. (e -> b) -> (a -> b) -> Result e a -> b
onResult e -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: Type -> Type) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM a -> m a
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure

-- | General eliminator.
onResult :: (e -> b) -> (a -> b) -> Result e a -> b
onResult :: forall e b a. (e -> b) -> (a -> b) -> Result e a -> b
onResult e -> b
f a -> b
_ (Err e
err) = e -> b
f e
err
onResult e -> b
_ a -> b
g (Ok a
x) = a -> b
g a
x

-- | 'Err' eliminator.
onErr :: (e -> a) -> Result e a -> a
onErr :: forall e a. (e -> a) -> Result e a -> a
onErr e -> a
f = (e -> a) -> (a -> a) -> Result e a -> a
forall e b a. (e -> b) -> (a -> b) -> Result e a -> b
onResult e -> a
f a -> a
forall a. a -> a
id

-- | 'Ok' eliminator.
onOk :: (a -> e) -> Result e a -> e
onOk :: forall a e. (a -> e) -> Result e a -> e
onOk = (e -> e) -> (a -> e) -> Result e a -> e
forall e b a. (e -> b) -> (a -> b) -> Result e a -> b
onResult e -> e
forall a. a -> a
id