{-|
    Module      :  Numeric.CollectErrors
    Description :  A type of numeric errors to be collected
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable

    A type of numeric errors to be collected.
-}
module Numeric.CollectErrors
(
  -- * Type of numeric errors
  ErrorCertaintyLevel(..), NumError(..), NumErrors, sample_NumErrors
  -- * Specialisation to numeric errors
, CN
, hasCertainError, hasCertainErrorCN
, hasError, hasErrorCN
, noValueCN
, noValueNumErrorCertainCN, noValueNumErrorPotentialCN
, getMaybeValueCN, getErrorsCN, prependErrorsCN
, CanEnsureCN, EnsureCN, EnsureNoCN
, ensureCN, deEnsureCN, ensureNoCN
, noValueECN, prependErrorsECN
, noValueNumErrorCertainECN, noValueNumErrorPotentialECN
, CanExtractCN, extractCN
  -- ** More compact synonyms
, cn, deCN, (~!)
)
where

import Prelude
  (Show(..), Eq(..), Bool, String, Maybe(..), Either(..), (++), (.), or, map, fst, ($), null, not)

import Control.CollectErrors

data NumError =
    DivByZero | OutOfRange String | NumError String
    deriving (NumError -> NumError -> Bool
(NumError -> NumError -> Bool)
-> (NumError -> NumError -> Bool) -> Eq NumError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumError -> NumError -> Bool
$c/= :: NumError -> NumError -> Bool
== :: NumError -> NumError -> Bool
$c== :: NumError -> NumError -> Bool
Eq)

instance Show NumError where
  show :: NumError -> String
show NumError
DivByZero = String
"division by 0"
  show (OutOfRange String
s) = String
"out of range: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
  show (NumError String
s) = String
"numeric error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

data ErrorCertaintyLevel =
  ErrorCertain | ErrorPotential
  deriving (ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
(ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool)
-> (ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool)
-> Eq ErrorCertaintyLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
$c/= :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
== :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
$c== :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
Eq)

instance Show ErrorCertaintyLevel where
  show :: ErrorCertaintyLevel -> String
show ErrorCertaintyLevel
ErrorCertain = String
"ERROR"
  show ErrorCertaintyLevel
ErrorPotential = String
"POTENTIAL ERROR"

type NumErrors = [(ErrorCertaintyLevel, NumError)]

instance CanTestErrorsCertain NumErrors where
  hasCertainError :: NumErrors -> Bool
hasCertainError NumErrors
es =
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ ((ErrorCertaintyLevel, NumError) -> Bool) -> NumErrors -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
forall a. Eq a => a -> a -> Bool
== ErrorCertaintyLevel
ErrorCertain) (ErrorCertaintyLevel -> Bool)
-> ((ErrorCertaintyLevel, NumError) -> ErrorCertaintyLevel)
-> (ErrorCertaintyLevel, NumError)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ErrorCertaintyLevel, NumError) -> ErrorCertaintyLevel
forall a b. (a, b) -> a
fst) NumErrors
es

hasCertainErrorCN :: CN v -> Bool
hasCertainErrorCN :: CN v -> Bool
hasCertainErrorCN = CN v -> Bool
forall es v. CanTestErrorsCertain es => CollectErrors es v -> Bool
hasCertainErrorCE

instance CanTestErrorsPresent NumErrors where
  hasError :: NumErrors -> Bool
hasError = Bool -> Bool
not (Bool -> Bool) -> (NumErrors -> Bool) -> NumErrors -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumErrors -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

hasErrorCN :: CN v -> Bool
hasErrorCN :: CN v -> Bool
hasErrorCN = CN v -> Bool
forall es v. CanTestErrorsPresent es => CollectErrors es v -> Bool
hasErrorCE

sample_NumErrors :: Maybe [(ErrorCertaintyLevel, NumError)]
sample_NumErrors :: Maybe NumErrors
sample_NumErrors = Maybe NumErrors
forall a. Maybe a
Nothing

