{-|
Module      : Prosidy.Compile.Error
Description : Error definitions and utility functions.
Copyright   : ©2020 James Alexander Feldman-Crough
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
module Prosidy.Compile.Error
    ( Error(..)
    , TagKind(..)
    , MetadataKind(..)
    , ErrorSet
    , Error'
    , ErrorSet'
    , IsError
    , ApError(..)
    , ApErrors
    , singleError
    , customError
    , liftError1
    , allErrors
    , groupErrors
    )
where

import           Lens.Micro

import           Control.Exception              ( Exception(..) )
import           Prosidy.Types.Key              ( Key )
import           Prosidy.Source                 ( Line(..)
                                                , Column(..)
                                                , Location
                                                )
import           Prosidy.Optics.Source          ( HasLocation(..)
                                                , line
                                                , column
                                                )
import           Data.HashSet                   ( HashSet
                                                , singleton
                                                )
import           GHC.Generics                   ( Generic )
import           Data.Hashable                  ( Hashable )
import           Data.Typeable                  ( Typeable )
import           Data.Void                      ( Void )
import           Data.Foldable                  ( toList )
import           Data.List.NonEmpty             ( NonEmpty(..)
                                                , nonEmpty
                                                )

-- | Similar to 'Control.Monad.Except.MonadError', but without the 'Monad'
-- constraint, and without a method to handle errors, only a method to map over
-- them.
class Applicative f => ApError e f | f -> e where
    liftError :: e -> f a
    mapError  :: (e -> e) -> f a -> f a

-- | A synonym for 'ApError' when the underlying applicative is capable of
-- accumulating errors in an 'ErrorSet'.
type ApErrors e = ApError (ErrorSet e)

-- | A constraint alias for errors throwable in a context admitting a
-- 'ApErrors' instance.
type IsError e = (Exception e, Hashable e, Eq e)

-- | A non-empty set of errors.
newtype ErrorSet e =
    ErrorSet (HashSet (Error e))
  deriving stock (Int -> ErrorSet e -> ShowS
[ErrorSet e] -> ShowS
ErrorSet e -> String
(Int -> ErrorSet e -> ShowS)
-> (ErrorSet e -> String)
-> ([ErrorSet e] -> ShowS)
-> Show (ErrorSet e)
forall e. Show e => Int -> ErrorSet e -> ShowS
forall e. Show e => [ErrorSet e] -> ShowS
forall e. Show e => ErrorSet e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorSet e] -> ShowS
$cshowList :: forall e. Show e => [ErrorSet e] -> ShowS
show :: ErrorSet e -> String
$cshow :: forall e. Show e => ErrorSet e -> String
showsPrec :: Int -> ErrorSet e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> ErrorSet e -> ShowS
Show, (forall x. ErrorSet e -> Rep (ErrorSet e) x)
-> (forall x. Rep (ErrorSet e) x -> ErrorSet e)
-> Generic (ErrorSet e)
forall x. Rep (ErrorSet e) x -> ErrorSet e
forall x. ErrorSet e -> Rep (ErrorSet e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (ErrorSet e) x -> ErrorSet e
forall e x. ErrorSet e -> Rep (ErrorSet e) x
$cto :: forall e x. Rep (ErrorSet e) x -> ErrorSet e
$cfrom :: forall e x. ErrorSet e -> Rep (ErrorSet e) x
Generic, ErrorSet e -> ErrorSet e -> Bool
(ErrorSet e -> ErrorSet e -> Bool)
-> (ErrorSet e -> ErrorSet e -> Bool) -> Eq (ErrorSet e)
forall e. Eq e => ErrorSet e -> ErrorSet e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorSet e -> ErrorSet e -> Bool
$c/= :: forall e. Eq e => ErrorSet e -> ErrorSet e -> Bool
== :: ErrorSet e -> ErrorSet e -> Bool
$c== :: forall e. Eq e => ErrorSet e -> ErrorSet e -> Bool
Eq)
  deriving anyclass (Int -> ErrorSet e -> Int
ErrorSet e -> Int
(Int -> ErrorSet e -> Int)
-> (ErrorSet e -> Int) -> Hashable (ErrorSet e)
forall e. Hashable e => Int -> ErrorSet e -> Int
forall e. Hashable e => ErrorSet e -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ErrorSet e -> Int
$chash :: forall e. Hashable e => ErrorSet e -> Int
hashWithSalt :: Int -> ErrorSet e -> Int
$chashWithSalt :: forall e. Hashable e => Int -> ErrorSet e -> Int
Hashable)

instance Exception e => Exception (ErrorSet e) where
    displayException :: ErrorSet e -> String
displayException (ErrorSet errors :: HashSet (Error e)
errors) = [ShowS] -> ShowS
forall a. Monoid a => [a] -> a
mconcat
        [ String -> ShowS
showString "encountered " ShowS -> ShowS -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
forall a. Show a => a -> ShowS
shows (HashSet (Error e) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HashSet (Error e)
errors) ShowS -> ShowS -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ShowS
showString
            " error(s):\n"
        , String -> ShowS
showString "-----\n"
        , (Error e -> ShowS) -> HashSet (Error e) -> ShowS
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\x :: Error e
x -> String -> ShowS
showString (Error e -> String
forall e. Exception e => e -> String
displayException Error e
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '\n') HashSet (Error e)
errors
        ]
        ""

instance IsError e => Semigroup (ErrorSet e) where
    ErrorSet lhs :: HashSet (Error e)
lhs <> :: ErrorSet e -> ErrorSet e -> ErrorSet e
<> ErrorSet rhs :: HashSet (Error e)
rhs = HashSet (Error e) -> ErrorSet e
forall e. HashSet (Error e) -> ErrorSet e
ErrorSet (HashSet (Error e) -> ErrorSet e)
-> HashSet (Error e) -> ErrorSet e
forall a b. (a -> b) -> a -> b
$! HashSet (Error e)
lhs HashSet (Error e) -> HashSet (Error e) -> HashSet (Error e)
forall a. Semigroup a => a -> a -> a
<> HashSet (Error e)
rhs

-- | A type alias for 'ErrorSet's which never contain empty errors.
type ErrorSet' = ErrorSet Void

-- | Enumerates the errors thrown when
data Error a =
    Custom a
    -- ^ A custom error, allowing extensibility.
  | ParseError Key String
    -- ^ Thrown when parsing a setting fails.
  | Required Key
    -- ^ Thrown when a setting was required to be set, but wasn't provided.
  | ExpectedTag TagKind Key
    -- ^ Thrown when matching against a 'Prosidy.Tag', and another node was
    -- found, or the input tag's 'Key' didn't match the specified key.
  | ExpectedParagraph
    -- ^ Thrown when matching against paragraph and an unexpected node was
    -- encountered.
  | ExpectedText
    -- ^ Thrown when matching against text and an unexpected node was
    -- encountered.
  | ExpectedBreak
    -- ^ Thrown when matching against an explicit break and an unexpected node
    -- was encountered.
  | EmptyMatch
    -- ^ Thrown when a match has no cases to check against.
  | UnknownMetadata (HashSet (MetadataKind, Key))
    -- ^ Thrown when an unknown property or setting is encountered when
    -- checking that properties and settings conform to strictly known
    -- keys.
  | Group (Maybe Location) (ErrorSet a)
    -- ^ Used to group a set of errors thrown at the same point in a tree.
  deriving (Error a -> Error a -> Bool
(Error a -> Error a -> Bool)
-> (Error a -> Error a -> Bool) -> Eq (Error a)
forall a. Eq a => Error a -> Error a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error a -> Error a -> Bool
$c/= :: forall a. Eq a => Error a -> Error a -> Bool
== :: Error a -> Error a -> Bool
$c== :: forall a. Eq a => Error a -> Error a -> Bool
Eq, Int -> Error a -> ShowS
[Error a] -> ShowS
Error a -> String
(Int -> Error a -> ShowS)
-> (Error a -> String) -> ([Error a] -> ShowS) -> Show (Error a)
forall a. Show a => Int -> Error a -> ShowS
forall a. Show a => [Error a] -> ShowS
forall a. Show a => Error a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error a] -> ShowS
$cshowList :: forall a. Show a => [Error a] -> ShowS
show :: Error a -> String
$cshow :: forall a. Show a => Error a -> String
showsPrec :: Int -> Error a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Error a -> ShowS
Show, (forall x. Error a -> Rep (Error a) x)
-> (forall x. Rep (Error a) x -> Error a) -> Generic (Error a)
forall x. Rep (Error a) x -> Error a
forall x. Error a -> Rep (Error a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Error a) x -> Error a
forall a x. Error a -> Rep (Error a) x
$cto :: forall a x. Rep (Error a) x -> Error a
$cfrom :: forall a x. Error a -> Rep (Error a) x
Generic, Int -> Error a -> Int
Error a -> Int
(Int -> Error a -> Int) -> (Error a -> Int) -> Hashable (Error a)
forall a. Hashable a => Int -> Error a -> Int
forall a. Hashable a => Error a -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Error a -> Int
$chash :: forall a. Hashable a => Error a -> Int
hashWithSalt :: Int -> Error a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Error a -> Int
Hashable)

