{-# Language TemplateHaskell #-}
-- | Defines uncertainty types and functions.
module Language.Drasil.Uncertainty (
  -- * Type
  Uncertainty,
  -- * Class
  HasUncertainty(..),
  -- * Lenses
  uncert, prec,
  -- * Constructors
  uncty, exact,
  -- * Constructor
  defaultUncrt,
  -- * Accessors
  uncVal, uncPrec,
) where

import Control.Lens (Lens', (^.), makeLenses)

import Data.Maybe (fromMaybe)

-- | Something that may contain an uncertainty value and a precision value.
data Uncertainty = Uncert {
  Uncertainty -> Maybe Double
_uncert :: Maybe Double,
  Uncertainty -> Maybe Int
_prec   :: Maybe Int
}
makeLenses ''Uncertainty

-- | HasUncertainty is just a chunk with some uncertainty associated to it.
-- This uncertainty is represented as a decimal value between 0 and 1 (percentage).
class HasUncertainty c where
  -- | Provides the 'Lens' to an 'Uncertainty'.
  unc  :: Lens' c Uncertainty

-- | Smart constructor for values with uncertainty.
uncty :: Double -> Maybe Int -> Uncertainty
uncty :: Double -> Maybe Int -> Uncertainty
uncty u :: Double
u = Maybe Double -> Maybe Int -> Uncertainty
Uncert (Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. (Num a, Ord a) => a -> a
isDecimal Double
u)

-- | Smart constructor for exact values (no uncertainty).
exact :: Uncertainty
exact :: Uncertainty
exact = Maybe Double -> Maybe Int -> Uncertainty
Uncert Maybe Double
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing

-- | Make sure that input is between 0 and 1, and throw an error otherwise.
isDecimal :: (Num a, Ord a) => a -> a
isDecimal :: a -> a
isDecimal 0  =  [Char] -> a
forall a. HasCallStack => [Char] -> a
error "An uncertain quantity cannot be exact (have 0% uncertainty). Reconsider whether your value is exact or uncertain"
isDecimal u :: a
u  =  if (0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
u) Bool -> Bool -> Bool
&& (a
u a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 1) then a
u
                else [Char] -> a
forall a. HasCallStack => [Char] -> a
error "Uncertainty must be between 0 and 1"

-- | The default uncertainty is set to 0.1.
defaultUncrt :: Uncertainty
defaultUncrt :: Uncertainty
defaultUncrt = Double -> Maybe Int -> Uncertainty
uncty 0.1 (Int -> Maybe Int
forall a. a -> Maybe a
Just 0)

-- | Accessor for uncertainty value from something that has an uncertainty.
uncVal :: HasUncertainty x => x -> Double
uncVal :: x -> Double
uncVal u :: x
u = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe 0.0 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ x
u x -> Getting (Maybe Double) x (Maybe Double) -> Maybe Double
forall s a. s -> Getting a s a -> a
^. ((Uncertainty -> Const (Maybe Double) Uncertainty)
-> x -> Const (Maybe Double) x
forall c. HasUncertainty c => Lens' c Uncertainty
unc ((Uncertainty -> Const (Maybe Double) Uncertainty)
 -> x -> Const (Maybe Double) x)
-> ((Maybe Double -> Const (Maybe Double) (Maybe Double))
    -> Uncertainty -> Const (Maybe Double) Uncertainty)
-> Getting (Maybe Double) x (Maybe Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Double -> Const (Maybe Double) (Maybe Double))
-> Uncertainty -> Const (Maybe Double) Uncertainty
Lens' Uncertainty (Maybe Double)
uncert)

-- | Accessor for precision value from something that has an uncertainty.
uncPrec :: HasUncertainty x => x -> Maybe Int
uncPrec :: x -> Maybe Int
uncPrec u :: x
u = x
u x -> Getting (Maybe Int) x (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. ((Uncertainty -> Const (Maybe Int) Uncertainty)
-> x -> Const (Maybe Int) x
forall c. HasUncertainty c => Lens' c Uncertainty
unc ((Uncertainty -> Const (Maybe Int) Uncertainty)
 -> x -> Const (Maybe Int) x)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> Uncertainty -> Const (Maybe Int) Uncertainty)
-> Getting (Maybe Int) x (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> Uncertainty -> Const (Maybe Int) Uncertainty
Lens' Uncertainty (Maybe Int)
prec)