{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

The 'Trial' Data Structure is a 'Either'-like structure that keeps
events history inside. The data type allows to keep track of the
'Fatality' level of each such event entry ('Warning' or 'Error').

'Trial' has two constructors:

* 'Fiasco': stores the list of events with the explicit 'Fatality'
  level; at least one event has level 'Error'
* 'Result': stores the final result and the list of events where each
  event has implicit 'Fatality' level 'Warning'

@trial@ implements the composable interface for creating and combining
values of type 'Trial', so the history of all events is stored
inside. Fundamental algebraic instances provide the following main
features:

* 'Semigroup': take the last 'Result' and combine all events.
* 'Applicative': return 'Fiasco', if at least one value if 'Fiasco',
  combine all events.
* 'Alternative': return first 'Result', also combine all events for
  all 'Trial's before this 'Result'.
-}

module Trial
       ( -- * Data structures
         Trial (..)
       , TaggedTrial
         -- ** 'Fatality'
       , Fatality
       , pattern Warning
       , pattern Error


         -- * Smart constructors
       , fiasco
       , fiascos
       , result
         -- * Combinators
       , alt
       , isFiasco
       , isResult
       , whenResult
       , whenResult_
       , whenFiasco
       , whenFiasco_

         -- * Work with Lists
         -- $patternList
       , pattern FiascoL
       , pattern ResultL
       , getTrialInfo
       , fiascoErrors
       , fiascoWarnings
       , resultWarnings
       , anyWarnings
       , dlistToList


         -- * 'Maybe' combinators
       , maybeToTrial
       , trialToMaybe
         -- * 'Either' combinators
       , eitherToTrial
       , trialToEither

         -- * Tag
       , withTag
       , unTag
       , fiascoOnEmpty

         -- * Pretty printing
       , prettyFatality
       , prettyTrial
       , prettyTrialWith
       , prettyTaggedTrial
       , prettyTaggedTrialWith

         -- * Configuration helpers
         -- $phase
       , Phase (..)
       , (:-)
       , (::-)
       ) where

import Control.Applicative (Alternative (..), Applicative (..))
import Data.Bifoldable (Bifoldable (..))
import Data.Bifunctor (Bifunctor (..))
import Data.Bitraversable (Bitraversable (..))
import Data.DList (DList)
import Data.Foldable (foldl')
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Proxy (Proxy (..))
import Data.Semigroup (Semigroup (..))
import Data.String (IsString (..))
import GHC.OverloadedLabels (IsLabel (..))
import GHC.Records (HasField (..))
import GHC.TypeLits (KnownSymbol, symbolVal)

import qualified Colourista as C
import qualified Colourista.Short as C
import qualified Data.DList as DL
import qualified Data.List.NonEmpty as NE


{- | Severity of the event in history.

* 'Error': fatal error that led to the final 'Fiasco'
* 'Warning': non-essential error, which didn't affect the result

You can't create values of type 'Fatality', you can only pattern-match
on them. 'Trial' smart constructors and instances take care of
assigning proper 'Fatality' values.

Use 'Warning' and 'Error' Pattern Synonyms to pattern match on
'Fatality':

>>> :{
showFatality :: Fatality -> String
showFatality Warning = "Warning"
showFatality Error   = "Error"
:}

@since 0.0.0.0
-}
data Fatality
    = W
    | E
    deriving stock (Int -> Fatality -> ShowS
[Fatality] -> ShowS
Fatality -> String
(Int -> Fatality -> ShowS)
-> (Fatality -> String) -> ([Fatality] -> ShowS) -> Show Fatality
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fatality] -> ShowS
$cshowList :: [Fatality] -> ShowS
show :: Fatality -> String
$cshow :: Fatality -> String
showsPrec :: Int -> Fatality -> ShowS
$cshowsPrec :: Int -> Fatality -> ShowS
Show, Fatality -> Fatality -> Bool
(Fatality -> Fatality -> Bool)
-> (Fatality -> Fatality -> Bool) -> Eq Fatality
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fatality -> Fatality -> Bool
$c/= :: Fatality -> Fatality -> Bool
== :: Fatality -> Fatality -> Bool
$c== :: Fatality -> Fatality -> Bool
Eq, Int -> Fatality
Fatality -> Int
Fatality -> [Fatality]
Fatality -> Fatality
Fatality -> Fatality -> [Fatality]
Fatality -> Fatality -> Fatality -> [Fatality]
(Fatality -> Fatality)
-> (Fatality -> Fatality)
-> (Int -> Fatality)
-> (Fatality -> Int)
-> (Fatality -> [Fatality])
-> (Fatality -> Fatality -> [Fatality])
-> (Fatality -> Fatality -> [Fatality])
-> (Fatality -> Fatality -> Fatality -> [Fatality])
-> Enum Fatality
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Fatality -> Fatality -> Fatality -> [Fatality]
$cenumFromThenTo :: Fatality -> Fatality -> Fatality -> [Fatality]
enumFromTo :: Fatality -> Fatality -> [Fatality]
$cenumFromTo :: Fatality -> Fatality -> [Fatality]
enumFromThen :: Fatality -> Fatality -> [Fatality]
$cenumFromThen :: Fatality -> Fatality -> [Fatality]
enumFrom :: Fatality -> [Fatality]
$cenumFrom :: Fatality -> [Fatality]
fromEnum :: Fatality -> Int
$cfromEnum :: Fatality -> Int
toEnum :: Int -> Fatality
$ctoEnum :: Int -> Fatality
pred :: Fatality -> Fatality
$cpred :: Fatality -> Fatality
succ :: Fatality -> Fatality
$csucc :: Fatality -> Fatality
Enum, Fatality
Fatality -> Fatality -> Bounded Fatality
forall a. a -> a -> Bounded a
maxBound :: Fatality
$cmaxBound :: Fatality
minBound :: Fatality
$cminBound :: Fatality
Bounded)