instance (Typeable a, Exception a) => Exception (Error a) where
    displayException :: Error a -> String
displayException (Custom a :: a
a        ) = a -> String
forall e. Exception e => e -> String
displayException a
a

    displayException (ParseError k :: Key
k msg :: String
msg) = [ShowS] -> ShowS
forall a. Monoid a => [a] -> a
mconcat
        [ String -> ShowS
showString "failed to parse the setting "
        , Key -> ShowS
forall a. Show a => a -> ShowS
shows Key
k
        , String -> ShowS
showString ": "
        , String -> ShowS
showString String
msg
        ]
        ""

    displayException EmptyMatch   = "Match provided with no possible cases."

    displayException (Required k :: Key
k) = "missing required setting " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Key -> String
forall a. Show a => a -> String
show Key
k

    displayException (ExpectedTag kind :: TagKind
kind k :: Key
k) =
        "expected a " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TagKind -> String
kindstr TagKind
kind String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " tag with key " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Key -> String
forall a. Show a => a -> String
show Key
k
      where
        kindstr :: TagKind -> String
kindstr BlockKind   = "block"
        kindstr InlineKind  = "inline"
        kindstr LiteralKind = "literal"

    displayException ExpectedParagraph = "expected a paragrapgh"

    displayException ExpectedText      = "expected plain text"

    displayException ExpectedBreak     = "expected a break"

    displayException (UnknownMetadata xs :: HashSet (MetadataKind, Key)
xs) =
        String -> ShowS