type CN = CollectErrors NumErrors
type CanEnsureCN = CanEnsureCE NumErrors
type EnsureCN a = EnsureCE NumErrors a
type EnsureNoCN a = EnsureNoCE NumErrors a

type CanExtractCN f = CanExtractCE NumErrors f
extractCN ::
  (CanEnsureCN c, CanExtractCN f) =>
  f c -> CN (f (EnsureNoCN c))
extractCN :: f c -> CN (f (EnsureNoCN c))
extractCN = Maybe NumErrors -> f c -> CN (f (EnsureNoCN c))
forall es (f :: * -> *) c.
(CanExtractCE es f, CanEnsureCE es c) =>
Maybe es -> f c -> CollectErrors es (f (EnsureNoCE es c))
extractCE Maybe NumErrors
sample_NumErrors

{-|
  Translate a value of a type @a@
  to a value of a type @CollectNumErrors a@ except when @a@
  already is a @CollectNumErrors@ type, in which case the value is left as is.
-}
ensureCN :: (CanEnsureCN v) => v -> EnsureCN v
ensureCN :: v -> EnsureCN v
ensureCN = Maybe NumErrors -> v -> EnsureCN v
forall es a. CanEnsureCE es a => Maybe es -> a -> EnsureCE es a
ensureCE Maybe NumErrors
sample_NumErrors

{-|
  Translate a value of a type @EnsureCN es a@ to @a@,
  throwing an exception if there was an error.
  If @a@ is a @CollectNumErrors@ type, then this is just an identity.
-}
deEnsureCN :: (CanEnsureCN v) => EnsureCN v -> Either NumErrors v
deEnsureCN :: EnsureCN v -> Either NumErrors v
deEnsureCN = Maybe NumErrors -> EnsureCN v -> Either NumErrors v
forall es a.
CanEnsureCE es a =>
Maybe es -> EnsureCE es a -> Either es a
deEnsureCE Maybe NumErrors
sample_NumErrors

{-|
  Translate a value of a type @a@
  to a value of a type @CollectNumErrors a@ except when @a@
  already is a @CollectNumErrors@ type, in which case the value is left as is.
-}
ensureNoCN :: (CanEnsureCN v) => v -> (Maybe (EnsureNoCN v), NumErrors)
ensureNoCN :: v -> (Maybe (EnsureNoCN v), NumErrors)
ensureNoCN = Maybe NumErrors -> v -> (Maybe (EnsureNoCN v), NumErrors)
forall es a.
CanEnsureCE es a =>
Maybe es -> a -> (Maybe (EnsureNoCE es a), es)
ensureNoCE Maybe NumErrors
sample_NumErrors

noValueECN :: (CanEnsureCN v) => Maybe v -> NumErrors -> EnsureCN v
noValueECN :: Maybe v -> NumErrors -> EnsureCN v
noValueECN = Maybe v -> NumErrors -> EnsureCN v
forall es a. CanEnsureCE es a => Maybe a -> es -> EnsureCE es a
noValueECE

prependErrorsECN :: (CanEnsureCN v) => Maybe v -> NumErrors -> EnsureCN v -> EnsureCN v
prependErrorsECN :: Maybe v -> NumErrors -> EnsureCN v -> EnsureCN v
prependErrorsECN = Maybe v -> NumErrors -> EnsureCN v -> EnsureCN v
forall es a.
CanEnsureCE es a =>
Maybe a -> es -> EnsureCE es a -> EnsureCE es a
prependErrorsECE

{-| Construct an empty wrapper indicating that given error has certainly occurred. -}
noValueNumErrorCertainECN :: (CanEnsureCN v) => Maybe v -> NumError -> EnsureCN v
noValueNumErrorCertainECN :: Maybe v -> NumError -> EnsureCN v
noValueNumErrorCertainECN Maybe v
sample_v NumError
e = Maybe v -> NumErrors -> EnsureCN v
forall es a. CanEnsureCE es a => Maybe a -> es -> EnsureCE es a
noValueECE Maybe v
sample_v [(ErrorCertaintyLevel
ErrorCertain, NumError
e)]

