-- | 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)

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

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

-- | 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 ".")
-- | Comma (",")
comm :: Doc -> Doc
comm = (Doc -> Doc -> Doc
<> String -> Doc
text ",")

-- | For wrapping $ on both sides of a 'Doc'.
dollarDoc :: Doc -> Doc
dollarDoc :: Doc -> Doc
dollarDoc x :: 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   x :: String
x = "(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"
-- | Wraps in curly braces.
brace :: String -> String
brace   x :: String
x = "{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "}"
-- | Wraps in dollar signs.
dollar :: String -> String
dollar  x :: String
x = "$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "$"
-- | Wraps in square brackets.
sqbrac :: String -> String
sqbrac  x :: String
x = "[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "]"
-- | Wraps in angular brackets ("<>").
angbrac :: String -> String
angbrac x :: String
x = "<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ ">"

-- | Format strings and convert to Doc.
upcase, lowcase :: String -> Doc
-- | Capitalize first letter of string.
upcase :: String -> Doc
upcase []      = String -> Doc
text []
upcase (c :: Char
c:cs :: 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 (c :: Char
c:cs :: 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 1 = "st"
sufx 2 = "nd"
sufx 3 = "rd"
sufx _ = "th"

-- | Similar to 'sufx' but used on any sized 'Int'.
sufxer :: Int -> String
sufxer :: Int -> String
sufxer = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".") (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
sufx (Int -> String) -> (Int -> Int) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod 10