showString "One or more invalid metadata items were encountered:"
            ShowS -> ShowS -> ShowS
forall a. Semigroup a => a -> a -> a
<> ((MetadataKind, Key) -> ShowS)
-> HashSet (MetadataKind, Key) -> ShowS
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (MetadataKind, Key) -> ShowS
forall a. Show a => (MetadataKind, a) -> ShowS
showItem HashSet (MetadataKind, Key)
xs
            ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$  ""
      where
        showItem :: (MetadataKind, a) -> ShowS
showItem (PropertyKind, key :: a
key) =
            Char -> ShowS
showChar ' ' ShowS -> ShowS -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
key ShowS -> ShowS -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ShowS
showString " (property)"
        showItem (SettingKind, key :: a
key) =
            Char -> ShowS
showChar ' ' ShowS -> ShowS -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
key ShowS -> ShowS -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ShowS
showString " (setting)"

    displayException (Group (Just loc :: Location
loc) x :: ErrorSet a
x) = [ShowS] -> ShowS
forall a. Monoid a => [a] -> a
mconcat
        [ String -> ShowS
showString "error(s) encountered at line "
        , Word -> ShowS
forall a. Show a => a -> ShowS
shows (Location
loc Location -> Getting (Endo Word) Location Word -> Word
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Optic' (->) (Const (Endo Word)) Location Line
forall l (f :: * -> *).
(HasLocation l, Contravariant f, Applicative f) =>
Optic' (->) f l Line
line Optic' (->) (Const (Endo Word)) Location Line
-> ((Word -> Const (Endo Word) Word)
    -> Line -> Const (Endo Word) Line)
-> Getting (Endo Word) Location Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line -> Word) -> SimpleGetter Line Word
forall s a. (s -> a) -> SimpleGetter s a
to (\(Line n :: Word
n) -> Word -> Word
forall a. Enum a => a -> a
succ Word
n))
        , String -> ShowS
showString " column "
        , Word -> ShowS
forall a. Show a => a -> ShowS
shows (Location
loc Location -> Getting (Endo Word) Location Word -> Word
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Optic' (->) (Const (Endo Word)) Location Column
forall l (f :: * -> *).
(HasLocation l, Contravariant f, Applicative f) =>
Optic' (->) f l Column
column Optic' (->) (Const (Endo Word)) Location Column
-> ((Word -> Const (Endo Word) Word)
    -> Column -> Const (Endo Word) Column)
-> Getting (Endo Word) Location Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column -> Word) -> SimpleGetter Column Word
forall s a. (s -> a) -> SimpleGetter s a
to (\(Column n :: Word
n) -> Word -> Word
forall a. Enum a => a -> a
succ Word
n))
        , String -> ShowS
