{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Numeric.CollectErrors.Type where

import Control.CollectErrors
  ( CanTakeErrors,
    CanTestErrorsCertain (..),
    CanTestErrorsPresent,
    CollectErrors (CollectErrors),
    lift1TCE,
    lift2CE,
    liftCE,
    liftT1CE,
    noValue,
    prependErrors,
    removeValue,
    unCollectErrors,
  )
import Control.DeepSeq
import qualified Data.List as List
import qualified Data.Set as Set
import GHC.Generics

type CN = CollectErrors NumErrors

cn :: v -> CN v
cn :: forall v. v -> CN v
cn = v -> CollectErrors NumErrors v
forall v. v -> CN v
forall (f :: * -> *) a. Applicative f => a -> f a
pure

{-| Unsafe way to get a value out of the CN wrapper. -}
unCN :: CN p -> p
unCN :: forall p. CN p -> p
unCN = CollectErrors NumErrors p -> p
forall es p. Show es => CollectErrors es p -> p
unCollectErrors

{-| Unsafe way to get the result of a function out of the CN wrapper. -}
unCNfn1 :: (a -> CN p) -> a -> p
unCNfn1 :: forall a p. (a -> CN p) -> a -> p
unCNfn1 a -> CN p
fn a
a = CN p -> p
forall es p. Show es => CollectErrors es p -> p
unCollectErrors (a -> CN p
fn a
a)

{-| Unsafe way to get the result of a binary function out of the CN wrapper. -}
unCNfn2 :: (a -> b -> CN p) -> a -> b -> p
unCNfn2 :: forall a b p. (a -> b -> CN p) -> a -> b -> p
unCNfn2 a -> b -> CN p
fn a
a b
b = CN p -> p
forall es p. Show es => CollectErrors es p -> p
unCollectErrors (a -> b -> CN p
fn a
a b
b)

newtype NumErrors = NumErrors (Set.Set NumErrorLevel)
  deriving (NumErrors -> NumErrors -> Bool
(NumErrors -> NumErrors -> Bool)
-> (NumErrors -> NumErrors -> Bool) -> Eq NumErrors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumErrors -> NumErrors -> Bool
== :: NumErrors -> NumErrors -> Bool
$c/= :: NumErrors -> NumErrors -> Bool
/= :: NumErrors -> NumErrors -> Bool
Eq, NonEmpty NumErrors -> NumErrors
NumErrors -> NumErrors -> NumErrors
(NumErrors -> NumErrors -> NumErrors)
-> (NonEmpty NumErrors -> NumErrors)
-> (forall b. Integral b => b -> NumErrors -> NumErrors)
-> Semigroup NumErrors
forall b. Integral b => b -> NumErrors -> NumErrors
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: NumErrors -> NumErrors -> NumErrors
<> :: NumErrors -> NumErrors -> NumErrors
$csconcat :: NonEmpty NumErrors -> NumErrors
sconcat :: NonEmpty NumErrors -> NumErrors
$cstimes :: forall b. Integral b => b -> NumErrors -> NumErrors
stimes :: forall b. Integral b => b -> NumErrors -> NumErrors
Semigroup, Semigroup NumErrors
NumErrors
Semigroup NumErrors =>
NumErrors
-> (NumErrors -> NumErrors -> NumErrors)
-> ([NumErrors] -> NumErrors)
-> Monoid NumErrors
[NumErrors] -> NumErrors
NumErrors -> NumErrors -> NumErrors
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: NumErrors
mempty :: NumErrors
$cmappend :: NumErrors -> NumErrors -> NumErrors
mappend :: NumErrors -> NumErrors -> NumErrors
$cmconcat :: [NumErrors] -> NumErrors
mconcat :: [NumErrors] -> NumErrors
Monoid, NumErrors -> Bool
(NumErrors -> Bool) -> CanTestErrorsCertain NumErrors
forall es. (es -> Bool) -> CanTestErrorsCertain es
$chasCertainError :: NumErrors -> Bool
hasCertainError :: NumErrors -> Bool
CanTestErrorsCertain, NumErrors -> Bool
(NumErrors -> Bool) -> CanTestErrorsPresent NumErrors
forall es. (es -> Bool) -> CanTestErrorsPresent es
$chasError :: NumErrors -> Bool
hasError :: NumErrors -> Bool
CanTestErrorsPresent, (forall x. NumErrors -> Rep NumErrors x)
-> (forall x. Rep NumErrors x -> NumErrors) -> Generic NumErrors
forall x. Rep NumErrors x -> NumErrors
forall x. NumErrors -> Rep NumErrors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NumErrors -> Rep NumErrors x
from :: forall x. NumErrors -> Rep NumErrors x
$cto :: forall x. Rep NumErrors x -> NumErrors
to :: forall x. Rep NumErrors x -> NumErrors
Generic, NumErrors -> ()
(NumErrors -> ()) -> NFData NumErrors
forall a. (a -> ()) -> NFData a
$crnf :: NumErrors -> ()
rnf :: NumErrors -> ()
NFData)

type NumErrorLevel = (NumError, ErrorCertaintyLevel)

instance Show NumErrors where
  show :: NumErrors -> String
show (NumErrors Set NumErrorLevel
set) =
    String
"{" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"; " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (NumErrorLevel -> String) -> [NumErrorLevel] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map NumErrorLevel -> String
forall {a} {a}. (Show a, Show a) => (a, a) -> String
showEL ([NumErrorLevel] -> [String]) -> [NumErrorLevel] -> [String]
forall a b. (a -> b) -> a -> b
$ Set NumErrorLevel -> [NumErrorLevel]
forall a. Set a -> [a]
Set.toList Set NumErrorLevel
set) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}"
    where
      showEL :: (a, a) -> String