{- | 'Warning' pattern synonym.

@since 0.0.0.0
-}
pattern Warning :: Fatality
pattern $mWarning :: forall r. Fatality -> (Void# -> r) -> (Void# -> r) -> r
Warning <- W

{- | 'Error' pattern synonym.

@since 0.0.0.0
-}
pattern Error :: Fatality
pattern $mError :: forall r. Fatality -> (Void# -> r) -> (Void# -> r) -> r
Error <- E

{-# COMPLETE Warning, Error #-}

withW :: Functor f => f e -> f (Fatality, e)
withW :: f e -> f (Fatality, e)
withW = (e -> (Fatality, e)) -> f e -> f (Fatality, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Fatality
W,)
{-# INLINE withW #-}

{- | 'Trial' is a data type that stores history of all events happened
with a value. In addition, each event is associated with the
'Fatality' level that indicates whether the event is fatal or not.

API provided by @trial@ guarantees the following property:

* If the final value is 'Fiasco', it is either an empty list or a list
  with at least one event with the 'Fatality' level 'Error'.

@since 0.0.0.0
-}
data Trial e a
    -- | Stores list of events with the explicit 'Fatality' level.
    = Fiasco (DList (Fatality, e))
    -- | Store list of events and the final result.
    | Result (DList e) a
    deriving stock (Int -> Trial e a -> ShowS
[Trial e a] -> ShowS
Trial e a -> String
(Int -> Trial e a -> ShowS)
-> (Trial e a -> String)
-> ([Trial e a] -> ShowS)
-> Show (Trial e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Trial e a -> ShowS
forall e a. (Show e, Show a) => [Trial e a] -> ShowS
forall e a. (Show e, Show a) => Trial e a -> String
showList :: [Trial e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [Trial e a] -> ShowS
show :: Trial e a -> String
$cshow :: forall e a. (Show e, Show a) => Trial e a -> String
showsPrec :: Int -> Trial e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Trial e a -> ShowS
Show, Trial e a -> Trial e a -> Bool
(Trial e a -> Trial e a -> Bool)
-> (Trial e a -> Trial e a -> Bool) -> Eq (Trial e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => Trial e a -> Trial e a -> Bool
/= :: Trial e a -> Trial e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => Trial e a -> Trial e a -> Bool
== :: Trial e a -> Trial e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => Trial e a -> Trial e a -> Bool
Eq)

{- | In addition to usual 'Trial' capabilities, 'TaggedTrial' allows
attaching a @tag@ to the resulting value, so you can track which event
helped to obtain a value.

@since 0.0.0.0
-}
type TaggedTrial tag a = Trial tag (tag, a)

{- | Combine two 'Trial' values. Returns 'Result' if at least one
argument is 'Result'.

Let's create some default values:

>>> f1 = fiasco "Not initialised..."
>>> f2 = fiasco "Parsing error!"
>>> r1 = result "r1: From CLI" 5
>>> r2 = result "r2: Default" 42

And here is how combination of those values look like:

>>> f1 <> f2
Fiasco (fromList [(E,"Not initialised..."),(E,"Parsing error!")])
>>> f1 <> r1
Result (fromList ["Not initialised...","r1: From CLI"]) 5
>>> f2 <> r2
Result (fromList ["Parsing error!","r2: Default"]) 42
>>> r1 <> r2
Result (fromList ["r1: From CLI","r2: Default"]) 42
>>> f1 <> r1 <> f2 <> r2
Result (fromList ["Not initialised...","r1: From CLI","Parsing error!","r2: Default"]) 42

@since 0.0.0.0
-}
instance Semigroup (Trial e a) where
    (<>) :: Trial e a -> Trial e a -> Trial e a
    Fiasco e1 :: DList (Fatality, e)
e1   <> :: Trial e a -> Trial e a -> Trial e a
<> Fiasco e2 :: DList (Fatality, e)
e2   = DList (Fatality, e) -> Trial e a
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList (Fatality, e) -> Trial e a)
-> DList (Fatality, e) -> Trial e a
forall a b. (a -> b) -> a -> b
$ DList (Fatality, e)
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList (Fatality, e)
e2
    Fiasco e1 :: DList (Fatality, e)
e1   <> Result e2 :: DList e
e2 a :: a
a = DList e -> a -> Trial e a
forall e a. DList e -> a -> Trial e a
Result (((Fatality, e) -> e) -> DList (Fatality, e) -> DList e
forall a b. (a -> b) -> DList a -> DList b
DL.map (Fatality, e) -> e
forall a b. (a, b) -> b
snd DList (Fatality, e)
e1 DList e -> DList e -> DList e
forall a. Semigroup a => a -> a -> a
<> DList e
e2) a
a
    Result e1 :: DList e
e1 a :: a
a <> Fiasco e2 :: DList (Fatality, e)
e2   = DList e -> a -> Trial e a
forall e a. DList e -> a -> Trial e a
Result (DList e
e1 DList e -> DList e -> DList e
forall a. Semigroup a => a -> a -> a
<> ((Fatality, e) -> e) -> DList (Fatality, e) -> DList e
forall a b. (a -> b) -> DList a -> DList b
DL.map (Fatality, e) -> e
forall a b. (a, b) -> b
snd DList (Fatality, e)
e2) a
a
    Result e1 :: DList e
e1 _ <> Result e2 :: DList e
e2 b :: a
b = DList e -> a -> Trial e a
forall e a. DList e -> a -> Trial e a
Result (DList e
e1 DList e -> DList e -> DList e
forall a. Semigroup a => a -> a -> a
<> DList e
e2) a
b
    {-# INLINE (<>) #-}

    sconcat :: NonEmpty (Trial e a) -> Trial e a
    sconcat :: NonEmpty (Trial e a) -> Trial e a
sconcat (x :: Trial e a
x :| xs :: [Trial e a]
xs) = (Trial e a -> Trial e a -> Trial e a)
-> Trial e a -> [Trial e a] -> Trial e a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Trial e a -> Trial e a -> Trial e a
forall a. Semigroup a => a -> a -> a
(<>) Trial e a
x [Trial e a]
xs
    {-# INLINE sconcat #-}

-- | @since 0.0.0.0
instance Functor (Trial e) where
    fmap :: (a -> b) -> Trial e a -> Trial e b
    fmap :: (a -> b) -> Trial e a -> Trial e b
fmap _ (Fiasco e :: DList (Fatality, e)
e)   = DList (Fatality, e) -> Trial e b
forall e a. DList (Fatality, e) -> Trial e a
Fiasco DList (Fatality, e)
e
    fmap f :: a -> b
f (Result e :: DList e
e a :: a
a) = DList e -> b -> Trial e b
forall e a. DList e -> a -> Trial e a
Result DList e
e (b -> Trial e b) -> b -> Trial e b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
    {-# INLINE fmap #-}

    (<$) :: a -> Trial e b -> Trial e a
    _ <$ :: a -> Trial e b -> Trial e a
<$ Fiasco e :: DList (Fatality, e)
e   = DList (Fatality, e) -> Trial e a
forall e a. DList (Fatality, e) -> Trial e a
Fiasco DList (Fatality, e)
e
    a :: a
a <$ Result e :: DList e
e _ = DList e -> a -> Trial e a
forall e a. DList e -> a -> Trial e a
Result DList e
e a
a
    {-# INLINE (<$) #-}

{- | Combine two 'Trial's but recording all 'Result' events inside
'Fiasco' as 'Warning's.

>>> fiasco "No default" <*> fiasco "No config"
Fiasco (fromList [(E,"No default"),(E,"No config")])
>>> fiasco "No default" *> result "Option deprecated" 10
Fiasco (fromList [(E,"No default"),(W,"Option deprecated")])
>>> (,) <$> result "Redundant" 10 <*> result "No CLI Flag" True
Result (fromList ["Redundant","No CLI Flag"]) (10,True)
>>> result "Option deprecated" 10 *> pure 42
Result (fromList ["Option deprecated"]) 42

@since 0.0.0.0
-}
instance Applicative (Trial e) where
    pure :: a -> Trial e a
    pure :: a -> Trial e a
pure = DList e -> a -> Trial e a
forall e a. DList e -> a -> Trial e a
Result DList e
forall a. DList a
DL.empty
    {-# INLINE pure #-}

    (<*>) :: Trial e (a -> b) -> Trial e a -> Trial e b
    Fiasco e1 :: DList (Fatality, e)
e1 <*> :: Trial e (a -> b) -> Trial e a -> Trial e b
<*> trial :: Trial e a
trial = DList (Fatality, e) -> Trial e b
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList (Fatality, e) -> Trial e b)
-> DList (Fatality, e) -> Trial e b
forall a b. (a -> b) -> a -> b
$ case Trial e a
trial of
        Fiasco e2 :: DList (Fatality, e)
e2   -> DList (Fatality, e)
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList (Fatality, e)
e2
        Result e2 :: DList e
e2 _ -> DList (Fatality, e)
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList e -> DList (Fatality, e)
forall (f :: * -> *) e. Functor f => f e -> f (Fatality, e)
withW DList e
e2
    Result e1 :: DList e
e1 _ <*> Fiasco e2 :: DList (Fatality, e)
e2   = DList (Fatality, e) -> Trial e b
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList e -> DList (Fatality, e)
forall (f :: * -> *) e. Functor f => f e -> f (Fatality, e)
withW DList e
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList (Fatality, e)
e2)
    Result e1 :: DList e
e1 f :: a -> b
f <*> Result e2 :: DList e
e2 a :: a
a = DList e -> b -> Trial e b
forall e a. DList e -> a -> Trial e a
Result (DList e
e1 DList e -> DList e -> DList e
forall a. Semigroup a => a -> a -> a
<> DList e
e2) (a -> b
f a
a)
    {-# INLINE (<*>) #-}

    (*>) :: Trial e a -> Trial e b -> Trial e b
    Fiasco e1 :: DList (Fatality, e)
e1 *> :: Trial e a -> Trial e b -> Trial e b
*> trial :: Trial e b
trial = DList (Fatality, e) -> Trial e b
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList (Fatality, e) -> Trial e b)
-> DList (Fatality, e) -> Trial e b
forall a b. (a -> b) -> a -> b
$ case Trial e b
trial of
        Fiasco e2 :: DList (Fatality, e)
e2   -> DList (Fatality, e)
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList (Fatality, e)
e2
        Result e2 :: DList e
e2 _ -> DList (Fatality, e)
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList e -> DList (Fatality, e)
forall (f :: * -> *) e. Functor f => f e -> f (Fatality, e)
withW DList e
e2
    Result e1 :: DList e
e1 _ *> Fiasco e2 :: DList (Fatality, e)
e2   = DList (Fatality, e) -> Trial e b
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList e -> DList (Fatality, e)
forall (f :: * -> *) e. Functor f => f e -> f (Fatality, e)
withW DList e
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList (Fatality, e)
e2)
    Result e1 :: DList e
e1 _ *> Result e2 :: DList e
e2 b :: b
b = DList e -> b -> Trial e b
forall e a. DList e -> a -> Trial e a
Result (DList e
e1 DList e -> DList e -> DList e
forall a. Semigroup a => a -> a -> a
<> DList e
e2) b
b
    {-# INLINE (*>) #-}

    (<*) :: Trial e a -> Trial e b -> Trial e a
    Fiasco e1 :: DList (Fatality, e)
e1 <* :: Trial e a -> Trial e b -> Trial e a
<* trial :: Trial e b
trial = DList (Fatality, e) -> Trial e a
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList (Fatality, e) -> Trial e a)
-> DList (Fatality, e) -> Trial e a
forall a b. (a -> b) -> a -> b
$ case Trial e b
trial of
        Fiasco e2 :: DList (Fatality, e)
e2   -> DList (Fatality, e)
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList (Fatality, e)
e2
        Result e2 :: DList e
e2 _ -> DList (Fatality, e)
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList e -> DList (Fatality, e)
forall (f :: * -> *) e. Functor f => f e -> f (Fatality, e)
withW DList e
e2
    Result e1 :: DList e
e1 _ <* Fiasco e2 :: DList (Fatality, e)
e2   = DList (Fatality, e) -> Trial e a
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList e -> DList (Fatality, e)
forall (f :: * -> *) e. Functor f => f e -> f (Fatality, e)
withW DList e
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList (Fatality, e)
e2)
    Result e1 :: DList e
e1 a :: a
a <* Result e2 :: DList e
e2 _ = DList e -> a -> Trial e a
forall e a. DList e -> a -> Trial e a
Result (DList e
e1 DList e -> DList e -> DList e
forall a. Semigroup a => a -> a -> a
<> DList e
e2) a
a
    {-# INLINE (<*) #-}

    liftA2 :: (a -> b -> c) -> Trial e a -> Trial e b -> Trial e c
    liftA2 :: (a -> b -> c) -> Trial e a -> Trial e b -> Trial e c
liftA2 _ (Fiasco e1 :: DList (Fatality, e)
e1) trial :: Trial e b
trial = DList (Fatality, e) -> Trial e c
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList (Fatality, e) -> Trial e c)
-> DList (Fatality, e) -> Trial e c
forall a b. (a -> b) -> a -> b
$ case Trial e b
trial of
        Fiasco e2 :: DList (Fatality, e)
e2   -> DList (Fatality, e)
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList (Fatality, e)
e2
        Result e2 :: DList e
e2 _ -> DList (Fatality, e)
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList e -> DList (Fatality, e)
forall (f :: * -> *) e. Functor f => f e -> f (Fatality, e)
withW DList e
e2
    liftA2 _ (Result e1 :: DList e
e1 _) (Fiasco e2 :: DList (Fatality, e)
e2)   = DList (Fatality, e) -> Trial e c
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList e -> DList (Fatality, e)
forall (f :: * -> *) e. Functor f => f e -> f (Fatality, e)
withW DList e
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList (Fatality, e)
e2)
    liftA2 f :: a -> b -> c
f (Result e1 :: DList e
e1 a :: a
a) (Result e2 :: DList e
e2 b :: b
b) = DList e -> c -> Trial e c
forall e a. DList e -> a -> Trial e a
Result (DList e
e1 DList e -> DList e -> DList e
forall a. Semigroup a => a -> a -> a
<> DList e
e2) (a -> b -> c
f a
a b
b)
    {-# INLINE liftA2 #-}

{- | Return the first 'Result' with the whole history before
it. If both are 'Fiasco's, return 'Fiasco's with the histories
combined.

>>> fiasco "No info" <|> pure 42
Result (fromList ["No info"]) 42
>>> pure 42 <|> result "Something" 10
Result (fromList []) 42
>>> fiasco "No info" <|> fiasco "Some info"
Fiasco (fromList [(E,"No info"),(E,"Some info")])

See 'alt' if you want a different behaviour.

@since 0.0.0.0
-}
instance Alternative (Trial e) where
    empty :: Trial e a
    empty :: Trial e a
empty = DList (Fatality, e) -> Trial e a
forall e a. DList (Fatality, e) -> Trial e a
Fiasco DList (Fatality, e)
forall a. DList a
DL.empty
    {-# INLINE empty #-}

    (<|>) :: Trial e a -> Trial e a -> Trial e a
    r :: Trial e a
r@Result{} <|> :: Trial e a -> Trial e a -> Trial e a
<|> _ = Trial e a
r
    f :: Trial e a
f@Fiasco{} <|> r :: Trial e a
r = Trial e a
f Trial e a -> Trial e a -> Trial e a
forall a. Semigroup a => a -> a -> a
<> Trial e a
r
    {-# INLINE (<|>) #-}

{- | Alternative implementation of the 'Alternative' instance for
'Trial'. Return the first 'Result'. Otherwise, append two histories in
both 'Fiasco's. both 'Fiasco's.

>>> fiasco "No info" `alt` pure 42
Result (fromList []) 42
>>> pure 42 `alt` result "Something" 10
Result (fromList []) 42
>>> fiasco "No info" `alt` fiasco "Some info"
Fiasco (fromList [(E,"No info"),(E,"Some info")])

@since 0.0.0.0
-}
infixl 3 `alt`
alt :: Trial e a -> Trial e a -> Trial e a
alt :: Trial e a -> Trial e a -> Trial e a
alt r :: Trial e a
r@Result{} _            = Trial e a
r
alt _ r :: Trial e a
r@Result{}            = Trial e a
r
alt (Fiasco e1 :: DList (Fatality, e)
e1) (Fiasco e2 :: DList (Fatality, e)
e2) = DList (Fatality, e) -> Trial e a
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList (Fatality, e)
e1 DList (Fatality, e) -> DList (Fatality, e) -> DList (Fatality, e)
forall a. Semigroup a => a -> a -> a
<> DList (Fatality, e)
e2)

-- | @since 0.0.0.0
instance Bifunctor Trial where
    bimap :: (e1 -> e2) -> (a -> b) -> Trial e1 a -> Trial e2 b
    bimap :: (e1 -> e2) -> (a -> b) -> Trial e1 a -> Trial e2 b
bimap ef :: e1 -> e2
ef _ (Fiasco es :: DList (Fatality, e1)
es)   = DList (Fatality, e2) -> Trial e2 b
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (((Fatality, e1) -> (Fatality, e2))
-> DList (Fatality, e1) -> DList (Fatality, e2)
forall a b. (a -> b) -> DList a -> DList b
DL.map ((e1 -> e2) -> (Fatality, e1) -> (Fatality, e2)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second e1 -> e2
ef) DList (Fatality, e1)
es)
    bimap ef :: e1 -> e2
ef af :: a -> b
af (Result e :: DList e1
e a :: a
a) = DList e2 -> b -> Trial e2 b
forall e a. DList e -> a -> Trial e a
Result ((e1 -> e2) -> DList e1 -> DList e2
forall a b. (a -> b) -> DList a -> DList b
DL.map e1 -> e2
ef DList e1
e) (a -> b
af a
a)
    {-# INLINE bimap #-}

-- | @since 0.0.0.0
instance Bifoldable Trial where
    bifoldMap :: (Monoid m) => (e -> m) -> (a -> m) -> Trial e a -> m
    bifoldMap :: (e -> m) -> (a -> m) -> Trial e a -> m
bifoldMap ef :: e -> m
ef _ (Fiasco es :: DList (Fatality, e)
es)    = ((Fatality, e) -> m) -> DList (Fatality, e) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (e -> m
ef (e -> m) -> ((Fatality, e) -> e) -> (Fatality, e) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fatality, e) -> e
forall a b. (a, b) -> b
snd) DList (Fatality, e)
es
    bifoldMap ef :: e -> m
ef ea :: a -> m
ea (Result es :: DList e
es a :: a
a) = (e -> m) -> DList e -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap e -> m
ef DList e
es m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
ea a
a
    {-# INLINE bifoldMap #-}

-- | @since 0.0.0.0
instance Bitraversable Trial where
    bitraverse :: (Applicative f) => (e1 -> f e2) -> (a -> f b) -> Trial e1 a -> f (Trial e2 b)
    bitraverse :: (e1 -> f e2) -> (a -> f b) -> Trial e1 a -> f (Trial e2 b)
bitraverse ef :: e1 -> f e2
ef _ (Fiasco es :: DList (Fatality, e1)
es)    = DList (Fatality, e2) -> Trial e2 b
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList (Fatality, e2) -> Trial e2 b)
-> f (DList (Fatality, e2)) -> f (Trial e2 b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Fatality, e1) -> f (Fatality, e2))
-> DList (Fatality, e1) -> f (DList (Fatality, e2))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DList a -> f (DList b)
traverseDList ((e1 -> f e2) -> (Fatality, e1) -> f (Fatality, e2)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse e1 -> f e2
ef) DList (Fatality, e1)
es
    bitraverse ef :: e1 -> f e2
ef ea :: a -> f b
ea (Result es :: DList e1
es a :: a
a) = DList e2 -> b -> Trial e2 b
forall e a. DList e -> a -> Trial e a
Result (DList e2 -> b -> Trial e2 b)
-> f (DList e2) -> f (b -> Trial e2 b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (e1 -> f e2) -> DList e1 -> f (DList e2)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DList a -> f (DList b)
traverseDList e1 -> f e2
ef DList e1
es f (b -> Trial e2 b) -> f b -> f (Trial e2 b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
ea a
a
    {-# INLINE bitraverse #-}

{- 'DList' doesn't have a 'Traversable' instance -}
traverseDList :: (Applicative f) => (a -> f b) -> DList a -> f (DList b)
traverseDList :: (a -> f b) -> DList a -> f (DList b)
traverseDList f :: a -> f b
f = (a -> f (DList b) -> f (DList b))
-> f (DList b) -> DList a -> f (DList b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a :: a
a fDlistB :: f (DList b)
fDlistB -> (b -> DList b -> DList b) -> f b -> f (DList b) -> f (DList b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> DList b -> DList b
forall a. a -> DList a -> DList a
DL.cons (a -> f b
f a
a) f (DList b)
fDlistB) (DList b -> f (DList b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList b
forall a. DList a
DL.empty)
{-# INLINE traverseDList #-}

{- | Smart constructor for 'Trial'. Returns 'Fiasco' with a single
event and 'Error' 'Fatality'.

@since 0.0.0.0
-}
fiasco :: e -> Trial e a
fiasco :: e -> Trial e a
fiasco e :: e
e = DList (Fatality, e) -> Trial e a
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList (Fatality, e) -> Trial e a)
-> DList (Fatality, e) -> Trial e a
forall a b. (a -> b) -> a -> b
$ (Fatality, e) -> DList (Fatality, e)
forall a. a -> DList a
DL.singleton (Fatality
E, e
e)
{-# INLINE fiasco #-}

{- | Smart constructor for 'Trial'. Returns 'Fiasco' with a list of
events, where each has 'Fatality' 'Error'.

@since 0.0.0.0
-}
fiascos :: NonEmpty e -> Trial e a
fiascos :: NonEmpty e -> Trial e a
fiascos = DList (Fatality, e) -> Trial e a
forall e a. DList (Fatality, e) -> Trial e a
Fiasco (DList (Fatality, e) -> Trial e a)
-> (NonEmpty e -> DList (Fatality, e)) -> NonEmpty e -> Trial e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Fatality, e)] -> DList (Fatality, e)
forall a. [a] -> DList a
DL.fromList ([(Fatality, e)] -> DList (Fatality, e))
-> (NonEmpty e -> [(Fatality, e)])
-> NonEmpty e
-> DList (Fatality, e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> (Fatality, e)) -> [e] -> [(Fatality, e)]
forall a b. (a -> b) -> [a] -> [b]
map (Fatality
E,) ([e] -> [(Fatality, e)])
-> (NonEmpty e -> [e]) -> NonEmpty e -> [(Fatality, e)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty e -> [e]
forall a. NonEmpty a -> [a]
NE.toList
{-# INLINE fiascos #-}

{- | Smart constructor for 'Trial'. Returns 'Result' with a single
event of 'Warning' 'Fatality'.

__Hint:__ Use 'pure' to create a 'Result' with an empty list of events.

@since 0.0.0.0
-}
result :: e -> a -> Trial e a
result :: e -> a -> Trial e a
result e :: e
e = DList e -> a -> Trial e a
forall e a. DList e -> a -> Trial e a
Result (DList e -> a -> Trial e a) -> DList e -> a -> Trial e a
forall a b. (a -> b) -> a -> b
$ e -> DList e
forall a. a -> DList a
DL.singleton e
e
{-# INLINE result #-}

{- | Predicate on if the given 'Trial' is 'Fiasco'.

>>> isFiasco (fiasco 'e')
True
>>> isFiasco (result 'a' 42)
False

@since 0.0.0.0
-}
isFiasco :: Trial e a -> Bool
isFiasco :: Trial e a -> Bool
isFiasco (Fiasco _) = Bool
True
isFiasco _          = Bool
False

{- | Predicate on if the given 'Trial' is 'Result'.

>>> isResult (result 'a' 42)
True
>>> isResult (fiasco 'e')
False

@since 0.0.0.0
-}
isResult :: Trial e a -> Bool
isResult :: Trial e a -> Bool
isResult (Result _ _) = Bool
True
isResult _            = Bool
False

{- | Applies the given action to 'Trial' if it is 'Result' and returns the
value. In case of 'Fiasco' the default value is returned.

>>> whenResult "bar" (fiasco "foo") (\es a -> "success!" <$ (print a >> print es))
"bar"

>>> whenResult "bar" (result "res" 42) (\es a -> "success!" <$ (print a >> print es))
42
["res"]
"success!"

@since 0.0.0.0
-}
whenResult :: Applicative f => x -> Trial e a -> ([e] -> a -> f x) -> f x
whenResult :: x -> Trial e a -> ([e] -> a -> f x) -> f x
whenResult x :: x
x (FiascoL _) _    = x -> f x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x
whenResult _ (ResultL es :: [e]
es a :: a
a) f :: [e] -> a -> f x
f = [e] -> a -> f x
f [e]
es a
a
{-# INLINE whenResult #-}

{- | Applies given action to the 'Trial' content if it is 'Result'.

Similar to 'whenResult' but the default value is @()@.

>>> whenResult_ (fiasco "foo") (\es a -> print a >> print es)
>>> whenResult_ (result "res" 42)  (\es a -> print a >> print es)
42
["res"]

@since 0.0.0.0
-}
whenResult_ :: Applicative f => Trial e a -> ([e] -> a -> f ()) -> f ()
whenResult_ :: Trial e a -> ([e] -> a -> f ()) -> f ()
whenResult_ = () -> Trial e a -> ([e] -> a -> f ()) -> f ()
forall (f :: * -> *) x e a.
Applicative f =>
x -> Trial e a -> ([e] -> a -> f x) -> f x
whenResult ()
{-# INLINE whenResult_ #-}

{- | Applies the given action to 'Trial' if it is 'Fiasco' and returns the
result. In case of 'Result' the default value is returned.

>>> whenFiasco "bar" (fiasco 42) (\es -> "foo" <$ print es)
[(E,42)]
"foo"

>>> whenFiasco "bar" (result "res" 42) (\es -> "foo" <$ print es)
"bar"

@since 0.0.0.0
-}
whenFiasco :: Applicative f => x -> Trial e a -> ([(Fatality, e)] -> f x) -> f x
whenFiasco :: x -> Trial e a -> ([(Fatality, e)] -> f x) -> f x
whenFiasco _ (FiascoL e :: [(Fatality, e)]
e) f :: [(Fatality, e)] -> f x
f   = [(Fatality, e)] -> f x
f [(Fatality, e)]
e
whenFiasco a :: x
a (ResultL _ _) _ = x -> f x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
a
{-# INLINE whenFiasco #-}

{- | Applies given action to the 'Trial' content if it is 'Fiasco'.

Similar to 'whenFiasco' but the default value is @()@.

>>> whenFiasco_ (result "res" 42) print
>>> whenFiasco_ (fiasco "foo") print
[(E,"foo")]

@since 0.0.0.0
-}
whenFiasco_ :: Applicative f => Trial e a -> ([(Fatality, e)] -> f ()) -> f ()
whenFiasco_ :: Trial e a -> ([(Fatality, e)] -> f ()) -> f ()
whenFiasco_ = () -> Trial e a -> ([(Fatality, e)] -> f ()) -> f ()
forall (f :: * -> *) x e a.
Applicative f =>
x -> Trial e a -> ([(Fatality, e)] -> f x) -> f x
whenFiasco ()
{-# INLINE whenFiasco_ #-}

{- | Convert 'Maybe' to 'Trial' but assigning 'Error' 'Fatality' when
the value is 'Nothing'.

>>> maybeToTrial "No default" (Just 10)
Result (fromList []) 10
>>> maybeToTrial "No default" Nothing
Fiasco (fromList [(E,"No default")])

Functions 'maybeToTrial' and 'trialToMaybe' satisfy property:

@
'trialToMaybe' . 'maybeToTrial' e ≡ 'id'
@

@since 0.0.0.0
-}
maybeToTrial :: e -> Maybe a -> Trial e a
maybeToTrial :: e -> Maybe a -> Trial e a
maybeToTrial e :: e
e = \case
    Just a :: a
a  -> a -> Trial e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Nothing -> e -> Trial e a
forall e a. e -> Trial e a
fiasco e
e

{- | 'Convert 'Trial' to 'Maybe' by losing all history information.

>>> trialToMaybe $ fiasco "Some info"
Nothing
>>> trialToMaybe $ result "From CLI" 3
Just 3

@since 0.0.0.0
-}
trialToMaybe :: Trial e a -> Maybe a
trialToMaybe :: Trial e a -> Maybe a
trialToMaybe (Result _ a :: a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
trialToMaybe (Fiasco _)   = Maybe a
forall a. Maybe a
Nothing

{- | Convert 'Either' to 'Trial' by assigning 'Fatality' 'Warning' to
a 'Left' value.

>>> eitherToTrial (Right 42)
Result (fromList []) 42
>>> eitherToTrial (Left "Missing value")
Fiasco (fromList [(E,"Missing value")])

Functions 'eitherToTrial' and 'trialToEither' satisfy property:

@
'trialToEither' . 'eitherToTrial' ≡ 'id'
@

@since 0.0.0.0
-}
eitherToTrial :: Either e a -> Trial e a
eitherToTrial :: Either e a -> Trial e a
eitherToTrial (Right a :: a
a) = a -> Trial e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
eitherToTrial (Left e :: e
e)  = e -> Trial e a
forall e a. e -> Trial e a
fiasco e
e

{- | Convert 'Trial' to 'Either' by concatenating all history events.

>>> trialToEither (result "No info" 42)
Right 42
>>> trialToEither $ fiascos $ "Hello, " :| ["there"]
Left "Hello, there"

@since 0.0.0.0
-}
trialToEither :: Monoid e => Trial e a -> Either e a
trialToEither :: Trial e a -> Either e a
trialToEither (Result _ a :: a
a) = a -> Either e a
forall a b. b -> Either a b
Right a
a
trialToEither (Fiasco es :: DList (Fatality, e)
es)  = e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a) -> e -> Either e a
forall a b. (a -> b) -> a -> b
$ (e -> e -> e) -> e -> DList e -> e
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' e -> e -> e
forall a. Semigroup a => a -> a -> a
(<>) e
forall a. Monoid a => a
mempty (DList e -> e) -> DList e -> e
forall a b. (a -> b) -> a -> b
$ ((Fatality, e) -> e) -> DList (Fatality, e) -> DList e
forall a b. (a -> b) -> DList a -> DList b
DL.map (Fatality, e) -> e
forall a b. (a, b) -> b
snd DList (Fatality, e)
es

{- | Tag a 'Trial'.

>>> withTag "Answer" $ pure 42
Result (fromList []) ("Answer",42)
>>> withTag "Answer" $ fiasco "No answer"
Fiasco (fromList [(E,"No answer")])

@since 0.0.0.0
-}
withTag :: tag -> Trial tag a -> TaggedTrial tag a
withTag :: tag -> Trial tag a -> TaggedTrial tag a
withTag tag :: tag
tag = (a -> (tag, a)) -> Trial tag a -> TaggedTrial tag a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (tag
tag,)

{- | Untag a 'Trial' by adding a @tag@ to a history of events.

>>> unTag $ pure ("Chosen randomly",5)
Result (fromList ["Chosen randomly"]) 5
>>> unTag $ fiasco "No random"
Fiasco (fromList [(E,"No random")])

@since 0.0.0.0
-}
unTag :: TaggedTrial tag a -> Trial tag a
unTag :: TaggedTrial tag a -> Trial tag a
unTag (Fiasco e :: DList (Fatality, tag)
e)          = DList (Fatality, tag) -> Trial tag a
forall e a. DList (Fatality, e) -> Trial e a
Fiasco DList (Fatality, tag)
e
unTag (Result e :: DList tag
e (tag :: tag
tag, a :: a
a)) = DList tag -> a -> Trial tag a
forall e a. DList e -> a -> Trial e a
Result (DList tag -> tag -> DList tag
forall a. DList a -> a -> DList a
DL.snoc DList tag
e tag
tag) a
a

{- | Tag a value with a given tag, and add a message to events using
tag and a name if the given 'Foldable' is 'null'.

When used like this:

@
fiascoOnEmpty \"CLI\" "port" someList
@

it's equivalent to the following:

@
'withTag' \"CLI\" $ __case__ someList __of__
    [] -> 'fiasco' "No CLI option specified for: port"
    xs -> pure xs
@

@since 0.0.0.0
-}
fiascoOnEmpty
    :: (IsString tag, Semigroup tag, Foldable f)
    => tag  -- ^ Tag
    -> tag  -- ^ Field name
    -> f a  -- ^ Container of elements
    -> TaggedTrial tag (f a)
fiascoOnEmpty :: tag -> tag -> f a -> TaggedTrial tag (f a)
fiascoOnEmpty tag :: tag
tag name :: tag
name f :: f a
f
    | f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f a
f = tag -> TaggedTrial tag (f a)
forall e a. e -> Trial e a
fiasco (tag -> TaggedTrial tag (f a)) -> tag -> TaggedTrial tag (f a)
forall a b. (a -> b) -> a -> b
$ "No " tag -> tag -> tag
forall a. Semigroup a => a -> a -> a
<> tag
tag tag -> tag -> tag
forall a. Semigroup a => a -> a -> a
<> " option specified for: " tag -> tag -> tag
forall a. Semigroup a => a -> a -> a
<> tag
name
    | Bool
otherwise = tag -> Trial tag (f a) -> TaggedTrial tag (f a)
forall tag a. tag -> Trial tag a -> TaggedTrial tag a
withTag tag
tag (f a -> Trial tag (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
f)

-- TODO: add usage example of the IsLabel instance
{- | Convenient instance to convert record fields of type
'TaggedTrial' to 'Trial' by appending field names to the history. This
instance automatically combines tags and record field names into human
readable message, so the resulting history has more context.

@since 0.0.0.0
-}
instance
       ( HasField label r (Trial tag (tag, a))
       , IsString tag
       , Semigroup tag
       , KnownSymbol label
       )
    => IsLabel label (r -> Trial tag a)
  where
    fromLabel :: r -> Trial tag a
    fromLabel :: r -> Trial tag a
fromLabel r :: r
r = let fieldName :: tag
fieldName = String -> tag
forall a. IsString a => String -> a
fromString (String -> tag) -> String -> tag
forall a b. (a -> b) -> a -> b
$ Proxy label -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy label
forall k (t :: k). Proxy t
Proxy @label) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " is set through the source: " in
        case r -> Trial tag (tag, a)
forall k (x :: k) r a. HasField x r a => r -> a
getField @label r
r of
            Fiasco e :: DList (Fatality, tag)
e          -> DList (Fatality, tag) -> Trial tag a
forall e a. DList (Fatality, e) -> Trial e a
Fiasco DList (Fatality, tag)
e
            Result e :: DList tag
e (tag :: tag
tag, a :: a
a) -> DList tag -> a -> Trial tag a
forall e a. DList e -> a -> Trial e a
Result (DList tag -> tag -> DList tag
forall a. DList a -> a -> DList a
DL.snoc DList tag
e (tag -> DList tag) -> tag -> DList tag
forall a b. (a -> b) -> a -> b
$ tag
fieldName tag -> tag -> tag
forall a. Semigroup a => a -> a -> a
<> tag
tag) a
a
    {-# INLINE fromLabel #-}

{- $patternList

'Trial' stores list of events as 'DList' internally for efficient
appending. But when pattern-matching on the final value, it's more
convenient to work directly with lists. 'FiascoL' and 'ResultL' are
Pattern Synonyms for working with lists. It's recommended to use them
only once at the end, since conversion from 'DList' to list takes some
time.

>>> :{
foo :: Trial String Int -> String
foo (FiascoL []) = "Fiasco list is empty"
foo (ResultL [] _) = "Result list is empty"
foo _ = "Other case"
:}

>>> foo empty
"Fiasco list is empty"
>>> foo $ pure 42
"Result list is empty"
>>> foo $ result "Something" 42
"Other case"
-}

{- | Uni-directional Pattern Synonym for 'Fiasco' that allows
pattern-matching directly on lists.

@since 0.0.0.0
-}
pattern FiascoL :: [(Fatality, e)] -> Trial e a
pattern $mFiascoL :: forall r e a.
Trial e a -> ([(Fatality, e)] -> r) -> (Void# -> r) -> r
FiascoL e <- Fiasco (DL.toList -> e)

{- | Uni-directional Pattern Synonym for 'Result' that allows
pattern-matching directly on lists.

@since 0.0.0.0
-}
pattern ResultL :: [e] -> a -> Trial e a
pattern $mResultL :: forall r e a. Trial e a -> ([e] -> a -> r) -> (Void# -> r) -> r
ResultL e a <- Result (DL.toList -> e) a

{-# COMPLETE FiascoL, ResultL #-}
{-# COMPLETE Result,  FiascoL #-}
{-# COMPLETE ResultL, Fiasco  #-}

{- | Get the list of 'Warning's and 'Error's together with the 'Maybe'
'Result' if applicable.

>>> getTrialInfo $ result "Warning" 42
([(W,"Warning")],Just 42)
>>> getTrialInfo $ fiasco "Error"
([(E,"Error")],Nothing)

@since 0.0.0.0
-}
getTrialInfo :: Trial e a -> ([(Fatality, e)], Maybe a)
getTrialInfo :: Trial e a -> ([(Fatality, e)], Maybe a)
getTrialInfo = \case
    Fiasco e :: DList (Fatality, e)
e -> (DList (Fatality, e) -> [(Fatality, e)]
forall a. DList a -> [a]
DL.toList DList (Fatality, e)
e, Maybe a
forall a. Maybe a
Nothing)
    Result e :: DList e
e a :: a
a -> ((e -> (Fatality, e)) -> [e] -> [(Fatality, e)]
forall a b. (a -> b) -> [a] -> [b]
map (Fatality
W,) ([e] -> [(Fatality, e)]) -> [e] -> [(Fatality, e)]
forall a b. (a -> b) -> a -> b
$ DList e -> [e]
forall a. DList a -> [a]
DL.toList DList e
e, a -> Maybe a
forall a. a -> Maybe a
Just a
a)

{- | Returns all 'Error's in the 'Fiasco' constructor.
If the given 'Trial' is 'Result' then returns an empty list instead.

>>> fiascoErrors $ fiasco "One Error"
["One Error"]
>>> fiascoErrors $ result "Warning" 42
[]
>>> fiascoErrors (fiasco "Error" *> result "Warning" 42)
["Error"]

@since 0.0.0.0
-}
fiascoErrors :: Trial e a -> [e]
fiascoErrors :: Trial e a -> [e]
fiascoErrors = \case
    Result _ _ -> []
    Fiasco e :: DList (Fatality, e)
e -> ((Fatality, e) -> e) -> [(Fatality, e)] -> [e]
forall a b. (a -> b) -> [a] -> [b]
map (Fatality, e) -> e
forall a b. (a, b) -> b
snd ([(Fatality, e)] -> [e]) -> [(Fatality, e)] -> [e]
forall a b. (a -> b) -> a -> b
$ ((Fatality, e) -> Bool) -> [(Fatality, e)] -> [(Fatality, e)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Fatality -> Fatality -> Bool
forall a. Eq a => a -> a -> Bool
(==) Fatality
E (Fatality -> Bool)
-> ((Fatality, e) -> Fatality) -> (Fatality, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fatality, e) -> Fatality
forall a b. (a, b) -> a
fst) ([(Fatality, e)] -> [(Fatality, e)])
-> [(Fatality, e)] -> [(Fatality, e)]
forall a b. (a -> b) -> a -> b
$ DList (Fatality, e) -> [(Fatality, e)]
forall a. DList a -> [a]
DL.toList DList (Fatality, e)
e


{- | Returns all 'Warning's in the 'Fiasco' constructor.
If the given 'Trial' is 'Result' then returns an empty list instead.

>>> fiascoWarnings $ fiasco "One Error"
[]
>>> fiascoWarnings $ result "Warning" 42
[]
>>> fiascoWarnings (fiasco "Error" *> result "Warning" 42)
["Warning"]

@since 0.0.0.0
-}
fiascoWarnings :: Trial e a -> [e]
fiascoWarnings :: Trial e a -> [e]
fiascoWarnings = \case
    Result _ _ -> []
    Fiasco e :: DList (Fatality, e)
e -> ((Fatality, e) -> e) -> [(Fatality, e)] -> [e]
forall a b. (a -> b) -> [a] -> [b]
map (Fatality, e) -> e
forall a b. (a, b) -> b
snd ([(Fatality, e)] -> [e]) -> [(Fatality, e)] -> [e]
forall a b. (a -> b) -> a -> b
$ ((Fatality, e) -> Bool) -> [(Fatality, e)] -> [(Fatality, e)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Fatality -> Fatality -> Bool
forall a. Eq a => a -> a -> Bool
(==) Fatality
W (Fatality -> Bool)
-> ((Fatality, e) -> Fatality) -> (Fatality, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fatality, e) -> Fatality
forall a b. (a, b) -> a
fst) ([(Fatality, e)] -> [(Fatality, e)])
-> [(Fatality, e)] -> [(Fatality, e)]
forall a b. (a -> b) -> a -> b
$ DList (Fatality, e) -> [(Fatality, e)]
forall a. DList a -> [a]
DL.toList DList (Fatality, e)
e


{- | Returns all 'Warning's in the 'Result' constructor.
If the given 'Trial' is 'Fiasco' then returns an empty list instead.

>>> resultWarnings $ fiasco "One Error"
[]
>>> resultWarnings $ result "Warning" 42
["Warning"]
>>> resultWarnings (fiasco "Error" *> result "Warning" 42)
[]

@since 0.0.0.0
-}
resultWarnings :: Trial e a -> [e]
resultWarnings :: Trial e a -> [e]
resultWarnings = \case
    Result e :: DList e
e _ -> DList e -> [e]
forall a. DList a -> [a]
DL.toList DList e
e
    Fiasco _ -> []

{- | Returns all 'Warning's in the 'Trial'. These includes both warnings in
'Result' of in 'Fiasco'.

>>> anyWarnings $ fiasco "One Error"
[]
>>> anyWarnings $ result "Warning" 42
["Warning"]
>>> anyWarnings (fiasco "Error" *> result "Warning" 42)
["Warning"]

@since 0.0.0.0
-}
anyWarnings :: Trial e a -> [e]
anyWarnings :: Trial e a -> [e]
anyWarnings = \case
    Result e :: DList e
e _ -> DList e -> [e]
forall a. DList a -> [a]
DL.toList DList e
e
    Fiasco e :: DList (Fatality, e)
e -> ((Fatality, e) -> e) -> [(Fatality, e)] -> [e]
forall a b. (a -> b) -> [a] -> [b]
map (Fatality, e) -> e
forall a b. (a, b) -> b
snd ([(Fatality, e)] -> [e]) -> [(Fatality, e)] -> [e]
forall a b. (a -> b) -> a -> b
$ ((Fatality, e) -> Bool) -> [(Fatality, e)] -> [(Fatality, e)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Fatality -> Fatality -> Bool
forall a. Eq a => a -> a -> Bool
(==) Fatality
W (Fatality -> Bool)
-> ((Fatality, e) -> Fatality) -> (Fatality, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fatality, e) -> Fatality
forall a b. (a, b) -> a
fst) ([(Fatality, e)] -> [(Fatality, e)])
-> [(Fatality, e)] -> [(Fatality, e)]
forall a b. (a -> b) -> a -> b
$ DList (Fatality, e) -> [(Fatality, e)]
forall a. DList a -> [a]
DL.toList DList (Fatality, e)
e

{- | Helper function to convert 'DList' to list.

@since 0.0.0.0
-}
dlistToList :: DList a -> [a]
dlistToList :: DList a -> [a]
dlistToList = DList a -> [a]
forall a. DList a -> [a]
DL.toList
{-# INLINE dlistToList #-}

{- | Print aligned and colourful 'Fatality':

* 'Warning' in yellow
* 'Error' in red

See 'prettyTrial' for examples.

@since 0.0.0.0
-}
prettyFatality :: (Semigroup str, IsString str) => Fatality -> str
prettyFatality :: Fatality -> str
prettyFatality = \case
    E -> [str] -> str -> str
forall str. (IsString str, Semigroup str) => [str] -> str -> str
C.formatWith [str
forall str. IsString str => str
C.red]    "Error  "
    W -> [str] -> str -> str
forall str. (IsString str, Semigroup str) => [str] -> str -> str
C.formatWith [str
forall str. IsString str => str
C.yellow] "Warning"

prettyEntry :: (Semigroup e, IsString e) => (Fatality, e) -> e
prettyEntry :: (Fatality, e) -> e
prettyEntry (f :: Fatality
f, e :: e
e) = "  * [" e -> e -> e
forall a. Semigroup a => a -> a -> a
<> Fatality -> e
forall str. (Semigroup str, IsString str) => Fatality -> str
prettyFatality Fatality
f e -> e -> e
forall a. Semigroup a => a -> a -> a
<> "] " e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e e -> e -> e
forall a. Semigroup a => a -> a -> a
<> "\n"

{- | Colourful pretty-printing of 'Trial'.

![Fiasco](https://user-images.githubusercontent.com/8126674/82759167-830c9b80-9de3-11ea-8e72-c5f6c2cdcb6e.png)

![Result](https://user-images.githubusercontent.com/8126674/82759176-8b64d680-9de3-11ea-8426-e5de941ae9a4.png)

@since 0.0.0.0
-}
prettyTrial
    :: (Show a, Semigroup e, IsString e)
    => Trial e a
    -> e
prettyTrial :: Trial e a -> e
prettyTrial = (a -> String) -> Trial e a -> e
forall e a.
(Semigroup e, IsString e) =>
(a -> String) -> Trial e a -> e
prettyTrialWith a -> String
forall a. Show a => a -> String
show

{- | Similar to 'prettyTrial', but accepts a function to show Result in the
provided way.

@since 0.0.0.0
-}
prettyTrialWith
    :: (Semigroup e, IsString e)
    => (a -> String)
    -> Trial e a
    -> e
prettyTrialWith :: (a -> String) -> Trial e a -> e
prettyTrialWith showRes :: a -> String
showRes = \case
    Fiasco es :: DList (Fatality, e)
es -> [e] -> e -> e
forall str. (IsString str, Semigroup str) => [str] -> str -> str
C.formatWith [e
forall str. IsString str => str
C.red, e
forall str. IsString str => str
C.bold] "Fiasco:\n"
        e -> e -> e
forall a. Semigroup a => a -> a -> a
<> ((Fatality, e) -> e -> e) -> e -> DList (Fatality, e) -> e
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\e :: (Fatality, e)
e -> e -> e -> e
forall a. Semigroup a => a -> a -> a
(<>) ((Fatality, e) -> e
forall e. (Semigroup e, IsString e) => (Fatality, e) -> e
prettyEntry (Fatality, e)
e)) "" DList (Fatality, e)
es
    Result es :: DList e
es a :: a
a -> [e] -> e -> e
forall str. (IsString str, Semigroup str) => [str] -> str -> str
C.formatWith [e
forall str. IsString str => str
C.green, e
forall str. IsString str => str
C.bold] "Result:\n"
        e -> e -> e
forall a. Semigroup a => a -> a -> a
<> String -> e
forall a. IsString a => String -> a
fromString ([String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ a -> String
showRes a
a)
        e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e -> e
forall str. (IsString str, Semigroup str) => str -> str
C.i "\nWith the following warnings:\n"
        e -> e -> e
forall a. Semigroup a => a -> a -> a
<> (e -> e -> e) -> e -> DList e -> e
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\e :: e
e -> e -> e -> e
forall a. Semigroup a => a -> a -> a
(<>) ((Fatality, e) -> e
forall e. (Semigroup e, IsString e) => (Fatality, e) -> e
prettyEntry (Fatality
W, e
e))) "" DList e
es

{- | Colourful pretty-printing of 'TaggedTrial'. Similar to
'prettyTrial', but also prints the resulting @tag@ for 'Result'.

![Tag](https://user-images.githubusercontent.com/8126674/82759188-93bd1180-9de3-11ea-8a76-337d73cf6cc0.png)

@since 0.0.0.0
-}
prettyTaggedTrial
    :: (Show a, Semigroup e, IsString e)
    => TaggedTrial e a
    -> e
prettyTaggedTrial :: TaggedTrial e a -> e
prettyTaggedTrial = (a -> String) -> TaggedTrial e a -> e
forall e a.
(Semigroup e, IsString e) =>
(a -> String) -> TaggedTrial e a -> e
prettyTaggedTrialWith a -> String
forall a. Show a => a -> String
show

{- | Similar to 'prettyTaggedTrial', but accepts a function to show the 'Result'
in the provided way.

@since 0.0.0.0
--}
prettyTaggedTrialWith
    :: (Semigroup e, IsString e)
    => (a -> String)
    -> TaggedTrial e a
    -> e
prettyTaggedTrialWith :: (a -> String) -> TaggedTrial e a -> e
prettyTaggedTrialWith showRes :: a -> String
showRes = \case
    Fiasco es :: DList (Fatality, e)
es -> [e] -> e -> e
forall str. (IsString str, Semigroup str) => [str] -> str -> str
C.formatWith [e
forall str. IsString str => str
C.red, e
forall str. IsString str => str
C.bold] "Fiasco:\n"
        e -> e -> e
forall a. Semigroup a => a -> a -> a
<> ((Fatality, e) -> e -> e) -> e -> DList (Fatality, e) -> e
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\e :: (Fatality, e)
e -> e -> e -> e
forall a. Semigroup a => a -> a -> a
(<>) ((Fatality, e) -> e
forall e. (Semigroup e, IsString e) => (Fatality, e) -> e
prettyEntry (Fatality, e)
e)) "" DList (Fatality, e)
es
    Result es :: DList e
es (tag :: e
tag, a :: a
a) -> [e] -> e -> e
forall str. (IsString str, Semigroup str) => [str] -> str -> str
C.formatWith [e
forall str. IsString str => str
C.green, e
forall str. IsString str => str
C.bold] "Result:\n"
        e -> e -> e
forall a. Semigroup a => a -> a -> a
<> [e] -> e -> e
forall str. (IsString str, Semigroup str) => [str] -> str -> str
C.formatWith [e
forall str. IsString str => str
C.blue] ("  [" e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
tag e -> e -> e
forall a. Semigroup a => a -> a -> a
<> "]\n    ")
        e -> e -> e
forall a. Semigroup a => a -> a -> a
<> String -> e
forall a. IsString a => String -> a
fromString ([String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ a -> String
showRes a
a)
        e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e -> e
forall str. (IsString str, Semigroup str) => str -> str
C.i "\nWith the following warnings:\n"
        e -> e -> e
forall a. Semigroup a => a -> a -> a
<> (e -> e -> e) -> e -> DList e -> e
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\e :: e
e -> e -> e -> e
forall a. Semigroup a => a -> a -> a
(<>) ((Fatality, e) -> e
forall e. (Semigroup e, IsString e) => (Fatality, e) -> e
prettyEntry (Fatality
W, e
e))) "" DList e
es

----------------------------------------------------------------------------
-- Configurations
----------------------------------------------------------------------------

{- $phase
@trial@ introduced some additional data types and type families for adding __phase__ notion to your data types.

This approach is especially useful when you have a data type with many fields and the goal is to roll up the 'Trial' data type to the one with /pure/ fields.

In this case you can have two options:

1. Use two separate data types:

    @
    __data__ MyType = MyType
        { mtField1 :: 'Int'
        , ...

    __data__ PartialMyType = PartialMyType
        { pmtField1 :: 'Trial' 'String' 'Int'
        , ...

    finalise :: PartialMyType -> Maybe MyType
    @

2. Use 'Phase' notion together with ':-' type family:

    @
    __data__ MyType (p :: Phase String) = MyType
        { mtField1 :: p :- 'Int'
        , ...

    finalise :: MyType \'Partial -> Maybe (MyType \'Final)
    @

    And this will have the same effect

See the usage example in the @trial-example@ package:

* [trial-example-advanced](https://github.com/kowainik/trial/blob/master/trial-example/app-advanced/Main.hs)
-}

{- | The phase of the configurations.
This type is parametrised by the @e@ (error) type of the 'Trial' data type.
It is a phantom parameter.
So it could easily be used in the following way: @Phase Text@.

@since 0.0.0.0
-}
data Phase (e :: Type)
    = Partial
    | Final
    deriving stock (Int -> Phase e -> ShowS
[Phase e] -> ShowS
Phase e -> String
(Int -> Phase e -> ShowS)
-> (Phase e -> String) -> ([Phase e] -> ShowS) -> Show (Phase e)
forall e. Int -> Phase e -> ShowS
forall e. [Phase e] -> ShowS
forall e. Phase e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Phase e] -> ShowS
$cshowList :: forall e. [Phase e] -> ShowS
show :: Phase e -> String
$cshow :: forall e. Phase e -> String
showsPrec :: Int -> Phase e -> ShowS
$cshowsPrec :: forall e. Int -> Phase e -> ShowS
Show, Phase e -> Phase e -> Bool
(Phase e -> Phase e -> Bool)
-> (Phase e -> Phase e -> Bool) -> Eq (Phase e)
forall e. Phase e -> Phase e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Phase e -> Phase e -> Bool
$c/= :: forall e. Phase e -> Phase e -> Bool
== :: Phase e -> Phase e -> Bool
$c== :: forall e. Phase e -> Phase e -> Bool
Eq)

{- | Type family to map 'Phase' to the corresponding field for the 'Trial'
approach. This is a Higher-Kinded Data approach specialised to custom
enumeration.

@since 0.0.0.0
-}
infixl 3 :-
type family (phase :: Phase (e :: Type)) :- field where
    ('Partial :: Phase e) :- field = Trial e field
    'Final :- field = field

{- | Type family to map 'Phase' to the corresponding field for the 'TaggedTrial'
approach. This is a Higher-Kinded Data approach specialised to custom
enumeration.

@since 0.0.0.0
-}
infixl 3 ::-
type family (phase :: Phase (tag :: Type)) ::- field where
    ('Partial :: Phase tag) ::- field = TaggedTrial tag field
    'Final ::- field = field