{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- | A module to unparse an expression.
module Data.SigFig.PrettyPrint (prettyPrint) where

import Data.BigDecimal (BigDecimal (..))
import Data.BigDecimal qualified as BD
import Data.SigFig.Types hiding (div)
import Data.SigFig.Util (display, isTerminating)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Real (Ratio(..))

precedence :: Expr -> Int
precedence = \case
  Apply {} -> Int
10
  Literal {} -> Int
11
  Exp {} -> Int
3
  Prec2 {} -> Int
2
  Prec1 {} -> Int
1

-- the only time we don't need parentheses is with leaf or if child is higher precedence

precede :: Int -> Op -> Expr -> Text
precede :: Int -> Op -> Expr -> Text
precede Int
prec Op
Add = (Text
" + " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> Text
prettyPrintPrec Int
prec
precede Int
prec Op
Sub = (Text
" - " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> Text
prettyPrintPrec Int
prec
precede Int
prec Op
Mul = (Text
" * " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> Text
prettyPrintPrec Int
prec
precede Int
prec Op
Div = (Text
" / " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> Text
prettyPrintPrec Int
prec

printTerm :: Term -> Text
printTerm :: Term -> Text
printTerm (Measured Integer
sf BigDecimal
bd) = BigDecimal -> Text
format BigDecimal
bd
  where
    ssf :: Text
ssf = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Integer
sf
    format :: BigDecimal -> Text
    format :: BigDecimal -> Text
format BigDecimal
term' =
      let term :: BigDecimal
term@(BigDecimal Integer
v Natural
s') = BigDecimal -> BigDecimal
BD.nf BigDecimal
term'
          s :: Integer
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
s' :: Integer
          termText :: Text
termText = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ BigDecimal
term
          p :: Integer
p = forall a b. (Integral a, Num b) => a -> b
fromIntegral (BigDecimal -> Natural
BD.precision BigDecimal
term) :: Integer
          rsdp :: Integer
rsdp = Integer
p forall a. Num a => a -> a -> a
- Integer
sf forall a. Num a => a -> a -> a
- Integer
s
          rsd :: Integer
rsd = if Integer
sf forall a. Ord a => a -> a -> Bool
> Integer
p then Integer
0 else Integer
v forall a. Integral a => a -> a -> a
`div` (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
rsdp forall a. Num a => a -> a -> a
+ Integer
s)) forall a. Integral a => a -> a -> a
`mod` Integer
10
       in if Integer
rsd forall a. Eq a => a -> a -> Bool
/= Integer
0 Bool -> Bool -> Bool
|| Integer
rsdp forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& Integer
p forall a. Eq a => a -> a -> Bool
== Integer
1
            then Text
termText
            else
              if Integer
rsdp forall a. Ord a => a -> a -> Bool
>= Integer
1
                then let coef :: BigDecimal
coef = Integer -> Natural -> BigDecimal
BigDecimal Integer
v (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
s forall a. Num a => a -> a -> a
+ (Integer
p forall a. Num a => a -> a -> a
- Integer
1))) in BigDecimal -> Text
format BigDecimal
coef forall a. Semigroup a => a -> a -> a
<> Text
"e" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ Integer
p forall a. Num a => a -> a -> a
- Integer
1)
                else
                  Text
termText
                    forall a. Semigroup a => a -> a -> a
<> (if Integer
s forall a. Ord a => a -> a -> Bool
> Integer
0 then Text
"" else Text
".")
                    forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
sf forall a. Num a => a -> a -> a
- Integer
p) Text
"0"
printTerm (Constant v :: Rational
v@(Integer
a :% Integer
b)) =
  [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$
    if Integer -> Bool
isTerminating Integer
b
      then (forall a. [a] -> [a] -> [a]
++ [Char]
"c") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. BigDecimal -> BigDecimal
BD.nf forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
v
      else [Char]
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Integer
a forall a. [a] -> [a] -> [a]
++ [Char]
"c / " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Integer
b forall a. [a] -> [a] -> [a]
++ [Char]
"c)"

conditionallyAddParens :: Int -> Int -> Text -> Text
conditionallyAddParens :: Int -> Int -> Text -> Text
conditionallyAddParens Int
outer Int
inner Text
t = if Int
inner forall a. Ord a => a -> a -> Bool
> Int
outer then Text
t else Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
")"

printFunc :: Function -> Expr -> Text
printFunc Function
Log10 Expr
x = Text
"log(" forall a. Semigroup a => a -> a -> a
<> Int -> Expr -> Text
prettyPrintPrec Int
0 Expr
x forall a. Semigroup a => a -> a -> a
<> Text
")"
printFunc Function
Antilog10 Expr
x = Text
"exp(" forall a. Semigroup a => a -> a -> a
<> Int -> Expr -> Text
prettyPrintPrec Int
0 Expr
x forall a. Semigroup a => a -> a -> a
<> Text
")"

prettyPrintPrec :: Int -> Expr -> Text
prettyPrintPrec :: Int -> Expr -> Text
prettyPrintPrec Int
prec Expr
e =
  let prec' :: Int
prec' = Expr -> Int
precedence Expr
e
   in case Expr
e of
        Literal Term
n -> Term -> Text
printTerm Term
n
        Prec1 ((Op
_, Expr
x) : [(Op, Expr)]
xs) -> Int -> Int -> Text -> Text
conditionallyAddParens Int
prec Int
prec' forall a b. (a -> b) -> a -> b
$ Int -> Expr -> Text
prettyPrintPrec Int
1 Expr
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ Int -> Op -> Expr -> Text
precede Int
1) [(Op, Expr)]
xs
        Prec2 ((Op
_, Expr
x) : [(Op, Expr)]
xs) -> Int -> Int -> Text -> Text
conditionallyAddParens Int
prec Int
prec' forall a b. (a -> b) -> a -> b
$ Int -> Expr -> Text
prettyPrintPrec Int
2 Expr
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ Int -> Op -> Expr -> Text
precede Int
2) [(Op, Expr)]
xs
        Exp Expr
a Expr
b -> Int -> Int -> Text -> Text
conditionallyAddParens Int
prec Int
prec' forall a b. (a -> b) -> a -> b
$ Int -> Expr -> Text
prettyPrintPrec Int
3 Expr
a forall a. Semigroup a => a -> a -> a
<> Text
" ** " forall a. Semigroup a => a -> a -> a
<> Int -> Expr -> Text
prettyPrintPrec Int
3 Expr
b
        Apply Function
a Expr
b -> Function -> Expr -> Text
printFunc Function
a Expr
b
        Expr
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"ill-formed expression"

-- | Pretty print an expression, adding parentheses where needed. Text emitted from the
-- pretty printer is intended to be able to be re-parsed, into the same expression tree.
--
-- ==== __Examples__
--
-- If you want to create expressions to pretty print, utilize the
-- functions in 'Data.SigFig.Types' like below to make life easier.
--
-- >>> prettyPrint $ lMeasured 3 4.0
-- "4.00"
--
-- >>> prettyPrint $ add [lConstant 3, lMeasured 2 3.5]
-- "3c + 3.5"
--
-- >>> prettyPrint $ add [lConstant 3, mul [lMeasured 2 3.5, lConstant 2.7]]
-- "3c + 3.5 * 2.7c"
--
-- >>> prettyPrint $ mul [lConstant 3, add [lMeasured 2 3.5, lConstant 2.7]]
-- "3c * (3.5 + 2.7c)"
prettyPrint :: Expr -> Text
prettyPrint :: Expr -> Text
prettyPrint = Int -> Expr -> Text
prettyPrintPrec Int
0