{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Control.Applicative.MultiExcept
( MultiExcept
, fromEither
, fromEitherPoly
, join
, or
, runMultiExcept
, succeed
, throwError
, throwErrors
, mapMultiExcept
) where
import Prelude (Eq(..), Ord(..), Either(..), (.), ($), id, Show(..), (++), uncurry)
import Control.Applicative (Applicative(..))
#if MIN_VERSION_base(4,8,0)
import Data.Bifunctor
#endif
import Data.Functor (Functor(..), (<$>))
import Data.Foldable (Foldable(..))
import Data.Traversable (Traversable(..))
#if MIN_VERSION_base(4,9,0)
import Data.List.NonEmpty (NonEmpty(..))
#endif
data NonEmptyDList a = NonEmptyDList !a !([a] -> [a])
{-# INLINE nedlSingleton #-}
nedlSingleton :: a -> NonEmptyDList a
nedlSingleton :: forall a. a -> NonEmptyDList a
nedlSingleton a
a = a -> ([a] -> [a]) -> NonEmptyDList a
forall a. a -> ([a] -> [a]) -> NonEmptyDList a
NonEmptyDList a
a [a] -> [a]
forall a. a -> a
id
{-# INLINE runNonEmptyDList #-}
runNonEmptyDList :: NonEmptyDList a -> (a, [a])
runNonEmptyDList :: forall a. NonEmptyDList a -> (a, [a])
runNonEmptyDList (NonEmptyDList a
x [a] -> [a]
xs) = (a
x, [a] -> [a]
xs [])
instance Eq a => Eq (NonEmptyDList a) where
NonEmptyDList a
x [a] -> [a]
xs == :: NonEmptyDList a -> NonEmptyDList a -> Bool
== NonEmptyDList a
y [a] -> [a]
ys = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
xs [] [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
ys []
instance Ord a => Ord (NonEmptyDList a) where
NonEmptyDList a
x [a] -> [a]
xs compare :: NonEmptyDList a -> NonEmptyDList a -> Ordering
`compare` NonEmptyDList a
y [a] -> [a]
ys = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
xs []) [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
ys [])
instance Show a => Show (NonEmptyDList a) where
show :: NonEmptyDList a -> String
show NonEmptyDList a
nedl = case NonEmptyDList a -> (a, [a])
forall a. NonEmptyDList a -> (a, [a])
runNonEmptyDList NonEmptyDList a
nedl of
(a
x, [a]
xs) -> [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> [a] -> String
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
appendNedl :: NonEmptyDList a -> NonEmptyDList a -> NonEmptyDList a
appendNedl :: forall a. NonEmptyDList a -> NonEmptyDList a -> NonEmptyDList a
appendNedl (NonEmptyDList a
x [a] -> [a]
xs) (NonEmptyDList a
y [a] -> [a]
ys) = a -> ([a] -> [a]) -> NonEmptyDList a
forall a. a -> ([a] -> [a]) -> NonEmptyDList a
NonEmptyDList a
x (([a] -> [a]) -> NonEmptyDList a)
-> ([a] -> [a]) -> NonEmptyDList a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
xs ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
ys
instance Functor NonEmptyDList where
fmap :: forall a b. (a -> b) -> NonEmptyDList a -> NonEmptyDList b
fmap a -> b
f NonEmptyDList a
nedl = case NonEmptyDList a -> (a, [a])
forall a. NonEmptyDList a -> (a, [a])
runNonEmptyDList NonEmptyDList a
nedl of
(a
x, [a]
xs) -> b -> ([b] -> [b]) -> NonEmptyDList b
forall a. a -> ([a] -> [a]) -> NonEmptyDList a
NonEmptyDList (a -> b
f a
x) ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
xs [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++)
data MultiExcept err a
= Success !a
| Errors !(NonEmptyDList 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
$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
/= :: 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
$ccompare :: forall err a.
(Ord a, Ord err) =>
MultiExcept err a -> MultiExcept err a -> Ordering
compare :: MultiExcept err a -> MultiExcept err a -> Ordering
$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
>= :: MultiExcept err a -> MultiExcept err a -> Bool
$cmax :: 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
$cmin :: 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
Ord, 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
$cshowsPrec :: forall err a.
(Show a, Show err) =>
Int -> MultiExcept err a -> ShowS
showsPrec :: Int -> MultiExcept err a -> ShowS
$cshow :: forall err a. (Show a, Show err) => MultiExcept err a -> String
show :: MultiExcept err a -> String
$cshowList :: forall err a. (Show a, Show err) => [MultiExcept err a] -> ShowS
showList :: [MultiExcept err a] -> ShowS
Show)
#if MIN_VERSION_base(4,9,0)
runMultiExcept :: MultiExcept err a -> Either (NonEmpty err) a
runMultiExcept :: forall err a. MultiExcept err a -> Either (NonEmpty err) a
runMultiExcept (Errors NonEmptyDList 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
$ (err -> [err] -> NonEmpty err) -> (err, [err]) -> NonEmpty err
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry err -> [err] -> NonEmpty err
forall a. a -> [a] -> NonEmpty a
(:|) ((err, [err]) -> NonEmpty err) -> (err, [err]) -> NonEmpty err
forall a b. (a -> b) -> a -> b
$ NonEmptyDList err -> (err, [err])
forall a. NonEmptyDList a -> (a, [a])
runNonEmptyDList NonEmptyDList err
errs
runMultiExcept (Success a
a) = a -> Either (NonEmpty err) a
forall a b. b -> Either a b
Right a
a
#else
runMultiExcept :: MultiExcept err a -> Either (err, [err]) a
runMultiExcept (Errors errs) = Left $ runNonEmptyDList errs
runMultiExcept (Success a) = Right a
#endif
throwError :: forall a err. err -> MultiExcept err a
throwError :: forall a err. err -> MultiExcept err a
throwError = NonEmptyDList err -> MultiExcept err a
forall err a. NonEmptyDList err -> MultiExcept err a
Errors (NonEmptyDList err -> MultiExcept err a)
-> (err -> NonEmptyDList err) -> err -> MultiExcept err a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> NonEmptyDList err
forall a. a -> NonEmptyDList a
nedlSingleton
#if MIN_VERSION_base(4,9,0)
throwErrors :: forall a err. NonEmpty err -> MultiExcept err a
throwErrors :: forall a err. NonEmpty err -> MultiExcept err a
throwErrors (err
err :| [err]
errs) = NonEmptyDList err -> MultiExcept err a
forall err a. NonEmptyDList err -> MultiExcept err a
Errors (NonEmptyDList err -> MultiExcept err a)
-> NonEmptyDList err -> MultiExcept err a
forall a b. (a -> b) -> a -> b
$ err -> ([err] -> [err]) -> NonEmptyDList err
forall a. a -> ([a] -> [a]) -> NonEmptyDList a
NonEmptyDList err
err ([err]
errs [err] -> [err] -> [err]
forall a. [a] -> [a] -> [a]
++)
#else
throwErrors :: forall a err. (err, [err]) -> MultiExcept err a
throwErrors (err, errs) = Errors $ NonEmptyDList err (errs ++)
#endif
succeed :: forall err a. a -> MultiExcept err a
succeed :: forall err a. a -> MultiExcept err a
succeed = a -> MultiExcept err a
forall err a. a -> MultiExcept err a
Success
fromEither :: Either err a -> MultiExcept err a
fromEither :: forall err a. Either err a -> MultiExcept err a
fromEither (Left err
err) = err -> MultiExcept err a
forall a err. err -> MultiExcept err a
throwError err
err
fromEither (Right a
a) = a -> MultiExcept err a
forall err a. a -> MultiExcept err a
Success a
a
#if MIN_VERSION_base(4,9,0)
fromEitherPoly :: Either (NonEmpty err) a -> MultiExcept err a
fromEitherPoly :: forall err a. Either (NonEmpty err) a -> MultiExcept err a
fromEitherPoly (Left NonEmpty err
errs) = NonEmpty err -> MultiExcept err a
forall a err. NonEmpty err -> MultiExcept err a
throwErrors NonEmpty err
errs
fromEitherPoly (Right a
a) = a -> MultiExcept err a
forall err a. a -> MultiExcept err a
Success a
a
#else
fromEitherPoly :: Either (err, [err]) a -> MultiExcept err a
fromEitherPoly (Left errs) = throwErrors errs
fromEitherPoly (Right a) = Success a
#endif
join :: MultiExcept err (MultiExcept err a) -> MultiExcept err a
join :: forall err a.
MultiExcept err (MultiExcept err a) -> MultiExcept err a
join (Success MultiExcept err a
a) = MultiExcept err a
a
join (Errors NonEmptyDList err
a) = NonEmptyDList err -> MultiExcept err a
forall err a. NonEmptyDList err -> MultiExcept err a
Errors NonEmptyDList err
a
instance Functor (MultiExcept err) where
fmap :: forall a b. (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 NonEmptyDList err
errs) = NonEmptyDList err -> MultiExcept err b
forall err a. NonEmptyDList err -> MultiExcept err a
Errors NonEmptyDList err
errs
mapMultiExcept:: (err -> err') -> (a -> a') -> MultiExcept err a -> MultiExcept err' a'
mapMultiExcept :: forall err err' a a'.
(err -> err')
-> (a -> a') -> MultiExcept err a -> MultiExcept err' a'
mapMultiExcept err -> err'
_ a -> a'
fa (Success a
a) = a' -> MultiExcept err' a'
forall err a. a -> MultiExcept err a
Success (a' -> MultiExcept err' a') -> a' -> MultiExcept err' a'
forall a b. (a -> b) -> a -> b
$ a -> a'
fa a
a
mapMultiExcept err -> err'
ferr a -> a'
_ (Errors NonEmptyDList err
err) = NonEmptyDList err' -> MultiExcept err' a'
forall err a. NonEmptyDList err -> MultiExcept err a
Errors (NonEmptyDList err' -> MultiExcept err' a')
-> NonEmptyDList err' -> MultiExcept err' a'
forall a b. (a -> b) -> a -> b
$ (err -> err') -> NonEmptyDList err -> NonEmptyDList err'
forall a b. (a -> b) -> NonEmptyDList a -> NonEmptyDList b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap err -> err'
ferr NonEmptyDList err
err
#if MIN_VERSION_base(4,8,0)
instance Bifunctor MultiExcept where
bimap :: forall err err' a a'.
(err -> err')
-> (a -> a') -> MultiExcept err a -> MultiExcept err' a'
bimap = (a -> b) -> (c -> d) -> MultiExcept a c -> MultiExcept b d
forall err err' a a'.
(err -> err')
-> (a -> a') -> MultiExcept err a -> MultiExcept err' a'
mapMultiExcept
#endif
instance Applicative (MultiExcept err) where
pure :: forall a. a -> MultiExcept err a
pure = a -> MultiExcept err a
forall err a. a -> MultiExcept err a
Success
Errors NonEmptyDList err
l <*> :: forall a b.
MultiExcept err (a -> b) -> MultiExcept err a -> MultiExcept err b
<*> Errors NonEmptyDList err
l' = NonEmptyDList err -> MultiExcept err b
forall err a. NonEmptyDList err -> MultiExcept err a
Errors (NonEmptyDList err -> MultiExcept err b)
-> NonEmptyDList err -> MultiExcept err b
forall a b. (a -> b) -> a -> b
$ NonEmptyDList err -> NonEmptyDList err -> NonEmptyDList err
forall a. NonEmptyDList a -> NonEmptyDList a -> NonEmptyDList a
appendNedl NonEmptyDList err
l NonEmptyDList 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 NonEmptyDList err
l <*> MultiExcept err a
_ = NonEmptyDList err -> MultiExcept err b
forall err a. NonEmptyDList err -> MultiExcept err a
Errors NonEmptyDList err
l
MultiExcept err (a -> b)
_ <*> Errors NonEmptyDList err
l = NonEmptyDList err -> MultiExcept err b
forall err a. NonEmptyDList err -> MultiExcept err a
Errors NonEmptyDList err
l
or :: MultiExcept err a -> MultiExcept err a -> MultiExcept err a
Success a
a or :: forall err a.
MultiExcept err a -> MultiExcept err a -> MultiExcept err a
`or` MultiExcept err a
_ = a -> MultiExcept err a
forall err a. a -> MultiExcept err a
Success a
a
MultiExcept err a
_ `or` Success a
a = a -> MultiExcept err a
forall err a. a -> MultiExcept err a
Success a
a
Errors NonEmptyDList err
l `or` Errors NonEmptyDList err
r = NonEmptyDList err -> MultiExcept err a
forall err a. NonEmptyDList err -> MultiExcept err a
Errors (NonEmptyDList err -> MultiExcept err a)
-> NonEmptyDList err -> MultiExcept err a
forall a b. (a -> b) -> a -> b
$ NonEmptyDList err -> NonEmptyDList err -> NonEmptyDList err
forall a. NonEmptyDList a -> NonEmptyDList a -> NonEmptyDList a
appendNedl NonEmptyDList err
l NonEmptyDList err
r
instance Foldable (MultiExcept err) where
foldr :: forall a b. (a -> b -> b) -> b -> MultiExcept err a -> b
foldr a -> b -> b
f b
acc (Success a
a) = a -> b -> b
f a
a b
acc
foldr a -> b -> b
_ b
acc MultiExcept err a
_ = b
acc
instance Traversable (MultiExcept err) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MultiExcept err a -> f (MultiExcept err b)
traverse a -> f b
f (Success a
a) = b -> MultiExcept err b
forall err a. a -> MultiExcept err a
Success (b -> MultiExcept err b) -> f b -> f (MultiExcept err b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
traverse a -> f b
_ (Errors NonEmptyDList err
err) = MultiExcept err b -> f (MultiExcept err b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultiExcept err b -> f (MultiExcept err b))
-> MultiExcept err b -> f (MultiExcept err b)
forall a b. (a -> b) -> a -> b
$ NonEmptyDList err -> MultiExcept err b
forall err a. NonEmptyDList err -> MultiExcept err a
Errors NonEmptyDList err
err