-- | General helper functions for printing Drasil documents.
module Language.Drasil.Printing.Helpers where

import Prelude hiding ((<>))
import Text.PrettyPrint (text, Doc, (<>), ($$))
import Data.Char (toUpper, toLower)
import Language.Drasil.Printing.Citation ( CiteField(HowPublished), HP (..) )

-- | Custom infix operator for concatenating 
-- two 'Doc's vertically with an empty line in between.
infixl 5 $^$
($^$) :: Doc -> Doc -> Doc
$^$ :: Doc -> Doc -> Doc
($^$) Doc
a Doc
b = Doc
a Doc -> Doc -> Doc
$$ Doc
emptyline Doc -> Doc -> Doc
$$ Doc
b

-- | Concatenate a list of 'Doc's vertically 
-- with an empty line in between.
vsep :: [Doc] -> Doc
vsep :: [Doc] -> Doc
vsep = (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc -> Doc -> Doc
($^$)

-- | Basic text-rendering helper function.
bslash,dbs,assign,eq,lt,gt,leq,geq,dlr,ast,pls,hat,slash,hyph,unders,pipe,emptyline :: Doc
-- | Single backslash.
bslash :: Doc
bslash    = String -> Doc
text String
"\\"
-- | Double backslash.
dbs :: Doc
dbs       = String -> Doc
text String
"\\\\"
-- | Variable assignment character ("=").
assign :: Doc
assign    = String -> Doc
text String
"="
-- | Equality character ("==").
eq :: Doc
eq        = String -> Doc
text String
"=="
-- | Less than.
lt :: Doc
lt        = String -> Doc
text String
"<"
-- | Greater than.
gt :: Doc
gt        = String -> Doc
text String
">"
-- | Less than or equal to.
leq :: Doc
leq       = String -> Doc
text String
"<="
-- | Greater than or equal to.
geq :: Doc
geq       = String -> Doc
text String
">="
-- | Dollar sign.
dlr :: Doc
dlr       = String -> Doc
text String
"$"
-- | Asterisk.
ast :: Doc
ast       = String -> Doc
text String
"*"
-- | Plus.
pls :: Doc
pls       = String -> Doc
text String
"+"
-- | Hat symbol ("^").
hat :: Doc
hat       = String -> Doc
text String
"^"
-- | Forward slash.
slash :: Doc
slash     = String -> Doc
text String
"/"
-- | Hyphen.
hyph :: Doc
hyph      = String -> Doc
text String
"-"
-- | Underscore.
unders :: Doc
unders    = String -> Doc
text String
"_"
-- | Pipe.
pipe :: Doc
pipe      = String -> Doc
text String
"|"
-- | Empty line.
emptyline :: Doc
emptyline = String -> Doc
text String
""

-- | Text-rendering helper for wrapping strings with brackets/braces.
sq,br :: String -> Doc
-- | Square brackets.
sq :: String -> Doc
sq String
t = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
-- | Curly braces.
br :: String -> Doc
br String
t = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"

-- | Text-rendering helper for appending a period/decimal point (dot symbol) or a comma.
dot, comm :: Doc -> Doc
-- | Dot symbol (".")
dot :: Doc -> Doc
dot  = (Doc -> Doc -> Doc
<> String -> Doc
text String
".")
-- | Comma (",")
comm :: Doc -> Doc
comm = (Doc -> Doc -> Doc
<> String -> Doc
text String
",")

-- | For wrapping $ on both sides of a 'Doc'.
dollarDoc :: Doc -> Doc
dollarDoc :: Doc -> Doc
dollarDoc Doc
x = Doc
dlr Doc -> Doc -> Doc
<> Doc
x Doc -> Doc -> Doc
<> Doc
dlr

-- | Basic plaintext (String) wrapping.
paren, brace, dollar, sqbrac, angbrac :: String -> String
-- | Wraps in parenthesis.
paren :: String -> String
paren   String
x = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
-- | Wraps in curly braces.
brace :: String -> String
brace   String
x = String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
-- | Wraps in dollar signs.
dollar :: String -> String
dollar  String
x = String
"$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$"
-- | Wraps in square brackets.
sqbrac :: String -> String
sqbrac  String
x = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
-- | Wraps in angular brackets ("<>").
angbrac :: String -> String
angbrac String
x = String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"

-- | Format strings and convert to Doc.
upcase, lowcase :: String -> Doc
-- | Capitalize first letter of string.
upcase :: String -> Doc
upcase []      = String -> Doc
text []
upcase (Char
c:String
cs)  = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Char
toUpper Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs
-- | Make first letter lowercase.
lowcase :: String -> Doc
lowcase []     = String -> Doc
text []
lowcase (Char
c:String
cs) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs

--FIXME: move this. It is here for not since TeX and HTML
--       use this for bibliography rendering
-- | Appends a suffix for a number. Used only on single digit 'Int's.
sufx :: Int -> String
sufx :: Int -> String
sufx Int
1 = String
"st"
sufx Int
2 = String
"nd"
sufx Int
3 = String
"rd"
sufx Int
_ = String
"th"

-- | Similar to 'sufx' but used on any sized 'Int'.
sufxer :: Int -> String
sufxer :: Int -> String
sufxer Int
x = Int -> String
sufx Int
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
    where
        r :: Int
r = if Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
x Int
100 Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
11, Int
12, Int
13] then Int
0 else Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
x Int
10

sufxPrint :: [CiteField] -> String
sufxPrint :: [CiteField] -> String
sufxPrint [CiteField]
fields = if (CiteField -> Bool) -> [CiteField] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CiteField -> Bool
isUrl [CiteField]
fields then String
"" else String
" Print."
  where
    isUrl :: CiteField -> Bool
isUrl (HowPublished (URL Spec
_)) = Bool
True
    isUrl CiteField
_ = Bool
False