{-|
    Module      :  Numeric.MixedType.Reduce
    Description :  Throw error when too inaccurate
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    Mechanism to throw an error when a value gets too inaccurate.
-}
module Numeric.MixedTypes.Reduce
(
    CanGiveUpIfVeryInaccurate(giveUpIfVeryInaccurate)
    , numErrorVeryInaccurate
)
where

import Numeric.MixedTypes.PreludeHiding
-- import qualified Prelude as P

import Numeric.CollectErrors ( CN, NumError (NumError) )
import qualified Numeric.CollectErrors as CN

import Numeric.MixedTypes.Eq

class CanGiveUpIfVeryInaccurate t where
  {-| If the value contains so little information that it is seen as useless,
      drop the value and add an error indicating what happened.
    -}
  giveUpIfVeryInaccurate :: CN t -> CN t
  giveUpIfVeryInaccurate = forall a. a -> a
id  -- by default, never give up!

numErrorVeryInaccurate :: String -> String -> NumError
numErrorVeryInaccurate :: String -> String -> NumError
numErrorVeryInaccurate String
context String
detail =
  case (String
context, String
detail) of
     (String
"", String
"") -> String -> NumError
NumError forall a b. (a -> b) -> a -> b
$ String
msg forall a. Semigroup a => a -> a -> a
<> String
"."
     (String
"", String
_) -> String -> NumError
NumError forall a b. (a -> b) -> a -> b
$ String
msg forall a. Semigroup a => a -> a -> a
<> String
": " forall a. [a] -> [a] -> [a]
++ String
detail
     (String
_, String
"") -> String -> NumError
NumError forall a b. (a -> b) -> a -> b
$ String
context forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> String
msg forall a. Semigroup a => a -> a -> a
<> String
"."
     (String, String)
_ -> String -> NumError
NumError forall a b. (a -> b) -> a -> b
$ String
context forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> String
msg forall a. Semigroup a => a -> a -> a
<> String
": " forall a. [a] -> [a] -> [a]
++ String
detail
  where
  msg :: String
msg = String
"Very inaccurate, too little information"

instance CanGiveUpIfVeryInaccurate Int
instance CanGiveUpIfVeryInaccurate Integer
instance CanGiveUpIfVeryInaccurate Rational
instance CanGiveUpIfVeryInaccurate Double where
  giveUpIfVeryInaccurate :: CN Double -> CN Double
giveUpIfVeryInaccurate CN Double
d
    | forall t. CanTestFinite t => t -> Bool
isFinite CN Double
d = CN Double
d
    | forall t. CanTestNaN t => t -> Bool
isNaN CN Double
d = forall t. NumError -> CN t -> CN t
CN.prependErrorCertain (String -> NumError
CN.NumError String
"NaN") CN Double
d
    | Bool
otherwise = forall t. NumError -> CN t -> CN t
CN.prependErrorCertain (String -> NumError
CN.NumError String
"Inifinity") CN Double
d