-- | Defines functions to print on plain files (for .txt, .log, etc.).
module Language.Drasil.Plain.Print (
  -- * Types
  SingleLine(..),
  -- * 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.Development 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 SingleLine = OneLine | MultiLine

-- | 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 -> SingleLine -> L.Expr -> Doc
exprDoc :: ChunkDB -> Stage -> SingleLine -> Expr -> Doc
exprDoc ChunkDB
db Stage
st SingleLine
f Expr
e = SingleLine -> Expr -> Doc
pExprDoc SingleLine
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 -> SingleLine -> C.CodeExpr -> Doc
codeExprDoc :: ChunkDB -> Stage -> SingleLine -> CodeExpr -> Doc
codeExprDoc ChunkDB
db Stage
st SingleLine
f CodeExpr
e = SingleLine -> Expr -> Doc
pExprDoc SingleLine
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 -> SingleLine -> Sentence -> Doc
sentenceDoc :: ChunkDB -> Stage -> SingleLine -> Sentence -> Doc
sentenceDoc ChunkDB
db Stage
st SingleLine
f Sentence
s = SingleLine -> Spec -> Doc
specDoc SingleLine
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 Symbol
s = SingleLine -> Expr -> Doc
pExprDoc SingleLine
OneLine (Symbol -> Expr
symbol Symbol
s)

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

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

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

-- | Helper for printing multicase expressions differently based on linearity (SingleLine).
caseDoc :: SingleLine -> [(Expr, Expr)] -> Doc
caseDoc :: SingleLine -> [(Expr, Expr)] -> Doc
caseDoc SingleLine
OneLine [(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 (\(Expr
e,Expr
c) -> SingleLine -> Expr -> Doc
pExprDoc SingleLine
OneLine Expr
c
  Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>" Doc -> Doc -> Doc
<+> SingleLine -> Expr -> Doc
pExprDoc SingleLine
OneLine Expr
e) [(Expr, Expr)]
cs
caseDoc SingleLine
MultiLine [(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 (\(Expr
e,Expr
c) -> SingleLine -> Expr -> Doc
pExprDoc SingleLine
MultiLine Expr
e Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> 
  SingleLine -> Expr -> Doc
pExprDoc SingleLine
MultiLine Expr
c) [(Expr, Expr)]
cs

-- | Helper for printing matrices.
mtxDoc :: SingleLine -> [[Expr]] -> Doc
mtxDoc :: SingleLine -> [[Expr]] -> Doc
mtxDoc SingleLine
OneLine [[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 (SingleLine -> Expr -> Doc
pExprDoc 
  SingleLine
OneLine)) [[Expr]]
rs
mtxDoc SingleLine
MultiLine [[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 (SingleLine -> Expr -> Doc
pExprDoc SingleLine
MultiLine)) [[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 Special
Circle  = String -> Doc
text String
"degree"

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

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

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

-- | Helper for printing Symbols
showSymb :: Symbol -> String
showSymb :: Symbol -> String
showSymb 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 :: forall x. HasSymbol x => x -> String
showHasSymbImpl x
x = Symbol -> String
showSymb (x -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
L.symbol x
x Stage
Implementation)