-- |
-- Module: Symtegration.Symbolic.Haskell
-- Description: Converts a symbolic representation of a mathematical expression into equivalent Haskell code.
-- Copyright: Copyright 2024 Yoo Chung
-- License: Apache-2.0
-- Maintainer: dev@chungyc.org
--
-- Support for converting symbolic representations of mathematical expressions
-- into equivalent Haskell code.
module Symtegration.Symbolic.Haskell
  ( toHaskell,

    -- * Support functions
    getUnaryFunctionText,
    getBinaryFunctionText,
  )
where

import Data.Text
import Symtegration.Symbolic
import TextShow (showt)

-- $setup
-- >>> import Symtegration.Symbolic

-- | Converts an 'Expression' into an equivalent Haskell expression.
--
-- >>> toHaskell $ BinaryApply Add (Number 1) (Number 3)
-- "1 + 3"
-- >>> toHaskell $ 1 + 3
-- "1 + 3"
--
-- Symbols are included without quotation.
--
-- >>> toHaskell $ ("x" + "y") * 4
-- "(x + y) * 4"
toHaskell :: Expression -> Text
toHaskell :: Expression -> Text
toHaskell (Number Integer
n) = Integer -> Text
forall a. TextShow a => a -> Text
showt Integer
n
toHaskell (Symbol Text
t) = Text
t
toHaskell (UnaryApply UnaryFunction
fun Expression
x) = Text
funcText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
asArg Expression
x
  where
    funcText :: Text
funcText = UnaryFunction -> Text
getUnaryFunctionText UnaryFunction
fun
toHaskell (LogBase' Expression
x Expression
y) = Text
funcText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
asArg Expression
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
asArg Expression
y
  where
    funcText :: Text
funcText = BinaryFunction -> Text
getBinaryFunctionText BinaryFunction
LogBase
toHaskell (Expression
x :+: Expression
y) = Expression -> Text
asAddArg Expression
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" + " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
asAddArg Expression
y
toHaskell (Expression
x :-: y :: Expression
y@(Expression
_ :+: Expression
_)) = Expression -> Text
asAddArg Expression
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
asArg Expression
y
toHaskell (Expression
x :-: y :: Expression
y@(Expression
_ :-: Expression
_)) = Expression -> Text
asAddArg Expression
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
asArg Expression
y
toHaskell (Expression
x :-: Expression
y) = Expression -> Text
asAddArg Expression
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
asAddArg Expression
y
toHaskell (Expression
x :*: Expression
y) = Expression -> Text
asMultiplyArg Expression
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" * " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
asMultiplyArg Expression
y
toHaskell (BinaryApply BinaryFunction
op Expression
x Expression
y) = Expression -> Text
asArg Expression
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
opText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
asArg Expression
y
  where
    opText :: Text
opText = BinaryFunction -> Text
getBinaryFunctionText BinaryFunction
op

-- | Converts an 'Expression' to Haskell code appropriate for use as an argument.
-- In other words, show numbers and symbols as is, while surrounding everything
-- else in parentheses.
asArg :: Expression -> Text
asArg :: Expression -> Text
asArg x :: Expression
x@(Number Integer
n)
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Expression -> Text
toHaskell Expression
x
  | Bool
otherwise = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
toHaskell Expression
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
asArg x :: Expression
x@(Symbol Text
_) = Expression -> Text
toHaskell Expression
x
asArg Expression
x = Text -> Text
par (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expression -> Text
toHaskell Expression
x

-- | Converts an 'Expression' to an argument appropriate for addition.
asAddArg :: Expression -> Text
asAddArg :: Expression -> Text
asAddArg x :: Expression
x@(Number Integer
_) = Expression -> Text
asArg Expression
x
asAddArg x :: Expression
x@(Symbol Text
_) = Expression -> Text
asArg Expression
x
-- No operation has lower precedence than addition,
-- and addition is commutative, so no parentheses are needed.
asAddArg Expression
x = Expression -> Text
toHaskell Expression
x

-- | Converts an 'Expression' to an argument appropriate for multiplication.
asMultiplyArg :: Expression -> Text
asMultiplyArg :: Expression -> Text
asMultiplyArg x :: Expression
x@(Number Integer
_) = Expression -> Text
asArg Expression
x
asMultiplyArg x :: Expression
x@(Symbol Text
_) = Expression -> Text
asArg Expression
x
asMultiplyArg x :: Expression
x@(Expression
_ :+: Expression
_) = Text -> Text
par (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expression -> Text
toHaskell Expression
x
asMultiplyArg x :: Expression
x@(Expression
_ :-: Expression
_) = Text -> Text
par (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expression -> Text
toHaskell Expression
x
-- No other operation has lower precedence than multiplication,
-- and multiplication is commutative, so no parentheses are needed.
asMultiplyArg Expression
x = Expression -> Text
toHaskell Expression
x

-- | Surrounds text by parentheses.
par :: Text -> Text
par :: Text -> Text
par Text
s = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | Returns the corresponding Haskell function name.
getUnaryFunctionText :: UnaryFunction -> Text
getUnaryFunctionText :: UnaryFunction -> Text
getUnaryFunctionText UnaryFunction
Negate = Text
"negate"
getUnaryFunctionText UnaryFunction
Abs = Text
"abs"
getUnaryFunctionText UnaryFunction
Signum = Text
"signum"
getUnaryFunctionText UnaryFunction
Exp = Text
"exp"
getUnaryFunctionText UnaryFunction
Log = Text
"log"
getUnaryFunctionText UnaryFunction
Sqrt = Text
"sqrt"
getUnaryFunctionText UnaryFunction
Sin = Text
"sin"
getUnaryFunctionText UnaryFunction
Cos = Text
"cos"
getUnaryFunctionText UnaryFunction
Tan = Text
"tan"
getUnaryFunctionText UnaryFunction
Asin = Text
"asin"
getUnaryFunctionText UnaryFunction
Acos = Text
"acos"
getUnaryFunctionText UnaryFunction
Atan = Text
"atan"
getUnaryFunctionText UnaryFunction
Sinh = Text
"sinh"
getUnaryFunctionText UnaryFunction
Cosh = Text
"cosh"
getUnaryFunctionText UnaryFunction
Tanh = Text
"tanh"
getUnaryFunctionText UnaryFunction
Asinh = Text
"asinh"
getUnaryFunctionText UnaryFunction
Acosh = Text
"acosh"
getUnaryFunctionText UnaryFunction
Atanh = Text
"atanh"

-- | Returns the corresponding Haskell function name.
--
-- For binary operators, it will be the infix form.
-- In other words, @"+"@ will be returned for 'Add', not @"(+)"@.
getBinaryFunctionText :: BinaryFunction -> Text
getBinaryFunctionText :: BinaryFunction -> Text
getBinaryFunctionText BinaryFunction
Add = Text
"+"
getBinaryFunctionText BinaryFunction
Multiply = Text
"*"
getBinaryFunctionText BinaryFunction
Subtract = Text
"-"
getBinaryFunctionText BinaryFunction
Divide = Text
"/"
getBinaryFunctionText BinaryFunction
Power = Text
"**"
getBinaryFunctionText BinaryFunction
LogBase = Text
"logBase"