{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ConstraintKinds #-}
module Numeric.CollectErrors.Type 

where

import GHC.Generics
import Control.DeepSeq

import qualified Data.List as List
import qualified Data.Set as Set

import Control.CollectErrors
    ( CanTestErrorsCertain(..), CollectErrors (CollectErrors), noValue, removeValue, prependErrors, liftCE, lift2CE, lift1TCE, liftT1CE, unCollectErrors, CanTestErrorsPresent, CanTakeErrors  )

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

unCN :: CN p -> p
unCN :: CN p -> p
unCN = CN p -> p
forall es p. Show es => CollectErrors es p -> p
unCollectErrors

type CN = CollectErrors NumErrors
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
/= :: NumErrors -> NumErrors -> Bool
$c/= :: NumErrors -> NumErrors -> Bool
== :: NumErrors -> NumErrors -> Bool
$c== :: NumErrors -> NumErrors -> Bool
Eq, b -> NumErrors -> NumErrors
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
stimes :: b -> NumErrors -> NumErrors
$cstimes :: forall b. Integral b => b -> NumErrors -> NumErrors
sconcat :: NonEmpty NumErrors -> NumErrors
$csconcat :: NonEmpty NumErrors -> NumErrors
<> :: NumErrors -> NumErrors -> NumErrors
$c<> :: NumErrors -> 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
mconcat :: [NumErrors] -> NumErrors
$cmconcat :: [NumErrors] -> NumErrors
mappend :: NumErrors -> NumErrors -> NumErrors
$cmappend :: NumErrors -> NumErrors -> NumErrors
mempty :: NumErrors
$cmempty :: NumErrors
$cp1Monoid :: Semigroup NumErrors
Monoid, NumErrors -> Bool
(NumErrors -> Bool) -> CanTestErrorsCertain NumErrors
forall es. (es -> Bool) -> CanTestErrorsCertain es
hasCertainError :: NumErrors -> Bool
$chasCertainError :: NumErrors -> Bool
CanTestErrorsCertain, NumErrors -> Bool
(NumErrors -> Bool) -> CanTestErrorsPresent NumErrors
forall es. (es -> Bool) -> CanTestErrorsPresent es
hasError :: NumErrors -> Bool
$chasError :: 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
$cto :: forall x. Rep NumErrors x -> NumErrors
$cfrom :: forall x. NumErrors -> Rep NumErrors x
Generic, NumErrors -> ()
(NumErrors -> ()) -> NFData NumErrors
forall a. (a -> ()) -> NFData a
rnf :: NumErrors -> ()
$crnf :: 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
/= :: NumError -> NumError -> Bool
$c/= :: NumError -> NumError -> Bool
== :: NumError -> NumError -> Bool
$c== :: 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
min :: NumError -> NumError -> NumError
$cmin :: NumError -> NumError -> NumError
max :: NumError -> NumError -> NumError
$cmax :: NumError -> NumError -> NumError
>= :: NumError -> NumError -> Bool
$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
compare :: NumError -> NumError -> Ordering
$ccompare :: NumError -> NumError -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep NumError x -> NumError
$cfrom :: forall x. NumError -> Rep NumError x
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
/= :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
$c/= :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
== :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
$c== :: 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
min :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> ErrorCertaintyLevel
$cmin :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> ErrorCertaintyLevel
max :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> ErrorCertaintyLevel
$cmax :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> ErrorCertaintyLevel
>= :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Bool
$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
compare :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Ordering
$ccompare :: ErrorCertaintyLevel -> ErrorCertaintyLevel -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep ErrorCertaintyLevel x -> ErrorCertaintyLevel
$cfrom :: forall x. ErrorCertaintyLevel -> Rep ErrorCertaintyLevel x
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 :: NumError -> CN v
noValueNumErrorCertain NumError
e = NumErrors -> CN v
forall es v. es -> CollectErrors es v
noValue (NumErrors -> CN v) -> NumErrors -> CN 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 :: NumError -> CN v
noValueNumErrorPotential NumError
e = NumErrors -> CN v
forall es v. es -> CollectErrors es v
noValue (NumErrors -> CN v) -> NumErrors -> CN 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 :: 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 :: 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 :: NumError -> CN t -> CN t
prependErrorCertain NumError
e = NumErrors -> CN t -> CN t
forall es v.
Monoid es =>
es -> CollectErrors es v -> CollectErrors es v
prependErrors (NumErrors -> CN t -> CN t) -> NumErrors -> CN t -> 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)
  
prependErrorPotential :: NumError -> CN t -> CN t
prependErrorPotential :: NumError -> CN t -> CN t
prependErrorPotential NumError
e = NumErrors -> CN t -> CN t
forall es v.
Monoid es =>
es -> CollectErrors es v -> CollectErrors es v
prependErrors (NumErrors -> CN t -> CN t) -> NumErrors -> CN t -> 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)

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 :: (a -> CN c) -> CN a -> CN c
liftCN = (a -> CN c) -> CN a -> CN 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 :: (a -> b -> CN c) -> CN a -> CN b -> CN c
lift2CN = (a -> b -> CN c) -> CN a -> CN b -> CN 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 :: (a -> b -> CN c) -> CN a -> b -> CN c
lift1TCN = (a -> b -> CN c) -> CN a -> b -> CN 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 :: (a -> b -> CN c) -> a -> CN b -> CN c
liftT1CN = (a -> b -> CN c) -> a -> CN b -> CN 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