{-# 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
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
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)
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
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)
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
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