{-# LANGUAGE OverloadedStrings #-}

module Text.TeXMath.TeX (TeX(..),
                         renderTeX,
                         isControlSeq,
                         escapeLaTeX)
where
import Data.Char (isLetter, isAlphaNum, isAscii)
import Data.Semigroup ((<>))
import qualified Data.Text as T

-- | An intermediate representation of TeX math, to be used in rendering.
data TeX = ControlSeq T.Text
         | Token Char
         | Literal T.Text
         | Grouped [TeX]
         | Space
         deriving (Int -> TeX -> ShowS
[TeX] -> ShowS
TeX -> String
(Int -> TeX -> ShowS)
-> (TeX -> String) -> ([TeX] -> ShowS) -> Show TeX
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeX] -> ShowS
$cshowList :: [TeX] -> ShowS
show :: TeX -> String
$cshow :: TeX -> String
showsPrec :: Int -> TeX -> ShowS
$cshowsPrec :: Int -> TeX -> ShowS
Show, TeX -> TeX -> Bool
(TeX -> TeX -> Bool) -> (TeX -> TeX -> Bool) -> Eq TeX
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeX -> TeX -> Bool
$c/= :: TeX -> TeX -> Bool
== :: TeX -> TeX -> Bool
$c== :: TeX -> TeX -> Bool
Eq)

-- | Render a 'TeX' to a string, appending to the front of the given string.
renderTeX :: TeX -> T.Text -> T.Text
renderTeX :: TeX -> Text -> Text
renderTeX (Token Char
c) Text
cs     = Char -> Text -> Text
T.cons Char
c Text
cs
renderTeX (Literal Text
s) Text
cs
  | (Char -> Bool) -> Text -> Bool
endsWith (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isLetter) Text
s = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs
  | (Char -> Bool) -> Text -> Bool
startsWith Char -> Bool
isLetter Text
cs      = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
T.cons Char
' ' Text
cs
  | Bool
otherwise                   = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs
renderTeX (ControlSeq Text
s) Text
cs
  | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\\ "               = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs
  | (Char -> Bool) -> Text -> Bool
startsWith (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Bool -> Bool
not (Char -> Bool
isAscii Char
c)) Text
cs
                             = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
T.cons Char
' ' Text
cs
  | Bool
otherwise                = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs
renderTeX (Grouped [Grouped [TeX]
xs]) Text
cs  = TeX -> Text -> Text
renderTeX ([TeX] -> TeX
Grouped [TeX]
xs) Text
cs
renderTeX (Grouped [TeX]
xs) Text
cs     =
  Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (TeX -> Text -> Text) -> Text -> [TeX] -> Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TeX -> Text -> Text
renderTeX Text
"" ([TeX] -> [TeX]
trimSpaces [TeX]
xs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs
renderTeX TeX
Space Text
cs
  | Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""                   = Text
""
  | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isPrefixOf` Text
cs) [Text]
ps = Text
cs
  | Bool
otherwise                  = Char -> Text -> Text
T.cons Char
' ' Text
cs
  where
    -- No space before ^, _, or \limits, and no doubled up spaces
    ps :: [Text]
ps = [ Text
"^", Text
"_", Text
" ", Text
"\\limits" ]

trimSpaces :: [TeX] -> [TeX]
trimSpaces :: [TeX] -> [TeX]
trimSpaces = [TeX] -> [TeX]
forall a. [a] -> [a]
reverse ([TeX] -> [TeX]) -> ([TeX] -> [TeX]) -> [TeX] -> [TeX]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeX] -> [TeX]
go ([TeX] -> [TeX]) -> ([TeX] -> [TeX]) -> [TeX] -> [TeX]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeX] -> [TeX]
forall a. [a] -> [a]
reverse ([TeX] -> [TeX]) -> ([TeX] -> [TeX]) -> [TeX] -> [TeX]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeX] -> [TeX]
go
  where go :: [TeX] -> [TeX]
go = (TeX -> Bool) -> [TeX] -> [TeX]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (TeX -> TeX -> Bool
forall a. Eq a => a -> a -> Bool
== TeX
Space)

startsWith :: (Char -> Bool) -> T.Text -> Bool
startsWith :: (Char -> Bool) -> Text -> Bool
startsWith Char -> Bool
p Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Just (Char
c, Text
_) -> Char -> Bool
p Char
c
  Maybe (Char, Text)
Nothing     -> Bool
False

endsWith :: (Char -> Bool) -> T.Text -> Bool
endsWith :: (Char -> Bool) -> Text -> Bool
endsWith Char -> Bool
p Text
t = case Text -> Maybe (Text, Char)
T.unsnoc Text
t of
  Just (Text
_, Char
c) -> Char -> Bool
p Char
c
  Maybe (Text, Char)
Nothing     -> Bool
False

isControlSeq :: T.Text -> Bool
isControlSeq :: Text -> Bool
isControlSeq Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Just (Char
'\\', Text
xs) -> Text -> Int
T.length Text
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Text
xs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
" "
                     Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isLetter Text
xs
  Maybe (Char, Text)
_               -> Bool
False

escapeLaTeX :: Char -> TeX
escapeLaTeX :: Char -> TeX
escapeLaTeX Char
c =
  case Char
c of
       Char
'~'   -> Text -> TeX
ControlSeq Text
"\\textasciitilde"
       Char
'^'   -> Text -> TeX
Literal Text
"\\textasciicircum"
       Char
'\\'  -> Text -> TeX
ControlSeq Text
"\\textbackslash"
       Char
'\x200B' -> Text -> TeX
Literal Text
"\\!"
       Char
'\x200A' -> Text -> TeX
Literal Text
"\\,"
       Char
'\x2006' -> Text -> TeX
Literal Text
"\\,"
       Char
'\xA0'   -> Text -> TeX
Literal Text
"~"
       Char
'\x2005' -> Text -> TeX
Literal Text
"\\:"
       Char
'\x2004' -> Text -> TeX
Literal Text
"\\;"
       Char
'\x2001' -> Text -> TeX
ControlSeq Text
"\\quad"
       Char
'\x2003' -> Text -> TeX
ControlSeq Text
"\\quad"
       Char
'\x2032' -> Text -> TeX
Literal Text
"'"
       Char
'\x2033' -> Text -> TeX
Literal Text
"''"
       Char
'\x2034' -> Text -> TeX
Literal Text
"'''"
       Char
_ | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
"#$%&_{} " -> Text -> TeX
Literal (Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c)
         | Bool
otherwise -> Char -> TeX
Token Char
c