{-# LANGUAGE ImportQualifiedPost #-}

-- |
-- Basic types and convenience functions for constructing your own terms and expression trees.
module Data.SigFig.Types
  ( Term (..),
    Op (..),
    Expr (..),
    Function (..),

    -- * Creating Terms and Expression Trees
    measured,
    constant,
    l,
    lMeasured,
    lConstant,

    -- * Building and Combining Expression Trees
    add,
    sub,
    mul,
    div,
    exp,
    apply,
  )
where

import Data.BigDecimal (BigDecimal (..))
import Data.BigDecimal qualified as BD
import Prelude hiding (div, exp)

-- | The basic datatype to represent measurements, constant terms, and evaluation results
data Term
  = -- | A measured value with a finite number of significant figures and an associated value
    Measured {Term -> Integer
numSigFigs :: Integer, Term -> BigDecimal
value :: BigDecimal}
  | -- | A constant value with infinite significant figures
    Constant Rational
  deriving (Int -> Term -> ShowS
[Term] -> ShowS
Term -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Term] -> ShowS
$cshowList :: [Term] -> ShowS
show :: Term -> String
$cshow :: Term -> String
showsPrec :: Int -> Term -> ShowS
$cshowsPrec :: Int -> Term -> ShowS
Show, Term -> Term -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Term -> Term -> Bool
$c/= :: Term -> Term -> Bool
== :: Term -> Term -> Bool
$c== :: Term -> Term -> Bool
Eq)

-- | Create a measured value
measured :: Integer -> Rational -> Term
measured :: Integer -> Rational -> Term
measured Integer
sf = Integer -> BigDecimal -> Term
Measured Integer
sf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational

-- | Create a constant value
constant :: Rational -> Term
constant :: Rational -> Term
constant = Rational -> Term
Constant

toConstant :: Term -> Term
toConstant :: Term -> Term
toConstant (Measured Integer
_ BigDecimal
bd) = Rational -> Term
Constant forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational BigDecimal
bd
toConstant Term
a = Term
a

-- | The types of (infix) operators
data Op
  = Add
  | Sub
  | Mul
  | Div
  deriving (Int -> Op -> ShowS
[Op] -> ShowS
Op -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Op] -> ShowS
$cshowList :: [Op] -> ShowS
show :: Op -> String
$cshow :: Op -> String
showsPrec :: Int -> Op -> ShowS
$cshowsPrec :: Int -> Op -> ShowS
Show, Op -> Op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Op -> Op -> Bool
$c/= :: Op -> Op -> Bool
== :: Op -> Op -> Bool
$c== :: Op -> Op -> Bool
Eq, Op
forall a. a -> a -> Bounded a
maxBound :: Op
$cmaxBound :: Op
minBound :: Op
$cminBound :: Op
Bounded, Int -> Op
Op -> Int
Op -> [Op]
Op -> Op
Op -> Op -> [Op]
Op -> Op -> Op -> [Op]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Op -> Op -> Op -> [Op]
$cenumFromThenTo :: Op -> Op -> Op -> [Op]
enumFromTo :: Op -> Op -> [Op]
$cenumFromTo :: Op -> Op -> [Op]
enumFromThen :: Op -> Op -> [Op]
$cenumFromThen :: Op -> Op -> [Op]
enumFrom :: Op -> [Op]
$cenumFrom :: Op -> [Op]
fromEnum :: Op -> Int
$cfromEnum :: Op -> Int
toEnum :: Int -> Op
$ctoEnum :: Int -> Op
pred :: Op -> Op
$cpred :: Op -> Op
succ :: Op -> Op
$csucc :: Op -> Op
Enum)

-- | Create a literal node out of a term, like a "singleton".
l :: Term -> Expr
l :: Term -> Expr
l = Term -> Expr
Literal

-- | Create a literal node and construct the 'Measured' value argument at the same time. Convenience function.
lMeasured :: Integer -> Rational -> Expr
lMeasured :: Integer -> Rational -> Expr
lMeasured = (Term -> Expr
l forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Rational -> Term
measured

-- | Create a literal node and construct the 'Constant' value argument at the same time. Convenience function.
lConstant :: Rational -> Expr
lConstant :: Rational -> Expr
lConstant = Term -> Expr
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Term
constant

-- | Add together a list of 'Expr's and create a new 'Expr'.
--
-- @add a b c@ is similar in idea to @a + b + c@.
add :: [Expr] -> Expr
add :: [Expr] -> Expr
add = [(Op, Expr)] -> Expr
Prec1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat Op
Add)

