{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
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
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"
prettyPrint :: Expr -> Text
prettyPrint :: Expr -> Text
prettyPrint = Int -> Expr -> Text
prettyPrintPrec Int
0