showEL (a
e, a
l) =
        a -> String
forall a. Show a => a -> String
show a
l String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
e

data NumError
  = DivByZero
  | OutOfDomain 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
$c== :: NumError -> NumError -> Bool
== :: NumError -> NumError -> Bool
$c/= :: NumError -> NumError -> Bool
/= :: NumError -> NumError -> Bool
Eq, Eq NumError
Eq NumError =>
(NumError -> NumError -> Ordering)
-> (NumError -> NumError -> Bool)
-> (NumError -> NumError -> Bool)
-> (NumError -> NumError -> Bool)
-> (NumError -> NumError -> Bool)
-> (NumError -> NumError -> NumError)
-> (NumError -> NumError -> NumError)
-> Ord NumError
NumError -> NumError -> Bool
NumError -> NumError -> Ordering
NumError -> NumError -> NumError
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
$ccompare :: NumError -> NumError -> Ordering
compare :: NumError -> NumError -> Ordering
$c< :: NumError -> NumError -> Bool
< :: NumError -> NumError -> Bool
$c<= :: NumError -> NumError -> Bool
<= :: NumError -> NumError -> Bool
$c> :: NumError -> NumError -> Bool
> :: NumError -> NumError -> Bool
$c>= :: NumError -> NumError -> Bool
>= :: NumError -> NumError -> Bool
$cmax :: NumError -> NumError -> NumError
max :: NumError -> NumError -> NumError
$cmin :: NumError -> NumError -> NumError
min :: NumError -> NumError -> NumError
Ord, (forall x. NumError -> Rep NumError x)
-> (forall x. Rep NumError x -> NumError) -> Generic NumError
forall x. Rep NumError x -> NumError
forall x. NumError -> Rep NumError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NumError -> Rep NumError x
from :: forall x. NumError -> Rep NumError x
$cto :: forall x. Rep NumError x -> NumError
to :: forall x. Rep NumError x -> NumError
Generic)

instance NFData NumError

instance Show NumError where
  show :: NumError -> String
