{-|
Module      : Control.Applicative.MultiExcept
Copyright   : (c) Owen Shepherd, 2021
License     : MIT
Maintainer  : owen@owen.cafe
Stability   : stable
Portability : portable
-}

module Control.Applicative.MultiExcept
  ( MultiExcept
  , runMultiExcept
  , throwError
  , succeed
  ) where

import Data.List.NonEmpty (NonEmpty)
import Data.DList.DNonEmpty (DNonEmpty)
import qualified Data.DList.DNonEmpty as DNE

-- | A MultiExcept is a success value, or one or more errors
data MultiExcept err a
  = Success a
  | Errors (DNonEmpty err)
  deriving (MultiExcept err a -> MultiExcept err a -> Bool
(MultiExcept err a -> MultiExcept err a -> Bool)
-> (MultiExcept err a -> MultiExcept err a -> Bool)
-> Eq (MultiExcept err a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall err a.
(Eq a, Eq err) =>
MultiExcept err a -> MultiExcept err a -> Bool
/= :: MultiExcept err a -> MultiExcept err a -> Bool
$c/= :: forall err a.
(Eq a, Eq err) =>
MultiExcept err a -> MultiExcept err a -> Bool
== :: MultiExcept err a -> MultiExcept err a -> Bool
$c== :: forall err a.
(Eq a, Eq err) =>
MultiExcept err a -> MultiExcept err a -> Bool
Eq, Eq (MultiExcept err a)
Eq (MultiExcept err a)
-> (MultiExcept err a -> MultiExcept err a -> Ordering)
-> (MultiExcept err a -> MultiExcept err a -> Bool)
-> (MultiExcept err a -> MultiExcept err a -> Bool)
-> (MultiExcept err a -> MultiExcept err a -> Bool)
-> (MultiExcept err a -> MultiExcept err a -> Bool)
-> (MultiExcept err a -> MultiExcept err a -> MultiExcept err a)
-> (MultiExcept err a -> MultiExcept err a -> MultiExcept err a)
-> Ord (MultiExcept err a)
MultiExcept err a -> MultiExcept err a -> Bool
MultiExcept err a -> MultiExcept err a -> Ordering
MultiExcept err a -> MultiExcept err a -> MultiExcept err a
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 err a. (Ord a, Ord err) => Eq (MultiExcept err a)
forall err a.
(Ord a, Ord err) =>
MultiExcept err a -> MultiExcept err a -> Bool
forall err a.
(Ord a, Ord err) =>
MultiExcept err a -> MultiExcept err a -> Ordering
forall err a.
(Ord a, Ord err) =>
MultiExcept err a -> MultiExcept err a -> MultiExcept err a
min :: MultiExcept err a -> MultiExcept err a -> MultiExcept err a
$cmin :: forall err a.
(Ord a, Ord err) =>
MultiExcept err a -> MultiExcept err a -> MultiExcept err a
max :: MultiExcept err a -> MultiExcept err a -> MultiExcept err a
$cmax :: forall err a.
(Ord a, Ord err) =>
MultiExcept err a -> MultiExcept err a -> MultiExcept err a
>= :: MultiExcept err a -> MultiExcept err a -> Bool
$c>= :: forall err a.
(Ord a, Ord err) =>
MultiExcept err a -> MultiExcept err a -> Bool
> :: MultiExcept err a -> MultiExcept err a -> Bool
$c> :: forall err a.
(Ord a, Ord err) =>
MultiExcept err a -> MultiExcept err a -> Bool
<= :: MultiExcept err a -> MultiExcept err a -> Bool
$c<= :: forall err a.
(Ord a, Ord err) =>
MultiExcept err a -> MultiExcept err a -> Bool
< :: MultiExcept err a -> MultiExcept err a -> Bool
$c< :: forall err a.
(Ord a, Ord err) =>
MultiExcept err a -> MultiExcept err a -> Bool
compare :: MultiExcept err a -> MultiExcept err a -> Ordering
$ccompare :: forall err a.
(Ord a, Ord err) =>
MultiExcept err a -> MultiExcept err a -> Ordering
$cp1Ord :: forall err a. (Ord a, Ord err) => Eq (MultiExcept err a)
Ord, ReadPrec [MultiExcept err a]
ReadPrec (MultiExcept err a)
Int -> ReadS (MultiExcept err a)
ReadS [MultiExcept err a]
(Int -> ReadS (MultiExcept err a))
-> ReadS [MultiExcept err a]
-> ReadPrec (MultiExcept err a)
-> ReadPrec [MultiExcept err a]
-> Read (MultiExcept err a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall err a. (Read a, Read err) => ReadPrec [MultiExcept err a]
forall err a. (Read a, Read err) => ReadPrec (MultiExcept err a)
forall err a.
(Read a, Read err) =>
Int -> ReadS (MultiExcept err a)
forall err a. (Read a, Read err) => ReadS [MultiExcept err a]
readListPrec :: ReadPrec [MultiExcept err a]
$creadListPrec :: forall err a. (Read a, Read err) => ReadPrec [MultiExcept err a]
readPrec :: ReadPrec (MultiExcept err a)
$creadPrec :: forall err a. (Read a, Read err) => ReadPrec (MultiExcept err a)
readList :: ReadS [MultiExcept err a]
$creadList :: forall err a. (Read a, Read err) => ReadS [MultiExcept err a]
readsPrec :: Int -> ReadS (MultiExcept err a)
$creadsPrec :: forall err a.
(Read a, Read err) =>
Int -> ReadS (MultiExcept err a)
Read, Int -> MultiExcept err a -> ShowS
[MultiExcept err a] -> ShowS
MultiExcept err a -> String
(Int -> MultiExcept err a -> ShowS)
-> (MultiExcept err a -> String)
-> ([MultiExcept err a] -> ShowS)
-> Show (MultiExcept err a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall err a.
(Show a, Show err) =>
Int -> MultiExcept err a -> ShowS
forall err a. (Show a, Show err) => [MultiExcept err a] -> ShowS
forall err a. (Show a, Show err) => MultiExcept err a -> String
showList :: [MultiExcept err a] -> ShowS
$cshowList :: forall err a. (Show a, Show err) => [MultiExcept err a] -> ShowS
show :: MultiExcept err a -> String
$cshow :: forall err a. (Show a, Show err) => MultiExcept err a -> String
showsPrec :: Int -> MultiExcept err a -> ShowS
$cshowsPrec :: forall err a.
(Show a, Show err) =>
Int -> MultiExcept err a -> ShowS
Show)

-- | Run the computation
runMultiExcept :: MultiExcept err a -> Either (NonEmpty err) a
runMultiExcept :: MultiExcept err a -> Either (NonEmpty err) a
runMultiExcept (Errors DNonEmpty err
errs) = NonEmpty err -> Either (NonEmpty err) a
forall a b. a -> Either a b
Left (NonEmpty err -> Either (NonEmpty err) a)
-> NonEmpty err -> Either (NonEmpty err) a
forall a b. (a -> b) -> a -> b
$ DNonEmpty err -> NonEmpty err
forall a. DNonEmpty a -> NonEmpty a
DNE.toNonEmpty DNonEmpty err
errs
runMultiExcept (Success a
a) = a -> Either (NonEmpty err) a
forall a b. b -> Either a b
Right a
a

-- | Throw a single error
throwError :: err -> MultiExcept err a
throwError :: err -> MultiExcept err a
throwError = DNonEmpty err -> MultiExcept err a
forall err a. DNonEmpty err -> MultiExcept err a
Errors (DNonEmpty err -> MultiExcept err a)
-> (err -> DNonEmpty err) -> err -> MultiExcept err a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> DNonEmpty err
forall a. a -> DNonEmpty a
DNE.singleton

-- | Embeds a value into a MultiExcept context
succeed :: a -> MultiExcept err a
succeed :: a -> MultiExcept err a
succeed a
a = a -> MultiExcept err a
forall err a. a -> MultiExcept err a
Success a
a

instance Functor (MultiExcept err) where
  fmap :: (a -> b) -> MultiExcept err a -> MultiExcept err b
fmap a -> b
f (Success a
a) = b -> MultiExcept err b
forall err a. a -> MultiExcept err a
Success (b -> MultiExcept err b) -> b -> MultiExcept err b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
  fmap a -> b
_ (Errors DNonEmpty err
errs) = DNonEmpty err -> MultiExcept err b
forall err a. DNonEmpty err -> MultiExcept err a
Errors DNonEmpty err
errs

instance Applicative (MultiExcept err) where
  pure :: a -> MultiExcept err a
pure = a -> MultiExcept err a
forall a err. a -> MultiExcept err a
succeed

  Errors DNonEmpty err
l <*> :: MultiExcept err (a -> b) -> MultiExcept err a -> MultiExcept err b
<*> Errors DNonEmpty err
l' = DNonEmpty err -> MultiExcept err b
forall err a. DNonEmpty err -> MultiExcept err a
Errors (DNonEmpty err -> MultiExcept err b)
-> DNonEmpty err -> MultiExcept err b
forall a b. (a -> b) -> a -> b
$ DNonEmpty err -> DNonEmpty err -> DNonEmpty err
forall a. DNonEmpty a -> DNonEmpty a -> DNonEmpty a
DNE.append DNonEmpty err
l DNonEmpty err
l'
  Success a -> b
f <*> Success a
a = b -> MultiExcept err b
forall err a. a -> MultiExcept err a
Success (b -> MultiExcept err b) -> b -> MultiExcept err b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
  Errors DNonEmpty err
l <*> MultiExcept err a
_ = DNonEmpty err -> MultiExcept err b
forall err a. DNonEmpty err -> MultiExcept err a
Errors DNonEmpty err
l
  MultiExcept err (a -> b)
_ <*> Errors DNonEmpty err
l = DNonEmpty err -> MultiExcept err b
forall err a. DNonEmpty err -> MultiExcept err a
Errors DNonEmpty err
l