{-# 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 c :: Char
c) cs :: Text
cs     = Char -> Text -> Text
T.cons Char
c Text
cs
renderTeX (Literal s :: Text
s) cs :: 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 ' ' Text
cs
  | Bool
otherwise                   = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs
renderTeX (ControlSeq s :: Text
s) cs :: Text
cs
  | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "\\ "               = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs
  | (Char -> Bool) -> Text -> Bool
startsWith (\c :: 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 ' ' Text
cs
  | Bool
otherwise                = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs
renderTeX (Grouped [Grouped xs :: [TeX]
xs]) cs :: Text
cs  = TeX -> Text -> Text
renderTeX ([TeX] -> TeX
Grouped [TeX]
xs) Text
cs
renderTeX (Grouped xs :: [TeX]
xs) cs :: Text
cs     =
  "{" 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 "" ([TeX] -> [TeX]
trimSpaces [TeX]
xs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs
renderTeX Space cs :: Text
cs
  | Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ""                   = ""
  | (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 ' ' Text
cs
  where
    -- No space before ^, _, or \limits, and no doubled up spaces
    ps :: [Text]
ps = [ "^", "_", " ", "\\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 p :: Char -> Bool
p t :: Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Just (c :: Char
c, _) -> Char -> Bool
p Char
c
  Nothing     -> Bool
False

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

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

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