show NumError
DivByZero = String
"division by 0"
  show (OutOfDomain String
s) = String
"out of domain: " 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
$c== :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
== :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
$c/= :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
/= :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
Eq, Eq ErrorCertaintyLevel
Eq ErrorCertaintyLevel =>
(ErrorCertaintyLevel -> ErrorCertaintyLevel -> Ordering)
-> (ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool)
-> (ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool)
-> (ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool)
-> (ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool)
-> (ErrorCertaintyLevel
    -> ErrorCertaintyLevel -> ErrorCertaintyLevel)
-> (ErrorCertaintyLevel
    -> ErrorCertaintyLevel -> ErrorCertaintyLevel)
-> Ord ErrorCertaintyLevel
ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
ErrorCertaintyLevel -> ErrorCertaintyLevel -> Ordering
ErrorCertaintyLevel -> ErrorCertaintyLevel -> ErrorCertaintyLevel
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
$ccompare :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Ordering
compare :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Ordering
$c< :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
< :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
$c<= :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
<= :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
$c> :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
> :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
$c>= :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
>= :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
$cmax :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> ErrorCertaintyLevel
max :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> ErrorCertaintyLevel
$cmin :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> ErrorCertaintyLevel
min :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> ErrorCertaintyLevel
Ord, (forall x. ErrorCertaintyLevel -> Rep ErrorCertaintyLevel x)
-> (forall x. Rep ErrorCertaintyLevel x -> ErrorCertaintyLevel)
-> Generic ErrorCertaintyLevel
forall x. Rep ErrorCertaintyLevel x -> ErrorCertaintyLevel
forall x. ErrorCertaintyLevel -> Rep ErrorCertaintyLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ErrorCertaintyLevel -> Rep ErrorCertaintyLevel x
from :: forall x. ErrorCertaintyLevel -> Rep ErrorCertaintyLevel x
$cto :: forall x. Rep ErrorCertaintyLevel x -> ErrorCertaintyLevel
to :: forall x. Rep ErrorCertaintyLevel x -> ErrorCertaintyLevel
Generic)

instance NFData ErrorCertaintyLevel

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

instance CanTestErrorsCertain NumErrorLevel where
  hasCertainError :: NumErrorLevel -> Bool
hasCertainError = (ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
forall a. Eq a => a -> a -> Bool
== ErrorCertaintyLevel
ErrorCertain) (ErrorCertaintyLevel -> Bool)
-> (NumErrorLevel -> ErrorCertaintyLevel) -> NumErrorLevel -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumErrorLevel -> ErrorCertaintyLevel
forall a b. (a, b) -> b
snd

-- | Construct an empty wrapper indicating that given error has certainly occurred.
noValueNumErrorCertain :: NumError -> CN v
noValueNumErrorCertain :: forall v. NumError -> CN v
noValueNumErrorCertain NumError
e = NumErrors -> CollectErrors NumErrors v
forall es v. es -> CollectErrors es v
noValue (NumErrors -> CollectErrors NumErrors v)
-> NumErrors -> CollectErrors NumErrors v
forall a b. (a -> b) -> a -> b
$ Set NumErrorLevel -> NumErrors
NumErrors (Set NumErrorLevel -> NumErrors) -> Set NumErrorLevel -> NumErrors
forall a b. (a -> b) -> a -> b
$ NumErrorLevel -> Set NumErrorLevel
forall a. a -> Set a
Set.singleton (NumError
e, ErrorCertaintyLevel
ErrorCertain)

-- | Construct an empty wrapper indicating that given error may have occurred.
noValueNumErrorPotential :: NumError -> CN v
noValueNumErrorPotential :: forall v. NumError -> CN v
noValueNumErrorPotential NumError
e = NumErrors -> CollectErrors NumErrors v
forall es v. es -> CollectErrors es v
noValue (NumErrors -> CollectErrors NumErrors v)
-> NumErrors -> CollectErrors NumErrors v
forall a b. (a -> b) -> a -> b
$ Set NumErrorLevel -> NumErrors
NumErrors (Set NumErrorLevel -> NumErrors) -> Set NumErrorLevel -> NumErrors
forall a b. (a -> b) -> a -> b
$ NumErrorLevel -> Set NumErrorLevel
forall a. a -> Set a
Set.singleton (NumError
e, ErrorCertaintyLevel
ErrorPotential)