{-| Construct an empty wrapper indicating that given error may have occurred. -}
noValueNumErrorPotentialECN :: (CanEnsureCN v) => Maybe v -> NumError -> EnsureCN v
noValueNumErrorPotentialECN :: Maybe v -> NumError -> EnsureCN v
noValueNumErrorPotentialECN Maybe v
sample_v NumError
e = Maybe v -> NumErrors -> EnsureCN v
forall es a. CanEnsureCE es a => Maybe a -> es -> EnsureCE es a
noValueECE Maybe v
sample_v [(ErrorCertaintyLevel
ErrorPotential, NumError
e)]

getErrorsCN :: CN v -> NumErrors
getErrorsCN :: CN v -> NumErrors
getErrorsCN = CN v -> NumErrors
forall es v. CollectErrors es v -> es
getErrorsCE

getMaybeValueCN :: CN v -> Maybe v
getMaybeValueCN :: CN v -> Maybe v
getMaybeValueCN = CN v -> Maybe v
forall es v. CollectErrors es v -> Maybe v
getMaybeValueCE

noValueCN :: NumErrors -> CN v
noValueCN :: NumErrors -> CN v
noValueCN = NumErrors -> CN v
forall es v. es -> CollectErrors es v
noValueCE

{-| Construct an empty wrapper indicating that given error has certainly occurred. -}
noValueNumErrorCertainCN :: NumError -> CN v
noValueNumErrorCertainCN :: NumError -> CN v
noValueNumErrorCertainCN NumError
e = NumErrors -> CN v
forall v. NumErrors -> CN v
noValueCN [(ErrorCertaintyLevel
ErrorCertain, NumError
e)]

{-| Construct an empty wrapper indicating that given error may have occurred. -}
noValueNumErrorPotentialCN :: NumError -> CN v
noValueNumErrorPotentialCN :: NumError -> CN v
noValueNumErrorPotentialCN NumError
e = NumErrors -> CN v
forall v. NumErrors -> CN v
noValueCN [(ErrorCertaintyLevel
ErrorPotential, NumError
e)]

prependErrorsCN :: NumErrors -> CN v -> CN v
prependErrorsCN :: NumErrors -> CN v -> CN v
prependErrorsCN = NumErrors -> CN v -> CN v
forall es v.
Monoid es =>
es -> CollectErrors es v -> CollectErrors es v
prependErrorsCE

-- more compact synonyms:

{-| Wrap a value in the 'CollectNumErrors' wrapper. -}
cn :: (CanEnsureCN v) => v -> EnsureCN v
cn :: v -> EnsureCN v
cn = v -> EnsureCN v
forall v. CanEnsureCN v => v -> EnsureCN v
ensureCN

{-| An unsafe way to get a value out of the CollectNumErrors wrapper. -}
deCN :: (CanEnsureCN v) => EnsureCN v -> Either NumErrors v
deCN :: EnsureCN v -> Either NumErrors v
deCN = EnsureCN v -> Either NumErrors v
forall v. CanEnsureCN v => EnsureCN v -> Either NumErrors v
deEnsureCN

{-| An unsafe way to get a value out of the CollectNumErrors wrapper. -}
(~!) :: (CanEnsureCN v, Show v) => v -> EnsureNoCN v
~! :: v -> EnsureNoCN v
(~!) = Maybe NumErrors -> v -> EnsureNoCN v
forall es v.
(SuitableForCE es, CanEnsureCE es v, Show v) =>
Maybe es -> v -> EnsureNoCE es v
getValueOrThrowErrorsNCE Maybe NumErrors
sample_NumErrors