showString ":\n"
        , (Error a -> ShowS) -> NonEmpty (Error a) -> ShowS
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
            (\exn :: Error a
exn -> String -> ShowS
showString (Error a -> String
forall e. Exception e => e -> String
displayException Error a
exn) ShowS -> ShowS -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> ShowS
showChar '\n')
            (ErrorSet a -> NonEmpty (Error a)
forall e. ErrorSet e -> NonEmpty (Error e)
allErrors ErrorSet a
x)
        ]
        ""

    displayException (Group Nothing x :: ErrorSet a
x) = (Error a -> ShowS) -> NonEmpty (Error a) -> ShowS
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        (\exn :: Error a
exn -> String -> ShowS
showString (Error a -> String
forall e. Exception e => e -> String
displayException Error a
exn) ShowS -> ShowS -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> ShowS
showChar '\n')
        (ErrorSet a -> NonEmpty (Error a)
forall e. ErrorSet e -> NonEmpty (Error e)
allErrors ErrorSet a
x)
        ""

-- | A type alias for 'Error's that never throw a custom error.
type Error' = Error Void

-- | A marker class for marking which type of tag 'ExpectedTag' was expecting.
data TagKind = BlockKind | InlineKind | LiteralKind
  deriving (Int -> TagKind -> ShowS
[TagKind] -> ShowS
TagKind -> String
(Int -> TagKind -> ShowS)
-> (TagKind -> String) -> ([TagKind] -> ShowS) -> Show TagKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagKind] -> ShowS
$cshowList :: [TagKind] -> ShowS
show :: TagKind -> String
$cshow :: TagKind -> String
showsPrec :: Int -> TagKind -> ShowS
$cshowsPrec :: Int -> TagKind -> ShowS
Show, TagKind -> TagKind -> Bool
(TagKind -> TagKind -> Bool)
-> (TagKind -> TagKind -> Bool) -> Eq TagKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagKind -> TagKind -> Bool
$c/= :: TagKind -> TagKind -> Bool
== :: TagKind -> TagKind -> Bool
$c== :: TagKind -> TagKind -> Bool
Eq, (forall x. TagKind -> Rep TagKind x)
-> (forall x. Rep TagKind x -> TagKind) -> Generic TagKind
forall x. Rep TagKind x -> TagKind
forall x. TagKind -> Rep TagKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagKind x -> TagKind
$cfrom :: forall x. TagKind -> Rep TagKind x
Generic, Int -> TagKind -> Int
TagKind -> Int
(Int -> TagKind -> Int) -> (TagKind -> Int) -> Hashable TagKind
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TagKind -> Int
$chash :: TagKind -> Int
hashWithSalt :: Int -> TagKind -> Int
$chashWithSalt :: Int -> TagKind -> Int
Hashable)

-- | A marker class for marking which type of metadata (settings or property)
-- a key corresponds to.
data MetadataKind = PropertyKind | SettingKind
  deriving (Int -> MetadataKind -> ShowS
[MetadataKind] -> ShowS
MetadataKind -> String
(Int -> MetadataKind -> ShowS)
-> (MetadataKind -> String)
-> ([MetadataKind] -> ShowS)
-> Show MetadataKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetadataKind] -> ShowS
$cshowList :: [MetadataKind] -> ShowS
show :: MetadataKind -> String
$cshow :: MetadataKind -> String
showsPrec :: Int -> MetadataKind -> ShowS
$cshowsPrec :: Int -> MetadataKind -> ShowS
Show, MetadataKind -> MetadataKind -> Bool
(MetadataKind -> MetadataKind -> Bool)
-> (MetadataKind -> MetadataKind -> Bool) -> Eq MetadataKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetadataKind -> MetadataKind -> Bool
$c/= :: MetadataKind -> MetadataKind -> Bool
== :: MetadataKind -> MetadataKind -> Bool
$c== :: MetadataKind -> MetadataKind -> Bool
Eq, (forall x. MetadataKind -> Rep MetadataKind x)
-> (forall x. Rep MetadataKind x -> MetadataKind)
-> Generic MetadataKind
forall x. Rep MetadataKind x -> MetadataKind
forall x. MetadataKind -> Rep MetadataKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetadataKind x -> MetadataKind
$cfrom :: forall x. MetadataKind -> Rep MetadataKind x
Generic, Int -> MetadataKind -> Int
MetadataKind -> Int
(Int -> MetadataKind -> Int)
-> (MetadataKind -> Int) -> Hashable MetadataKind
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MetadataKind -> Int
$chash :: MetadataKind -> Int
hashWithSalt :: Int -> MetadataKind -> Int
$chashWithSalt :: Int -> MetadataKind -> Int
Hashable)

