{-# LANGUAGE OverloadedStrings #-}

-- | Defines functions to print on plain files (for .txt, .log, etc.).
module Language.Drasil.Plain.Print (
  -- * Types
  SingleLine(..),
  -- * Renderers
  oneLineCodeSymbolDoc, oneLineSentenceDoc, oneLineExprDoc, oneLineCodeExprDoc,
  oneLineUnitDoc
) where

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

import Language.Drasil (Special(..), Symbol, USymb(..), codeSymb)
import qualified Language.Drasil as L (HasSymbol(..), Sentence, Expr)

import Drasil.Printers.Common
import Language.Drasil.Printing.AST (Expr(..), Spec(..), Ops(..), Fence(..),
  OverSymb(..), Fonts(..), Spacing(..), LinkType(..))
import Language.Drasil.Printing.PrintingInformation (PrintingInformation)
import Language.Drasil.Printing.Import.Expr (expr)
import Language.Drasil.Printing.Import.Sentence (spec)
import Language.Drasil.Printing.Import.Symbol (symbol)
import Language.Drasil.Printing.Import.CodeExpr (codeExpr)
import Drasil.Code.CodeExpr (CodeExpr)

-- | Data is either linear or not.
data SingleLine = OneLine | MultiLine

-- | Render a symbol to a 'String' on one line.
oneLineCodeSymbolDoc :: L.HasSymbol x => x -> String
oneLineCodeSymbolDoc :: forall x. HasSymbol x => x -> String
oneLineCodeSymbolDoc = Doc -> String
render (Doc -> String) -> (x -> Doc) -> x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleLine -> Expr -> Doc
pExprDoc SingleLine
OneLine (Expr -> Doc) -> (x -> Expr) -> x -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Expr
symbol (Symbol -> Expr) -> (x -> Symbol) -> x -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Symbol
forall q. HasSymbol q => q -> Symbol
codeSymb

-- | Creates a 'OneLine' 'Implementation'-stage 'sentenceDoc'.
oneLineSentenceDoc :: PrintingInformation -> L.Sentence -> Doc
oneLineSentenceDoc :: PrintingInformation -> Sentence -> Doc
oneLineSentenceDoc PrintingInformation
pinfo = SingleLine -> Spec -> Doc
specDoc SingleLine
OneLine (Spec -> Doc) -> (Sentence -> Spec) -> Sentence -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintingInformation -> Sentence -> Spec
spec PrintingInformation
pinfo

-- | Creates a 'OneLine' 'Implementation'-stage 'exprDoc'.
oneLineExprDoc :: PrintingInformation -> L.Expr -> Doc
oneLineExprDoc :: PrintingInformation -> Expr -> Doc
oneLineExprDoc PrintingInformation
pinfo Expr
e = SingleLine -> Expr -> Doc
pExprDoc SingleLine
OneLine (Expr -> PrintingInformation -> Expr
expr Expr
e PrintingInformation
pinfo)

oneLineCodeExprDoc :: PrintingInformation -> CodeExpr -> Doc
oneLineCodeExprDoc :: PrintingInformation -> CodeExpr -> Doc
oneLineCodeExprDoc PrintingInformation
pinfo = SingleLine -> Expr -> Doc
pExprDoc SingleLine
OneLine (Expr -> Doc) -> (CodeExpr -> Expr) -> CodeExpr -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintingInformation -> CodeExpr -> Expr
codeExpr PrintingInformation
pinfo

-- | Creates a 'OneLine' 'unitDoc'.
oneLineUnitDoc :: USymb -> Doc
oneLineUnitDoc :: USymb -> Doc
oneLineUnitDoc = SingleLine -> USymb -> Doc
unitDoc SingleLine
OneLine

-- | 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
$ SingleLine -> Expr -> Doc
pExprDoc SingleLine
f (Expr -> Doc) -> [Expr] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr]
es
pExprDoc SingleLine
f (Set [Expr]
es) = [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ SingleLine -> Expr -> Doc
pExprDoc SingleLine
f (Expr -> Doc) -> [Expr] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr]
es
pExprDoc SingleLine
_ (Ident String
s) = String -> Doc
text String
s
pExprDoc SingleLine
_ (Label String
s) = String -> Doc
text 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) = Text -> Text -> Doc -> Doc
forall a. CanTextWrap a => Text -> Text -> a -> a
wrap Text
"_" Text
"_" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ SingleLine -> Expr -> Doc
pExprDoc SingleLine
f Expr
e
pExprDoc SingleLine
f (Div Expr
n Expr
d) = Doc -> Doc
forall a. CanTextWrap a => a -> a
paren (SingleLine -> Expr -> Doc
pExprDoc SingleLine
f Expr
n) Doc -> Doc -> Doc
<> String -> Doc
text String
"/" Doc -> Doc -> Doc
<> Doc -> Doc
forall a. CanTextWrap a => a -> a
paren (SingleLine -> Expr -> Doc
pExprDoc SingleLine
f Expr
d)
pExprDoc SingleLine
f (Sqrt Expr
e) = String -> Doc
text String
"sqrt" Doc -> Doc -> Doc
<> Doc -> Doc
forall a. CanTextWrap a => a -> a
paren (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
f (Tooltip Spec
_ Spec
s) = SingleLine -> Spec -> Doc
specDoc SingleLine
f Spec
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. Semigroup a => a -> a -> a
P.<> 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. Semigroup a => a -> a -> a
P.<> 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
forall a. CanTextWrap a => a -> a
dquote (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ SingleLine -> Spec -> Doc
specDoc SingleLine
f Spec
s

-- | 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
pow ((Symbol, Integer) -> Doc) -> [(Symbol, Integer)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(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
s,Integer
i) -> (Symbol
s,-Integer
i)) ((Symbol, Integer) -> (Symbol, Integer))
-> [(Symbol, Integer)] -> [(Symbol, Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(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
forall a. CanTextWrap a => a -> a
paren (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
pow ((Symbol, Integer) -> Doc) -> [(Symbol, Integer)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(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
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) -> Doc) -> [(Expr, Expr)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Expr, Expr)]
cs
caseDoc SingleLine
MultiLine [(Expr, Expr)]
cs = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (\(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) -> Doc) -> [(Expr, Expr)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Expr, Expr)]
cs

-- | Helper for printing matrices.
mtxDoc :: SingleLine -> [[Expr]] -> Doc
mtxDoc :: SingleLine -> [[Expr]] -> Doc
mtxDoc SingleLine
OneLine [[Expr]]
rs = Doc -> Doc
forall a. CanTextWrap a => a -> a
brak (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
$ Doc -> Doc
forall a. CanTextWrap a => a -> a
brak (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]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SingleLine -> Expr -> Doc
pExprDoc
  SingleLine
OneLine) ([Expr] -> Doc) -> [[Expr]] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Expr]]
rs
mtxDoc SingleLine
MultiLine [[Expr]]
rs = Doc -> Doc
forall a. CanTextWrap a => a -> a
brak (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
$ [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]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SingleLine -> Expr -> Doc
pExprDoc SingleLine
MultiLine) ([Expr] -> Doc) -> [[Expr]] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[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
"|"