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

where

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

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

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

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)

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)

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)

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