-- | Group errors together, attaching a location if one is available.
groupErrors :: (IsError e, ApErrors e m, HasLocation l) => l -> m a -> m a
groupErrors :: l -> m a -> m a
groupErrors item :: l
item = (ErrorSet e -> ErrorSet e) -> m a -> m a
forall e (f :: * -> *) a. ApError e f => (e -> e) -> f a -> f a
mapError ((ErrorSet e -> ErrorSet e) -> m a -> m a)
-> (ErrorSet e -> ErrorSet e) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ \es :: ErrorSet e
es -> case ErrorSet e -> NonEmpty (Error e)
forall e. ErrorSet e -> NonEmpty (Error e)
allErrors ErrorSet e
es of
    Group Nothing  es' :: ErrorSet e
es' :| [] -> Error e -> ErrorSet e
forall e. Hashable e => Error e -> ErrorSet e
singleError (Error e -> ErrorSet e) -> Error e -> ErrorSet e
forall a b. (a -> b) -> a -> b
$ Maybe Location -> ErrorSet e -> Error e
forall a. Maybe Location -> ErrorSet a -> Error a
Group (l
item l -> Getting (First Location) l Location -> Maybe Location
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Location) l Location
forall t. HasLocation t => Affine' t Location
location) ErrorSet e
es'
    Group (Just _) _   :| [] -> ErrorSet e
es
    _                        -> Error e -> ErrorSet e
forall e. Hashable e => Error e -> ErrorSet e
singleError (Error e -> ErrorSet e) -> Error e -> ErrorSet e
forall a b. (a -> b) -> a -> b
$ Maybe Location -> ErrorSet e -> Error e
forall a. Maybe Location -> ErrorSet a -> Error a
Group (l
item l -> Getting (First Location) l Location -> Maybe Location
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Location) l Location
forall t. HasLocation t => Affine' t Location
location) ErrorSet e
es

-- | Lift a single 'Error' into an 'ErrorSet'.
singleError :: Hashable e => Error e -> ErrorSet e
singleError :: Error e -> ErrorSet e
singleError = HashSet (Error e) -> ErrorSet e
forall e. HashSet (Error e) -> ErrorSet e
ErrorSet (HashSet (Error e) -> ErrorSet e)
-> (Error e -> HashSet (Error e)) -> Error e -> ErrorSet e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error e -> HashSet (Error e)
forall a. Hashable a => a -> HashSet a
singleton
{-# INLINE singleError #-}

-- | Lift a custom error into an 'ErrorSet'.
customError :: Hashable e => e -> ErrorSet e
customError :: e -> ErrorSet e
customError = Error e -> ErrorSet e
forall e. Hashable e => Error e -> ErrorSet e
singleError (Error e -> ErrorSet e) -> (e -> Error e) -> e -> ErrorSet e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Error e
forall a. a -> Error a
Custom
{-# INLINE customError #-}

-- | Throw a single error.
liftError1 :: (IsError e, ApErrors e m) => Error e -> m a
liftError1 :: Error e -> m a
liftError1 = ErrorSet e -> m a
forall e (f :: * -> *) a. ApError e f => e -> f a
liftError (ErrorSet e -> m a) -> (Error e -> ErrorSet e) -> Error e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error e -> ErrorSet e
forall e. Hashable e => Error e -> ErrorSet e
singleError
{-# INLINE liftError1 #-}

-- | Return the set of errors in an 'ErrorSet' as a non-empty list.
allErrors :: ErrorSet e -> NonEmpty (Error e)
allErrors :: ErrorSet e -> NonEmpty (Error e)
allErrors (ErrorSet hs :: HashSet (Error e)
hs) =
    NonEmpty (Error e)
-> (NonEmpty (Error e) -> NonEmpty (Error e))
-> Maybe (NonEmpty (Error e))
-> NonEmpty (Error e)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> NonEmpty (Error e)
forall a. HasCallStack => String -> a
error "unexpected empty ErrorSet") NonEmpty (Error e) -> NonEmpty (Error e)
forall a. a -> a
id (Maybe (NonEmpty (Error e)) -> NonEmpty (Error e))
-> ([Error e] -> Maybe (NonEmpty (Error e)))
-> [Error e]
-> NonEmpty (Error e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Error e] -> Maybe (NonEmpty (Error e))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Error e] -> NonEmpty (Error e))
-> [Error e] -> NonEmpty (Error e)
forall a b. (a -> b) -> a -> b
$ HashSet (Error e) -> [Error e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet (Error e)
hs