removeValueErrorCertain :: CN t -> NumError -> CN t
removeValueErrorCertain :: forall t. CN t -> NumError -> CN t
removeValueErrorCertain CN t
v NumError
e =
  CN t -> NumErrors -> CN t
forall es v.
Monoid es =>
CollectErrors es v -> es -> CollectErrors es v
removeValue CN t
v (NumErrors -> CN t) -> NumErrors -> CN t
forall a b. (a -> b) -> a -> b
$ Set NumErrorLevel -> NumErrors
NumErrors (Set NumErrorLevel -> NumErrors) -> Set NumErrorLevel -> NumErrors
forall a b. (a -> b) -> a -> b
$ NumErrorLevel -> Set NumErrorLevel
forall a. a -> Set a
Set.singleton (NumError
e, ErrorCertaintyLevel
ErrorCertain)

removeValueErrorPotential :: CN t -> NumError -> CN t
removeValueErrorPotential :: forall t. CN t -> NumError -> CN t
removeValueErrorPotential CN t
v NumError
e =
  CN t -> NumErrors -> CN t
forall es v.
Monoid es =>
CollectErrors es v -> es -> CollectErrors es v
removeValue CN t
v (NumErrors -> CN t) -> NumErrors -> CN t
forall a b. (a -> b) -> a -> b
$ Set NumErrorLevel -> NumErrors
NumErrors (Set NumErrorLevel -> NumErrors) -> Set NumErrorLevel -> NumErrors
forall a b. (a -> b) -> a -> b
$ NumErrorLevel -> Set NumErrorLevel
forall a. a -> Set a
Set.singleton (NumError
e, ErrorCertaintyLevel
ErrorPotential)

prependErrorCertain :: NumError -> CN t -> CN t
prependErrorCertain :: forall t. NumError -> CN t -> CN t
prependErrorCertain NumError
e = NumErrors -> CollectErrors NumErrors t -> CollectErrors NumErrors t
forall es v.
Monoid es =>
es -> CollectErrors es v -> CollectErrors es v
prependErrors (NumErrors
 -> CollectErrors NumErrors t -> CollectErrors NumErrors t)
-> NumErrors
-> CollectErrors NumErrors t
-> CollectErrors NumErrors t
forall a b. (a -> b) -> a -> b
$ Set NumErrorLevel -> NumErrors
NumErrors (Set NumErrorLevel -> NumErrors) -> Set NumErrorLevel -> NumErrors
forall a b. (a -> b) -> a -> b
$ NumErrorLevel -> Set NumErrorLevel
forall a. a -> Set a
Set.singleton (NumError
e, ErrorCertaintyLevel
ErrorCertain)

prependErrorPotential :: NumError -> CN t -> CN t
prependErrorPotential :: forall t. NumError -> CN t -> CN t
prependErrorPotential NumError
e = NumErrors -> CollectErrors NumErrors t -> CollectErrors NumErrors t
forall es v.
Monoid es =>
es -> CollectErrors es v -> CollectErrors es v
prependErrors (NumErrors
 -> CollectErrors NumErrors t -> CollectErrors NumErrors t)
-> NumErrors
-> CollectErrors NumErrors t
-> CollectErrors NumErrors t
forall a b. (a -> b) -> a -> b
$ Set NumErrorLevel -> NumErrors
NumErrors (Set NumErrorLevel -> NumErrors) -> Set NumErrorLevel -> NumErrors
forall a b. (a -> b) -> a -> b
$ NumErrorLevel -> Set NumErrorLevel
forall a. a -> Set a
Set.singleton (NumError
e, ErrorCertaintyLevel
ErrorPotential)

class CanClearPotentialErrors cnt where
  -- |
  --    If there is a value, remove any potential errors that are associated with it.
  clearPotentialErrors :: cnt -> cnt

