{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingStrategies #-}

{- |
Module      : Database.DuckDB.Simple.Ok
Description : Lightweight error accumulation for row parsing.

The 'Ok' type mirrors the helper used by @sqlite-simple@: it behaves like an
`Either [SomeException]` with sensible 'Alternative' semantics that accumulate
failure reasons instead of discarding them. This underpins the RowParser
machinery in 'Database.DuckDB.Simple.FromRow'.
-}
module Database.DuckDB.Simple.Ok (
    Ok (..),
    ManyErrors (..),
) where

import Control.Applicative (Alternative (..))
import Control.Exception (Exception, SomeException, toException)
import Control.Monad (MonadPlus (..))
import qualified Control.Monad.Fail as Fail

-- | Simple success-or-errors container with error accumulation.
data Ok a
    = Errors [SomeException]
    | Ok !a
    deriving stock (Int -> Ok a -> ShowS
[Ok a] -> ShowS
Ok a -> String
(Int -> Ok a -> ShowS)
-> (Ok a -> String) -> ([Ok a] -> ShowS) -> Show (Ok a)
forall a. Show a => Int -> Ok a -> ShowS
forall a. Show a => [Ok a] -> ShowS
forall a. Show a => Ok a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Ok a -> ShowS
showsPrec :: Int -> Ok a -> ShowS
$cshow :: forall a. Show a => Ok a -> String
show :: Ok a -> String
$cshowList :: forall a. Show a => [Ok a] -> ShowS
showList :: [Ok a] -> ShowS
Show)
    deriving stock ((forall a b. (a -> b) -> Ok a -> Ok b)
-> (forall a b. a -> Ok b -> Ok a) -> Functor Ok
forall a b. a -> Ok b -> Ok a
forall a b. (a -> b) -> Ok a -> Ok b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Ok a -> Ok b
fmap :: forall a b. (a -> b) -> Ok a -> Ok b
$c<$ :: forall a b. a -> Ok b -> Ok a
<$ :: forall a b. a -> Ok b -> Ok a
Functor)

-- | Two failures are considered equal regardless of their payload.
instance (Eq a) => Eq (Ok a) where
    Errors [SomeException]
_ == :: Ok a -> Ok a -> Bool
== Errors [SomeException]
_ = Bool
True
    Ok a
a == Ok a
b = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b
    Ok a
_ == Ok a
_ = Bool
False

instance Applicative Ok where
    pure :: forall a. a -> Ok a
pure = a -> Ok a
forall a. a -> Ok a
Ok
    Ok a -> b
f <*> :: forall a b. Ok (a -> b) -> Ok a -> Ok b
<*> Ok a
a = b -> Ok b
forall a. a -> Ok a
Ok (a -> b
f a
a)
    Errors [SomeException]
es <*> Ok a
_ = [SomeException] -> Ok b
forall a. [SomeException] -> Ok a
Errors [SomeException]
es
    Ok a -> b
_ <*> Errors [SomeException]
es = [SomeException] -> Ok b
forall a. [SomeException] -> Ok a
Errors [SomeException]
es
    Errors [SomeException]
es1 <*> Errors [SomeException]
es2 = [SomeException] -> Ok b
forall a. [SomeException] -> Ok a
Errors ([SomeException]
es1 [SomeException] -> [SomeException] -> [SomeException]
forall a. Semigroup a => a -> a -> a
<> [SomeException]
es2)

instance Alternative Ok where
    empty :: forall a. Ok a
empty = [SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors []
    Ok a
x <|> :: forall a. Ok a -> Ok a -> Ok a
<|> Ok a
_ = a -> Ok a
forall a. a -> Ok a
Ok a
x
    Errors [SomeException]
_ <|> Ok a
y = a -> Ok a
forall a. a -> Ok a
Ok a
y
    Errors [SomeException]
xs <|> Errors [SomeException]
ys = [SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors ([SomeException]
xs [SomeException] -> [SomeException] -> [SomeException]
forall a. Semigroup a => a -> a -> a
<> [SomeException]
ys)

instance Monad Ok where
    Ok a
a >>= :: forall a b. Ok a -> (a -> Ok b) -> Ok b
>>= a -> Ok b
f = a -> Ok b
f a
a
    Errors [SomeException]
es >>= a -> Ok b
_ = [SomeException] -> Ok b
forall a. [SomeException] -> Ok a
Errors [SomeException]
es

instance MonadPlus Ok where
    mzero :: forall a. Ok a
mzero = Ok a
forall a. Ok a
forall (f :: * -> *) a. Alternative f => f a
empty
    mplus :: forall a. Ok a -> Ok a -> Ok a
mplus = Ok a -> Ok a -> Ok a
forall a. Ok a -> Ok a -> Ok a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Fail.MonadFail Ok where
    fail :: forall a. String -> Ok a
fail String
msg = [SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors [IOError -> SomeException
forall e. Exception e => e -> SomeException
toException (String -> IOError
userError String
msg)]

-- | Bundle multiple underlying exceptions into a single throwable value.
newtype ManyErrors = ManyErrors [SomeException]
    deriving stock (Int -> ManyErrors -> ShowS
[ManyErrors] -> ShowS
ManyErrors -> String
(Int -> ManyErrors -> ShowS)
-> (ManyErrors -> String)
-> ([ManyErrors] -> ShowS)
-> Show ManyErrors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ManyErrors -> ShowS
showsPrec :: Int -> ManyErrors -> ShowS
$cshow :: ManyErrors -> String
show :: ManyErrors -> String
$cshowList :: [ManyErrors] -> ShowS
showList :: [ManyErrors] -> ShowS
Show)

instance Exception ManyErrors