-- | "Subtract together" a list of 'Expr's and create a new 'Expr'.
--
-- @sub a b c@ is similar in idea to @a - b - c@.
sub :: [Expr] -> Expr
sub :: [Expr] -> Expr
sub [] = [(Op, Expr)] -> Expr
Prec1 []
sub (Expr
x : [Expr]
xs) = [(Op, Expr)] -> Expr
Prec1 forall a b. (a -> b) -> a -> b
$ (Op
Add, Expr
x) forall a. a -> [a] -> [a]
: forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat Op
Sub) [Expr]
xs

-- | multiply together a list of 'Expr's and create a new 'Expr'.
--
-- @mul a b c@ is similar in idea to @a * b * c@.
mul :: [Expr] -> Expr
mul :: [Expr] -> Expr
mul = [(Op, Expr)] -> Expr
Prec2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat Op
Mul)

-- | "Divide together" a list of 'Expr's and create a new 'Expr'.
--
-- @div a b c@ is similar in idea to @a \/ b \/ c@.
div :: [Expr] -> Expr
div :: [Expr] -> Expr
div [] = [(Op, Expr)] -> Expr
Prec2 []
div (Expr
x : [Expr]
xs) = [(Op, Expr)] -> Expr
Prec2 forall a b. (a -> b) -> a -> b
$ (Op
Mul, Expr
x) forall a. a -> [a] -> [a]
: forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat Op
Div) [Expr]
xs

-- | Take an 'Expr' to the power of an integer. Equivalent to 'Exp'.
exp :: Expr -> Expr -> Expr
exp :: Expr -> Expr -> Expr
exp = Expr -> Expr -> Expr
Exp

-- | Apply a function to an 'Expr'. Equivalent to 'Apply'.
apply :: Function -> Expr -> Expr
apply :: Function -> Expr -> Expr
apply = Function -> Expr -> Expr
Apply

-- | A datatype representing the supported functions.
data Function
  = -- | The function @log()@ in expressions.
    Log10
  | -- | The function @exp()@ in expressions.
    Antilog10
  deriving (Int -> Function -> ShowS
[Function] -> ShowS
Function -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Function] -> ShowS
$cshowList :: [Function] -> ShowS
show :: Function -> String
$cshow :: Function -> String
showsPrec :: Int -> Function -> ShowS
$cshowsPrec :: Int -> Function -> ShowS
Show, Function -> Function -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Function -> Function -> Bool
$c/= :: Function -> Function -> Bool
== :: Function -> Function -> Bool
$c== :: Function -> Function -> Bool
Eq, Function
forall a. a -> a -> Bounded a
maxBound :: Function
$cmaxBound :: Function
minBound :: Function
$cminBound :: Function
Bounded, Int -> Function
Function -> Int
Function -> [Function]
Function -> Function
Function -> Function -> [Function]
Function -> Function -> Function -> [Function]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Function -> Function -> Function -> [Function]
$cenumFromThenTo :: Function -> Function -> Function -> [Function]
enumFromTo :: Function -> Function -> [Function]
$cenumFromTo :: Function -> Function -> [Function]
enumFromThen :: Function -> Function -> [Function]
$cenumFromThen :: Function -> Function -> [Function]
enumFrom :: Function -> [Function]
$cenumFrom :: Function -> [Function]
fromEnum :: Function -> Int
$cfromEnum :: Function -> Int
toEnum :: Int -> Function
$ctoEnum :: Int -> Function
pred :: Function -> Function
$cpred :: Function -> Function
succ :: Function -> Function
$csucc :: Function -> Function
Enum)

-- | A datatype to represent (not-yet-evaluated) expressions. Use 'Data.SigFig.Parse.parse' to create such an expression from text.
data Expr
  = -- | Literal term
    Literal Term
  | -- | Operation of "Precedence 1": addition and subtraction
    Prec1 [(Op, Expr)]
  | -- | Operation of "Precedence 2": multiplication and division
    Prec2 [(Op, Expr)]
  | -- | Exponentiation with a constant exponent
    Exp Expr Expr
  | -- | Application of a function to an expression argument
    Apply Function Expr
  deriving (Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show, Expr -> Expr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq)