-- | Defines functions to print on plain files (for .txt, .log, etc.).
module Language.Drasil.Plain.Print (
  -- * Types
  Linearity(..),
  -- * Functions
  exprDoc, codeExprDoc, sentenceDoc, symbolDoc, unitDoc, showSymb,
  showHasSymbImpl
) where

import Database.Drasil (ChunkDB)
import Language.Drasil (Sentence, Special(..), Stage(..), Symbol, USymb(..))
import qualified Language.Drasil as L (Expr, HasSymbol(..))
import qualified Language.Drasil.CodeExpr as C (CodeExpr)
import Language.Drasil.Printing.AST (Expr(..), Spec(..), Ops(..), Fence(..), 
  OverSymb(..), Fonts(..), Spacing(..), LinkType(..))
import Language.Drasil.Printing.Import (expr, codeExpr, spec, symbol)
import Language.Drasil.Printing.PrintingInformation (PrintingConfiguration(..), 
  PrintingInformation(..), Notation(Scientific))

import Utils.Drasil (toPlainName)

import Prelude hiding ((<>))
import Data.List (partition)
import Text.PrettyPrint.HughesPJ (Doc, (<>), (<+>), brackets, comma, double, 
  doubleQuotes, empty, hcat, hsep, integer, parens, punctuate, space, text, 
  vcat, render)

-- | Data is either linear or not.
data Linearity = Linear | Nonlinear

-- | Simple printing configuration is scientific.
plainConfiguration :: PrintingConfiguration
plainConfiguration :: PrintingConfiguration
plainConfiguration = Notation -> PrintingConfiguration
PC Notation
Scientific

-- | Create expressions for a document in 'Doc' format.
exprDoc :: ChunkDB -> Stage -> Linearity -> L.Expr -> Doc
exprDoc :: ChunkDB -> Stage -> Linearity -> Expr -> Doc
exprDoc db :: ChunkDB
db st :: Stage
st f :: Linearity
f e :: Expr
e = Linearity -> Expr -> Doc
pExprDoc Linearity
f (Expr -> PrintingInformation -> Expr
expr Expr
e (ChunkDB -> Stage -> PrintingConfiguration -> PrintingInformation
PI ChunkDB
db Stage
st PrintingConfiguration
plainConfiguration))

-- | Create code expressions for a document in 'Doc' format.
codeExprDoc :: ChunkDB -> Stage -> Linearity -> C.CodeExpr -> Doc
codeExprDoc :: ChunkDB -> Stage -> Linearity -> CodeExpr -> Doc
codeExprDoc db :: ChunkDB
db st :: Stage
st f :: Linearity
f e :: CodeExpr
e = Linearity -> Expr -> Doc
pExprDoc Linearity
f (CodeExpr -> PrintingInformation -> Expr
codeExpr CodeExpr
e (ChunkDB -> Stage -> PrintingConfiguration -> PrintingInformation
PI ChunkDB
db Stage
st PrintingConfiguration
plainConfiguration))

-- | Create sentences for a document in 'Doc' format.
sentenceDoc :: ChunkDB -> Stage -> Linearity -> Sentence -> Doc
sentenceDoc :: ChunkDB -> Stage -> Linearity -> Sentence -> Doc
sentenceDoc db :: ChunkDB
db st :: Stage
st f :: Linearity
f s :: Sentence
s = Linearity -> Spec -> Doc
specDoc Linearity
f (PrintingInformation -> Sentence -> Spec
spec (ChunkDB -> Stage -> PrintingConfiguration -> PrintingInformation
PI ChunkDB
db Stage
st PrintingConfiguration
plainConfiguration) Sentence
s)

-- | Create symbols for a document in 'Doc' format.
symbolDoc :: Symbol -> Doc
symbolDoc :: Symbol -> Doc
symbolDoc s :: Symbol
s = Linearity -> Expr -> Doc
pExprDoc Linearity
Linear (Symbol -> Expr
symbol Symbol
s)

-- | Helper for printing expressions in 'Doc' format. Display format of an expression may change regarding the 'Linearity'.
pExprDoc :: Linearity -> Expr -> Doc
pExprDoc :: Linearity -> Expr -> Doc
pExprDoc _ (Dbl d :: Double
d) = Double -> Doc
double Double
d
pExprDoc _ (Int i :: Integer
i) = Integer -> Doc
integer Integer
i
pExprDoc _ (Str s :: String
s) = String -> Doc
text String
s
pExprDoc f :: Linearity
f (Case cs :: [(Expr, Expr)]
cs) = Linearity -> [(Expr, Expr)] -> Doc
caseDoc Linearity
f [(Expr, Expr)]
cs
pExprDoc f :: Linearity
f (Mtx rs :: [[Expr]]
rs) = Linearity -> [[Expr]] -> Doc
mtxDoc Linearity
f [[Expr]]
rs
pExprDoc f :: Linearity
f (Row es :: [Expr]
es) = [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Expr -> Doc) -> [Expr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Linearity -> Expr -> Doc
pExprDoc Linearity
f) [Expr]
es
pExprDoc _ (Ident s :: String
s) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
toPlainName String
s
pExprDoc _ (Label s :: String
s) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
toPlainName String
s
pExprDoc _ (Spec s :: Special
s) = Special -> Doc
specialDoc Special
s
pExprDoc f :: Linearity
f (Sub e :: Expr
e) = String -> Doc
text "_" Doc -> Doc -> Doc
<> Linearity -> Expr -> Doc
pExprDoc Linearity
f Expr
e
pExprDoc f :: Linearity
f (Sup e :: Expr
e) = String -> Doc
text "^" Doc -> Doc -> Doc
<> Linearity -> Expr -> Doc
pExprDoc Linearity
f Expr
e
pExprDoc _ (MO o :: Ops
o) = Ops -> Doc
opsDoc Ops
o
pExprDoc f :: Linearity
f (Over Hat e :: Expr
e) = Linearity -> Expr -> Doc
pExprDoc Linearity
f Expr
e Doc -> Doc -> Doc
<> String -> Doc
text "_hat"
pExprDoc f :: Linearity
f (Fenced l :: Fence
l r :: Fence
r e :: Expr
e) = Fence -> Doc
fenceDocL Fence
l Doc -> Doc -> Doc
<> Linearity -> Expr -> Doc
pExprDoc Linearity
f Expr
e Doc -> Doc -> Doc
<> Fence -> Doc
fenceDocR Fence
r 
pExprDoc f :: Linearity
f (Font Bold e :: Expr
e) = Linearity -> Expr -> Doc
pExprDoc Linearity
f Expr
e Doc -> Doc -> Doc
<> String -> Doc
text "_vect"
pExprDoc f :: Linearity
f (Font Emph e :: Expr
e) = String -> Doc
text "_" Doc -> Doc -> Doc
<> Linearity -> Expr -> Doc
pExprDoc Linearity
f Expr
e Doc -> Doc -> Doc
<> String -> Doc
text "_"
pExprDoc f :: Linearity
f (Div n :: Expr
n d :: Expr
d) = Doc -> Doc
parens (Linearity -> Expr -> Doc
pExprDoc Linearity
f Expr
n) Doc -> Doc -> Doc
<> String -> Doc
text "/" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Linearity -> Expr -> Doc
pExprDoc Linearity
f Expr
d)
pExprDoc f :: Linearity
f (Sqrt e :: Expr
e) = String -> Doc
text "sqrt" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Linearity -> Expr -> Doc
pExprDoc Linearity
f Expr
e)
pExprDoc _ (Spc Thin) = Doc
space

-- | Helper for printing sentences ('Spec's) in 'Doc' format.
specDoc :: Linearity -> Spec -> Doc
specDoc :: Linearity -> Spec -> Doc
specDoc f :: Linearity
f (E e :: Expr
e) = Linearity -> Expr -> Doc
pExprDoc Linearity
f Expr
e
specDoc _ (S s :: String
s) = String -> Doc
text String
s
specDoc _ (Sp s :: Special
s) = Special -> Doc
specialDoc Special
s
specDoc f :: Linearity
f (Ref (Cite2 n :: Spec
n) r :: String
r _) = Linearity -> Spec -> Doc
specDoc Linearity
f Spec
n Doc -> Doc -> Doc
<+> String -> Doc
text ("Ref: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r)
specDoc f :: Linearity
f (Ref _ r :: String
r s :: Spec
s) = Linearity -> Spec -> Doc
specDoc Linearity
f Spec
s Doc -> Doc -> Doc
<+> String -> Doc
text ("Ref: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r) --may need to change?
specDoc f :: Linearity
f (s1 :: Spec
s1 :+: s2 :: Spec
s2) = Linearity -> Spec -> Doc
specDoc Linearity
f Spec
s1 Doc -> Doc -> Doc
<> Linearity -> Spec -> Doc
specDoc Linearity
f Spec
s2
specDoc _ EmptyS = Doc
empty
specDoc f :: Linearity
f (Quote s :: Spec
s) = Doc -> Doc
doubleQuotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Linearity -> Spec -> Doc
specDoc Linearity
f Spec
s
specDoc Nonlinear HARDNL = String -> Doc
text "\n"
specDoc Linear HARDNL = String -> Doc
forall a. HasCallStack => String -> a
error "HARDNL encountered in attempt to format linearly"

-- | Helper for printing units in 'Doc' format.
unitDoc :: Linearity -> USymb -> Doc
unitDoc :: Linearity -> USymb -> Doc
unitDoc f :: Linearity
f (US us :: [(Symbol, Integer)]
us) = [(Symbol, Integer)] -> [(Symbol, Integer)] -> Doc
formatu [(Symbol, Integer)]
t [(Symbol, Integer)]
b
  where
  (t :: [(Symbol, Integer)]
t,b :: [(Symbol, Integer)]
b) = ((Symbol, Integer) -> Bool)
-> [(Symbol, Integer)]
-> ([(Symbol, Integer)], [(Symbol, Integer)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Integer -> Bool)
-> ((Symbol, Integer) -> Integer) -> (Symbol, Integer) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol, Integer) -> Integer
forall a b. (a, b) -> b
snd) [(Symbol, Integer)]
us
  formatu :: [(Symbol,Integer)] -> [(Symbol,Integer)] -> Doc
  formatu :: [(Symbol, Integer)] -> [(Symbol, Integer)] -> Doc
formatu [] l :: [(Symbol, Integer)]
l = [(Symbol, Integer)] -> Doc
line [(Symbol, Integer)]
l
  formatu l :: [(Symbol, Integer)]
l [] = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Symbol, Integer) -> Doc) -> [(Symbol, Integer)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol, Integer) -> Doc
pow [(Symbol, Integer)]
l
  formatu nu :: [(Symbol, Integer)]