instance CanClearPotentialErrors (CN t) where
  clearPotentialErrors :: CN t -> CN t
clearPotentialErrors (CollectErrors (Just t
v) (NumErrors Set NumErrorLevel
es)) =
    Maybe t -> NumErrors -> CN t
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (t -> Maybe t
forall a. a -> Maybe a
Just t
v) (Set NumErrorLevel -> NumErrors
NumErrors (Set NumErrorLevel -> NumErrors) -> Set NumErrorLevel -> NumErrors
forall a b. (a -> b) -> a -> b
$ (NumErrorLevel -> Bool) -> Set NumErrorLevel -> Set NumErrorLevel
forall a. (a -> Bool) -> Set a -> Set a
Set.filter NumErrorLevel -> Bool
forall {a}. (a, ErrorCertaintyLevel) -> Bool
notPotential Set NumErrorLevel
es)
    where
      notPotential :: (a, ErrorCertaintyLevel) -> Bool
notPotential (a
_, ErrorCertaintyLevel
ErrorPotential) = Bool
False
      notPotential (a, ErrorCertaintyLevel)
_ = Bool
True
  clearPotentialErrors CN t
ce = CN t
ce

instance (CanClearPotentialErrors t1, CanClearPotentialErrors t2) => CanClearPotentialErrors (t1, t2) where
  clearPotentialErrors :: (t1, t2) -> (t1, t2)
clearPotentialErrors (t1
v1, t2
v2) = (t1 -> t1
forall cnt. CanClearPotentialErrors cnt => cnt -> cnt
clearPotentialErrors t1
v1, t2 -> t2
forall cnt. CanClearPotentialErrors cnt => cnt -> cnt
clearPotentialErrors t2
v2)

instance (CanClearPotentialErrors t) => CanClearPotentialErrors [t] where
  clearPotentialErrors :: [t] -> [t]
clearPotentialErrors = (t -> t) -> [t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map t -> t
forall cnt. CanClearPotentialErrors cnt => cnt -> cnt
clearPotentialErrors

liftCN :: (a -> (CN c)) -> (CN a) -> (CN c)
liftCN :: forall a c. (a -> CN c) -> CN a -> CN c
liftCN = (a -> CollectErrors NumErrors c)
-> CollectErrors NumErrors a -> CollectErrors NumErrors c
forall es a c.
Monoid es =>
(a -> CollectErrors es c)
-> CollectErrors es a -> CollectErrors es c
liftCE

lift2CN :: (a -> b -> (CN c)) -> (CN a) -> (CN b) -> (CN c)
lift2CN :: forall a b c. (a -> b -> CN c) -> CN a -> CN b -> CN c
lift2CN = (a -> b -> CollectErrors NumErrors c)
-> CollectErrors NumErrors a
-> CollectErrors NumErrors b
-> CollectErrors NumErrors c
forall es a b c.
Monoid es =>
(a -> b -> CollectErrors es c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
lift2CE

lift1TCN :: (a -> b -> (CN c)) -> (CN a) -> b -> (CN c)
lift1TCN :: forall a b c. (a -> b -> CN c) -> CN a -> b -> CN c
lift1TCN = (a -> b -> CollectErrors NumErrors c)
-> CollectErrors NumErrors a -> b -> CollectErrors NumErrors c
forall es a b c.
Monoid es =>
(a -> b -> CollectErrors es c)
-> CollectErrors es a -> b -> CollectErrors es c
lift1TCE

liftT1CN :: (a -> b -> (CN c)) -> a -> (CN b) -> (CN c)
liftT1CN :: forall a b c. (a -> b -> CN c) -> a -> CN b -> CN c
liftT1CN = (a -> b -> CollectErrors NumErrors c)
-> a -> CollectErrors NumErrors b -> CollectErrors NumErrors c
forall es a b c.
Monoid es =>
(a -> b -> CollectErrors es c)
-> a -> CollectErrors es b -> CollectErrors es c
liftT1CE

type CanTakeCNErrors = CanTakeErrors NumErrors