{-# 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
(Int -> Term -> ShowS)
-> (Term -> String) -> ([Term] -> ShowS) -> Show Term
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
(Term -> Term -> Bool) -> (Term -> Term -> Bool) -> Eq Term
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 (BigDecimal -> Term)
-> (Rational -> BigDecimal) -> Rational -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> BigDecimal
forall a. Fractional a => Rational -> a
fromRational

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

-- | The types of (infix) operators
data Op
  = Add
  | Sub
  | Mul
  | Div
  deriving (Int -> Op -> ShowS
[Op] -> ShowS
Op -> String
(Int -> Op -> ShowS)
-> (Op -> String) -> ([Op] -> ShowS) -> Show Op
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
(Op -> Op -> Bool) -> (Op -> Op -> Bool) -> Eq Op
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)

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

-- | Create a leaf 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 (Term -> Expr) -> (Rational -> Term) -> Rational -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Rational -> Term) -> Rational -> Expr)
-> (Integer -> Rational -> Term) -> Integer -> Rational -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Rational -> Term
measured

-- | Create a leaf node and construct the 'Constant' value argument at the same time. Convenience function.
lConstant :: Rational -> Expr
lConstant :: Rational -> Expr
lConstant = Term -> Expr
l (Term -> Expr) -> (Rational -> Term) -> Rational -> Expr
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 ([(Op, Expr)] -> Expr)
-> ([Expr] -> [(Op, Expr)]) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Op] -> [Expr] -> [(Op, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Op -> [Op]
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 ([(Op, Expr)] -> Expr) -> [(Op, Expr)] -> Expr
forall a b. (a -> b) -> a -> b
$ (Op
Add, Expr
x) (Op, Expr) -> [(Op, Expr)] -> [(Op, Expr)]
forall a. a -> [a] -> [a]
: [Op] -> [Expr] -> [(Op, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Op -> [Op]
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 ([(Op, Expr)] -> Expr)
-> ([Expr] -> [(Op, Expr)]) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Op] -> [Expr] -> [(Op, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Op -> [Op]
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 ([(Op, Expr)] -> Expr) -> [(Op, Expr)] -> Expr
forall a b. (a -> b) -> a -> b
$ (Op
Mul, Expr
x) (Op, Expr) -> [(Op, Expr)] -> [(Op, Expr)]
forall a. a -> [a] -> [a]
: [Op] -> [Expr] -> [(Op, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Op -> [Op]
forall a. a -> [a]
repeat Op
Div) [Expr]
xs

-- | Take an 'Expr' to the power of an integer. Equivalent to 'Exp'.
exp :: Expr -> Integer -> Expr
exp :: Expr -> Integer -> Expr
exp = Expr -> Integer -> 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
(Int -> Function -> ShowS)
-> (Function -> String) -> ([Function] -> ShowS) -> Show Function
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
(Function -> Function -> Bool)
-> (Function -> Function -> Bool) -> Eq Function
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)

-- | A datatype to represent (not-yet-evaluated) expressions. Use 'Data.SigFig.Parse.parse' to create such an expression from text.
data Expr
  = -- | Leaf of an expression
    Leaf 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 integer exponent
    Exp Expr Integer
  | -- | Application of a function to an expression argument
    Apply Function Expr
  deriving (Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
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
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
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)