nu de :: [(Symbol, Integer)]
de = [(Symbol, Integer)] -> Doc
line [(Symbol, Integer)]
nu Doc -> Doc -> Doc
<> String -> Doc
text "/" Doc -> Doc -> Doc
<> [(Symbol, Integer)] -> Doc
line (((Symbol, Integer) -> (Symbol, Integer))
-> [(Symbol, Integer)] -> [(Symbol, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map (\(s :: Symbol
s,i :: Integer
i) -> (Symbol
s,-Integer
i)) [(Symbol, Integer)]
de)
  line :: [(Symbol,Integer)] -> Doc
  line :: [(Symbol, Integer)] -> Doc
line []  = Doc
empty
  line [x :: (Symbol, Integer)
x] = (Symbol, Integer) -> Doc
pow (Symbol, Integer)
x
  line l :: [(Symbol, Integer)]
l   = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Symbol, Integer) -> Doc) -> [(Symbol, Integer)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol, Integer) -> Doc
pow [(Symbol, Integer)]
l
  pow :: (Symbol,Integer) -> Doc
  pow :: (Symbol, Integer) -> Doc
pow (x :: Symbol
x,1) = Linearity -> Expr -> Doc
pExprDoc Linearity
f (Expr -> Doc) -> Expr -> Doc
forall a b. (a -> b) -> a -> b
$ Symbol -> Expr
symbol Symbol
x
  pow (x :: Symbol
x,p :: Integer
p) = Linearity -> Expr -> Doc
pExprDoc Linearity
f (Symbol -> Expr
symbol Symbol
x) Doc -> Doc -> Doc
<> String -> Doc
text "^" Doc -> Doc -> Doc
<> Integer -> Doc
integer Integer
p

-- | Helper for printing multicase expressions differently based on linearity.
caseDoc :: Linearity -> [(Expr, Expr)] -> Doc
caseDoc :: Linearity -> [(Expr, Expr)] -> Doc
caseDoc Linear cs :: [(Expr, Expr)]
cs = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ((Expr, Expr) -> Doc) -> [(Expr, Expr)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(e :: Expr
e,c :: Expr
c) -> Linearity -> Expr -> Doc
pExprDoc Linearity
Linear Expr
c
  Doc -> Doc -> Doc
<+> String -> Doc
text "=>" Doc -> Doc -> Doc
<+> Linearity -> Expr -> Doc
pExprDoc Linearity
Linear Expr
e) [(Expr, Expr)]
cs
caseDoc Nonlinear cs :: [(Expr, Expr)]
cs = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Expr, Expr) -> Doc) -> [(Expr, Expr)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(e :: Expr
e,c :: Expr
c) -> Linearity -> Expr -> Doc
pExprDoc Linearity
Nonlinear Expr
e Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> 
  Linearity -> Expr -> Doc
pExprDoc Linearity
Nonlinear Expr
c) [(Expr, Expr)]
cs

-- | Helper for printing matrices.
mtxDoc :: Linearity -> [[Expr]] -> Doc
mtxDoc :: Linearity -> [[Expr]] -> Doc
mtxDoc Linear rs :: [[Expr]]
rs = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ([Expr] -> Doc) -> [[Expr]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
brackets (Doc -> Doc) -> ([Expr] -> Doc) -> [Expr] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Expr] -> [Doc]) -> [Expr] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Doc) -> [Expr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Linearity -> Expr -> Doc
pExprDoc 
  Linearity
Linear)) [[Expr]]
rs
mtxDoc Nonlinear rs :: [[Expr]]
rs = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ([Expr] -> Doc) -> [[Expr]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Expr] -> [Doc]) -> [Expr] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Doc) -> [Expr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Linearity -> Expr -> Doc
pExprDoc Linearity
Nonlinear)) [[Expr]]
rs

-- TODO: Double check that this is valid in all output languages
-- | Helper for printing special characters (for degrees and partial derivatives).
specialDoc :: Special -> Doc
specialDoc :: Special -> Doc
specialDoc Circle  = String -> Doc
text "degree"
specialDoc Partial = String -> Doc
text "partial"

-- | Helper for printing operators.
opsDoc :: Ops -> Doc
opsDoc :: Ops -> Doc
opsDoc IsIn = String -> Doc
text " is in "
opsDoc Integer = String -> Doc
text "integers"
opsDoc Real = String -> Doc
text "real numbers"
opsDoc Rational = String -> Doc
text "rational numbers"
opsDoc Natural = String -> Doc
text "natural numbers"
opsDoc Boolean = String -> Doc
text "booleans"
opsDoc Comma = Doc
comma Doc -> Doc -> Doc
<> Doc
space
opsDoc Prime = String -> Doc
text "'"
opsDoc Log = String -> Doc
text "log"
opsDoc Ln = String -> Doc
text "ln"
opsDoc Sin = String -> Doc
text "sin"
opsDoc Cos = String -> Doc
text "cos"
opsDoc Tan = String -> Doc
text "tan"
opsDoc Sec = String -> Doc
text "sec"
opsDoc Csc = String -> Doc
text "csc"
opsDoc Cot = String -> Doc
text "cot"
opsDoc Arcsin = String -> Doc
text "arcsin"
opsDoc Arccos = String -> Doc
text "arccos"
opsDoc Arctan = String -> Doc
text "arctan"
opsDoc Not = String -> Doc
text "!"
opsDoc Dim = String -> Doc
text "dim"
opsDoc Exp = String -> Doc
text "exp"
opsDoc Neg = String -> Doc
text "-"
opsDoc Cross = String -> Doc
text " cross "
opsDoc Dot = String -> Doc
text " dot "
opsDoc Eq = String -> Doc
text " == "
opsDoc NEq = String -> Doc
text " != "
opsDoc Lt = String -> Doc
text " < "
opsDoc Gt = String -> Doc
text " > "
opsDoc LEq = String -> Doc
text " <= "
opsDoc GEq = String -> Doc
text " >= "
opsDoc Impl = String -> Doc
text " => "
opsDoc Iff = String -> Doc
text "iff "
opsDoc Subt = String -> Doc
text " - "
opsDoc And = String -> Doc
text " && "
opsDoc Or = String -> Doc
text " || "
opsDoc Add = String -> Doc
text " + "
opsDoc Mul = String -> Doc
text " * "
opsDoc Summ = String -> Doc
text "sum "
opsDoc Inte = String -> Doc
text "integral "
opsDoc Prod = String -> Doc
text "product "
opsDoc Point = String -> Doc
text "."
opsDoc Perc = String -> Doc
text "%"
opsDoc LArrow = String -> Doc
text " <- "
opsDoc RArrow = String -> Doc
text " -> "
opsDoc ForAll = String -> Doc
text " ForAll "

-- | Helper for printing the left side of some characters "(, {, \\|, |".
fenceDocL :: Fence -> Doc
fenceDocL :: Fence -> Doc
fenceDocL Paren = String -> Doc
text "("
fenceDocL Curly = String -> Doc
text "{"
fenceDocL Norm = String -> Doc
text "\\|"
fenceDocL Abs = String -> Doc
text "|"

-- | Helper for printing the right side of some characters "), }, \\|, |".
fenceDocR :: Fence -> Doc
fenceDocR :: Fence -> Doc
fenceDocR Paren = String -> Doc
text ")"
fenceDocR Curly = String -> Doc
text "}"
fenceDocR Norm = String -> Doc
text "\\|"
fenceDocR Abs = String -> Doc
text "|"

-- | Helper for printing Symbols
showSymb :: Symbol -> String
showSymb :: Symbol -> String
showSymb a :: Symbol
a = Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Symbol -> Doc
symbolDoc Symbol
a

-- | Helper for printing a HasSymbol in Implementation Stage
showHasSymbImpl :: L.HasSymbol x => x -> String
showHasSymbImpl :: x -> String
showHasSymbImpl x :: x
x = Symbol -> String
showSymb (x -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
L.symbol x
x Stage
Implementation)