{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
{-
Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}
module Text.TeXMath.Shared
  ( getMMLType
  , getTextType
  , getLaTeXTextCommand
  , getScalerCommand
  , getScalerValue
  , scalers
  , getSpaceWidth
  , getSpaceChars
  , getDiacriticalCommand
  , diacriticals
  , getOperator
  , readLength
  , fixTree
  , isEmpty
  , empty
  , handleDownup
  ) where


import Text.TeXMath.Types
import Text.TeXMath.TeX
import qualified Data.Map as M
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Maybe (fromMaybe)
import Data.Ratio ((%))
import Data.List (sort)
import Control.Monad (guard)
import Text.Parsec (Parsec, parse, getInput, digit, char, many1, option)
import Data.Generics (everywhere, mkT)

-- As we constuct from the bottom up, this situation can occur.
removeNesting :: Exp -> Exp
removeNesting :: Exp -> Exp
removeNesting (EDelimited Text
o Text
c [Right (EDelimited Text
"" Text
"" [InEDelimited]
xs)]) = Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
o Text
c [InEDelimited]
xs
removeNesting (EDelimited Text
"" Text
"" [InEDelimited
x]) = (Text -> Exp) -> (Exp -> Exp) -> InEDelimited -> Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord) Exp -> Exp
forall a. a -> a
id InEDelimited
x
removeNesting (EGrouped [Exp
x]) = Exp
x
removeNesting Exp
x = Exp
x

removeEmpty :: [Exp] -> [Exp]
removeEmpty :: [Exp] -> [Exp]
removeEmpty [Exp]
xs = (Exp -> Bool) -> [Exp] -> [Exp]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Exp -> Bool) -> Exp -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> Bool
isEmpty) [Exp]
xs

-- | An empty group of expressions
empty :: Exp
empty :: Exp
empty = [Exp] -> Exp
EGrouped []

-- | Test to see whether an expression is @empty@.
isEmpty :: Exp -> Bool
isEmpty :: Exp -> Bool
isEmpty (EGrouped []) = Bool
True
isEmpty Exp
_ = Bool
False

-- | Walks over a tree of expressions, removing empty expressions, and
-- fixing delimited expressions with no delimiters and unnecessarily
-- grouped expressions.
fixTree :: Exp -> Exp
fixTree :: Exp -> Exp
fixTree = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((Exp -> Exp) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT Exp -> Exp
removeNesting) (Exp -> Exp) -> (Exp -> Exp) -> Exp -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (([Exp] -> [Exp]) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT [Exp] -> [Exp]
removeEmpty)

-- | Maps TextType to the corresponding MathML mathvariant
getMMLType :: TextType -> T.Text
getMMLType :: TextType -> Text
getMMLType TextType
t = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"normal" ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> Maybe (Text, Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextType -> Map TextType (Text, Text) -> Maybe (Text, Text)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TextType
t Map TextType (Text, Text)
textTypesMap)

-- | Maps TextType to corresponding LaTeX command
getLaTeXTextCommand :: Env -> TextType -> T.Text
getLaTeXTextCommand :: Env -> TextType -> Text
getLaTeXTextCommand Env
e TextType
t =
  let textCmd :: Text
textCmd = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"\\mathrm"
                  ((Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> Maybe (Text, Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextType -> Map TextType (Text, Text) -> Maybe (Text, Text)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TextType
t Map TextType (Text, Text)
textTypesMap) in
  if Text -> Env -> Bool
textPackage Text
textCmd Env
e
    then Text
textCmd
    else Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"\\mathrm" (Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
textCmd Map Text Text
alts)

-- | Maps MathML mathvariant to the corresponing TextType
getTextType :: T.Text -> TextType
getTextType :: Text -> TextType
getTextType Text
s = TextType -> Maybe TextType -> TextType
forall a. a -> Maybe a -> a
fromMaybe TextType
TextNormal (Text -> Map Text TextType -> Maybe TextType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
s Map Text TextType
revTextTypesMap)

-- | Maps a LaTeX scaling command to the percentage scaling
getScalerCommand :: Rational -> Maybe T.Text
getScalerCommand :: Rational -> Maybe Text
getScalerCommand Rational
width =
  case [(Rational, Text)] -> [(Rational, Text)]
forall a. Ord a => [a] -> [a]
sort [ (Rational
w, Text
cmd) | (Text
cmd, Rational
w) <- [(Text, Rational)]
scalers, Rational
w Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
width ] of
       ((Rational
_,Text
cmd):[(Rational, Text)]
_) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
cmd
       [(Rational, Text)]
_           -> Maybe Text
forall a. Maybe a
Nothing
  -- note, we don't use a Map here because we need the first
  -- match:  \Big, not \Bigr

-- | Gets percentage scaling from LaTeX scaling command
getScalerValue :: T.Text -> Maybe Rational
getScalerValue :: Text -> Maybe Rational
getScalerValue Text
command = Text -> [(Text, Rational)] -> Maybe Rational
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
command [(Text, Rational)]
scalers

-- | Given a diacritical mark, returns the corresponding LaTeX command
getDiacriticalCommand  :: Position -> T.Text -> Maybe T.Text
getDiacriticalCommand :: Position -> Text -> Maybe Text
getDiacriticalCommand Position
pos Text
symbol = do
  Text
command <- Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
symbol Map Text Text
diaMap
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
command Text -> Env -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Env
unavailable)
  let below :: Bool
below = Text
command Text -> Env -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Env
under
  case Position
pos of
    Position
Under -> if Bool
below then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
command else Maybe Text
forall a. Maybe a
Nothing
    Position
Over -> if Bool -> Bool
not Bool
below then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
command else Maybe Text
forall a. Maybe a
Nothing
  where
    diaMap :: Map Text Text
diaMap = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Text)]
diacriticals

-- Operator Table

getOperator :: Exp -> Maybe TeX
getOperator :: Exp -> Maybe TeX
getOperator Exp
op = (Text -> TeX) -> Maybe Text -> Maybe TeX
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TeX
ControlSeq (Maybe Text -> Maybe TeX) -> Maybe Text -> Maybe TeX
forall a b. (a -> b) -> a -> b
$ Exp -> Map Exp Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Exp
op Map Exp Text
operators

operators :: M.Map Exp T.Text
operators :: Map Exp Text
operators = [(Exp, Text)] -> Map Exp Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
           [ (Text -> Exp
EMathOperator Text
"arccos", Text
"\\arccos")
           , (Text -> Exp
EMathOperator Text
"arcsin", Text
"\\arcsin")
           , (Text -> Exp
EMathOperator Text
"arctan", Text
"\\arctan")
           , (Text -> Exp
EMathOperator Text
"arg", Text
"\\arg")
           , (Text -> Exp
EMathOperator Text
"cos", Text
"\\cos")
           , (Text -> Exp
EMathOperator Text
"cosh", Text
"\\cosh")
           , (Text -> Exp
EMathOperator Text
"cot", Text
"\\cot")
           , (Text -> Exp
EMathOperator Text
"coth", Text
"\\coth")
           , (Text -> Exp
EMathOperator Text
"csc", Text
"\\csc")
           , (Text -> Exp
EMathOperator Text
"deg", Text
"\\deg")
           , (Text -> Exp
EMathOperator Text
"det", Text
"\\det")
           , (Text -> Exp
EMathOperator Text
"dim", Text
"\\dim")
           , (Text -> Exp
EMathOperator Text
"exp", Text
"\\exp")
           , (Text -> Exp
EMathOperator Text
"gcd", Text
"\\gcd")
           , (Text -> Exp
EMathOperator Text
"hom", Text
"\\hom")
           , (Text -> Exp
EMathOperator Text
"inf", Text
"\\inf")
           , (Text -> Exp
EMathOperator Text
"ker", Text
"\\ker")
           , (Text -> Exp
EMathOperator Text
"lg", Text
"\\lg")
           , (Text -> Exp
EMathOperator Text
"lim", Text
"\\lim")
           , (Text -> Exp
EMathOperator Text
"liminf", Text
"\\liminf")
           , (Text -> Exp
EMathOperator Text
"limsup", Text
"\\limsup")
           , (Text -> Exp
EMathOperator Text
"ln", Text
"\\ln")
           , (Text -> Exp
EMathOperator Text
"log", Text
"\\log")
           , (Text -> Exp
EMathOperator Text
"max", Text
"\\max")
           , (Text -> Exp
EMathOperator Text
"min", Text
"\\min")
           , (Text -> Exp
EMathOperator Text
"Pr", Text
"\\Pr")
           , (Text -> Exp
EMathOperator Text
"sec", Text
"\\sec")
           , (Text -> Exp
EMathOperator Text
"sin", Text
"\\sin")
           , (Text -> Exp
EMathOperator Text
"sinh", Text
"\\sinh")
           , (Text -> Exp
EMathOperator Text
"sup", Text
"\\sup")
           , (Text -> Exp
EMathOperator Text
"tan", Text
"\\tan")
           , (Text -> Exp
EMathOperator Text
"tanh", Text
"\\tanh") ]

-- | Attempts to convert a string into
readLength :: T.Text -> Maybe Rational
readLength :: Text -> Maybe Rational
readLength Text
s = do
  (Rational
n, Text
unit) <- case (Parsec Text () (Rational, Text)
-> [Char] -> Text -> Either ParseError (Rational, Text)
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse Parsec Text () (Rational, Text)
parseLength [Char]
"" Text
s) of
                  Left ParseError
_ -> Maybe (Rational, Text)
forall a. Maybe a
Nothing
                  Right (Rational, Text)
v -> (Rational, Text) -> Maybe (Rational, Text)
forall a. a -> Maybe a
Just (Rational, Text)
v
  (Rational
n Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*) (Rational -> Rational) -> Maybe Rational -> Maybe Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Rational
unitToMultiplier Text
unit


parseLength :: Parsec T.Text () (Rational, T.Text)
parseLength :: Parsec Text () (Rational, Text)
parseLength = do
    [Char]
neg <- [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" ((Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[]) (Char -> [Char])
-> ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
    [Char]
dec <- ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
    [Char]
frac <- [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" ((:) (Char -> [Char] -> [Char])
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity ([Char] -> [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT Text () Identity ([Char] -> [Char])
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)
    Text
unit <- ParsecT Text () Identity Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
    -- This is safe as dec and frac must be a double of some kind
    case ReadS Double
forall a. Read a => ReadS a
reads ([Char]
neg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dec [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
frac) of
       [(Double
n :: Double, [])] -> (Rational, Text) -> Parsec Text () (Rational, Text)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
18) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
18, Text
unit)
       [(Double, [Char])]
_ -> [Char] -> Parsec Text () (Rational, Text)
forall a. [Char] -> ParsecT Text () Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parsec Text () (Rational, Text))
-> [Char] -> Parsec Text () (Rational, Text)
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not parse " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
neg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dec [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
frac [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" as Double"

textTypesMap :: M.Map TextType (T.Text, T.Text)
textTypesMap :: Map TextType (Text, Text)
textTypesMap = [(TextType, (Text, Text))] -> Map TextType (Text, Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(TextType, (Text, Text))]
textTypes

revTextTypesMap :: M.Map T.Text TextType
revTextTypesMap :: Map Text TextType
revTextTypesMap = [(Text, TextType)] -> Map Text TextType
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, TextType)] -> Map Text TextType)
-> [(Text, TextType)] -> Map Text TextType
forall a b. (a -> b) -> a -> b
$ ((TextType, (Text, Text)) -> (Text, TextType))
-> [(TextType, (Text, Text))] -> [(Text, TextType)]
forall a b. (a -> b) -> [a] -> [b]
map (\(TextType
k, (Text
v,Text
_)) -> (Text
v,TextType
k)) [(TextType, (Text, Text))]
textTypes

--TextType to (MathML, LaTeX)
textTypes :: [(TextType, (T.Text, T.Text))]
textTypes :: [(TextType, (Text, Text))]
textTypes =
  [ ( TextType
TextNormal       , (Text
"normal", Text
"\\mathrm"))
  , ( TextType
TextBold         , (Text
"bold", Text
"\\mathbf"))
  , ( TextType
TextItalic       , (Text
"italic",Text
"\\mathit"))
  , ( TextType
TextMonospace    , (Text
"monospace",Text
"\\mathtt"))
  , ( TextType
TextSansSerif    , (Text
"sans-serif",Text
"\\mathsf"))
  , ( TextType
TextDoubleStruck , (Text
"double-struck",Text
"\\mathbb"))
  , ( TextType
TextScript       , (Text
"script",Text
"\\mathcal"))
  , ( TextType
TextFraktur      , (Text
"fraktur",Text
"\\mathfrak"))
  , ( TextType
TextBoldItalic          , (Text
"bold-italic",Text
"\\mathbfit"))
  , ( TextType
TextSansSerifBold       , (Text
"bold-sans-serif",Text
"\\mathbfsfup"))
  , ( TextType
TextSansSerifBoldItalic , (Text
"sans-serif-bold-italic",Text
"\\mathbfsfit"))
  , ( TextType
TextBoldScript          , (Text
"bold-script",Text
"\\mathbfscr"))
  , ( TextType
TextBoldFraktur         , (Text
"bold-fraktur",Text
"\\mathbffrak"))
  , ( TextType
TextSansSerifItalic     , (Text
"sans-serif-italic",Text
"\\mathsfit")) ]

unicodeMath, base :: Set.Set T.Text
unicodeMath :: Set Text
unicodeMath = Env -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
  [Text
"\\mathbfit", Text
"\\mathbfsfup", Text
"\\mathbfsfit", Text
"\\mathbfscr",
   Text
"\\mathbffrak", Text
"\\mathsfit"]
base :: Set Text
base = Env -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
  [Text
"\\mathbb", Text
"\\mathrm", Text
"\\mathbf", Text
"\\mathit", Text
"\\mathsf",
   Text
"\\mathtt", Text
"\\mathfrak", Text
"\\mathcal"]

alts :: M.Map T.Text T.Text
alts :: Map Text Text
alts = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"\\mathbfit", Text
"\\mathbf")
  , (Text
"\\mathbfsfup", Text
"\\mathbf")
  , (Text
"\\mathbfsfit", Text
"\\mathbf")
  , (Text
"\\mathbfscr", Text
"\\mathcal")
  , (Text
"\\mathbffrak", Text
"\\mathfrak")
  , (Text
"\\mathsfit", Text
"\\mathsf")
  ]

textPackage :: T.Text -> [T.Text] -> Bool
textPackage :: Text -> Env -> Bool
textPackage Text
s Env
e
  | Text
s Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
unicodeMath = Text
"unicode-math" Text -> Env -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Env
e
  | Text
s Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
base    = Bool
True
  | Bool
otherwise = Bool
True

-- | Mapping between LaTeX scaling commands and the scaling factor
scalers :: [(T.Text, Rational)]
scalers :: [(Text, Rational)]
scalers =
          [ (Text
"\\bigg", Rational
widthbigg)
          , (Text
"\\Bigg", Rational
widthBigg)
          , (Text
"\\big", Rational
widthbig)
          , (Text
"\\Big", Rational
widthBig)
          , (Text
"\\biggr", Rational
widthbigg)
          , (Text
"\\Biggr", Rational
widthBigg)
          , (Text
"\\bigr", Rational
widthbig)
          , (Text
"\\Bigr", Rational
widthBig)
          , (Text
"\\biggl", Rational
widthbigg)
          , (Text
"\\Biggl", Rational
widthBigg)
          , (Text
"\\bigl", Rational
widthbig)]
  where widthbig :: Rational
widthbig = Rational
6 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
5
        widthBig :: Rational
widthBig = Rational
9 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
5
        widthbigg :: Rational
widthbigg = Rational
12 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
5
        widthBigg :: Rational
widthBigg = Rational
3

-- | Returns the space width for a unicode space character, or Nothing.
getSpaceWidth :: Char -> Maybe Rational
getSpaceWidth :: Char -> Maybe Rational
getSpaceWidth Char
' '      = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
4Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18)
getSpaceWidth Char
'\xA0'   = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
4Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18)
getSpaceWidth Char
'\x2000' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)
getSpaceWidth Char
'\x2001' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
1
getSpaceWidth Char
'\x2002' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)
getSpaceWidth Char
'\x2003' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
1
getSpaceWidth Char
'\x2004' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
3)
getSpaceWidth Char
'\x2005' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
4Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18)
getSpaceWidth Char
'\x2006' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
6)
getSpaceWidth Char
'\x2007' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
3) -- ? width of a digit
getSpaceWidth Char
'\x2008' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
6) -- ? width of a period
getSpaceWidth Char
'\x2009' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
6)
getSpaceWidth Char
'\x200A' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
9)
getSpaceWidth Char
'\x200B' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
0
getSpaceWidth Char
'\x202F' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
3Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18)
getSpaceWidth Char
'\x205F' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational
4Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
18)
getSpaceWidth Char
_        = Maybe Rational
forall a. Maybe a
Nothing

-- | Returns the sequence of unicode space characters closest to the
-- specified width.
getSpaceChars :: Rational -> T.Text
getSpaceChars :: Rational -> Text
getSpaceChars Rational
r
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Text
"\x200B" -- no negative space chars in unicode
  | Bool
otherwise = Rational -> Text
forall {t}. (Ord t, Fractional t) => t -> Text
fracSpaces Rational
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
emQuads Int
n
  where
    (Int
n, Rational
f) = Rational -> (Int, Rational)
forall b. Integral b => Rational -> (b, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Rational
r
    emQuads :: Int -> Text
emQuads Int
x = Int -> Text -> Text
T.replicate Int
x Text
"\x2001"
    fracSpaces :: t -> Text
fracSpaces t
x
      | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
2t -> t -> t
forall a. Fractional a => a -> a -> a
/t
18 = Text
"\x200A"
      | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
3t -> t -> t
forall a. Fractional a => a -> a -> a
/t
18 = Text
"\x2006"
      | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
4t -> t -> t
forall a. Fractional a => a -> a -> a
/t
18 = Text
"\xA0"   -- could also be "\x2005"
      | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
5t -> t -> t
forall a. Fractional a => a -> a -> a
/t
18 = Text
"\x2005"
      | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
7t -> t -> t
forall a. Fractional a => a -> a -> a
/t
18 = Text
"\x2004"
      | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
9t -> t -> t
forall a. Fractional a => a -> a -> a
/t
18 = Text
"\x2000"
      | Bool
otherwise = Char -> Text -> Text
T.cons Char
'\x2000' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ t -> Text
fracSpaces (t
x t -> t -> t
forall a. Num a => a -> a -> a
- (t
1t -> t -> t
forall a. Fractional a => a -> a -> a
/t
2))

-- Accents which go under the character
under :: [T.Text]
under :: Env
under = [Text
"\\underbrace", Text
"\\underline", Text
"\\underbar", Text
"\\underbracket"]

-- We want to parse these but we can't represent them in LaTeX
unavailable :: [T.Text]
unavailable :: Env
unavailable = [Text
"\\overbracket", Text
"\\underbracket"]


-- | Mapping between unicode combining character and LaTeX accent command
diacriticals :: [(T.Text, T.Text)]
diacriticals :: [(Text, Text)]
diacriticals =
               [ (Text
"\x00B4", Text
"\\acute")
               , (Text
"\x0301", Text
"\\acute")
               , (Text
"\x0060", Text
"\\grave")
               , (Text
"\x0300", Text
"\\grave")
               , (Text
"\x02D8", Text
"\\breve")
               , (Text
"\x0306", Text
"\\breve")
               , (Text
"\x02C7", Text
"\\check")
               , (Text
"\x030C", Text
"\\check")
               , (Text
"\x307", Text
"\\dot")
               , (Text
"\x308", Text
"\\ddot")
               , (Text
"\x20DB", Text
"\\dddot")
               , (Text
"\x20DC", Text
"\\ddddot")
               , (Text
"\x00B0", Text
"\\mathring")
               , (Text
"\x030A", Text
"\\mathring")
               , (Text
"\x20D7", Text
"\\vec")
               , (Text
"\x20D7", Text
"\\overrightarrow")
               , (Text
"\x20D6", Text
"\\overleftarrow")
               , (Text
"\x005E", Text
"\\hat")
               , (Text
"\x02C6", Text
"\\widehat")
               , (Text
"\x0302", Text
"\\widehat")
               , (Text
"\x02DC", Text
"\\widetilde")
               , (Text
"\x0303", Text
"\\tilde")
               , (Text
"\x0303", Text
"\\widetilde")
               , (Text
"\x0304", Text
"\\bar")
               , (Text
"\x203E", Text
"\\bar")
               , (Text
"\x23DE", Text
"\\overbrace")
               , (Text
"\x23B4", Text
"\\overbracket") -- Only availible in mathtools
               , (Text
"\x00AF", Text
"\\overline")
               , (Text
"\x0305", Text
"\\overline")
               , (Text
"\x23DF", Text
"\\underbrace")
               , (Text
"\x23B5", Text
"\\underbracket") -- mathtools
               , (Text
"\x0332", Text
"\\underline")
               , (Text
"_", Text
"\\underline")
               , (Text
"\x0333", Text
"\\underbar")
               ]




-- Converts unit to multiplier to reach em
unitToMultiplier :: T.Text -> Maybe Rational
unitToMultiplier :: Text -> Maybe Rational
unitToMultiplier Text
s = Text -> Map Text Rational -> Maybe Rational
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
s Map Text Rational
units
  where
    units :: Map Text Rational
units = [(Text, Rational)] -> Map Text Rational
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList  [ ( Text
"pt" , Rational
10)
                        , ( Text
"mm" , (Rational
351Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
10))
                        , ( Text
"cm" , (Rational
35Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
100))
                        , ( Text
"in" , (Rational
14Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
100))
                        , ( Text
"ex" , (Rational
232Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
100))
                        , ( Text
"em" , Rational
1)
                        , ( Text
"mu" , Rational
18)
                        , ( Text
"dd" , (Rational
93Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
100))
                        , ( Text
"bp" , (Rational
996Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
1000))
                        , ( Text
"pc" , (Rational
83Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
100)) ]

handleDownup :: DisplayType -> Exp -> Exp
handleDownup :: DisplayType -> Exp -> Exp
handleDownup DisplayType
DisplayInline (EUnder Bool
True Exp
x Exp
y)       = Exp -> Exp -> Exp
ESub Exp
x Exp
y
handleDownup DisplayType
DisplayInline (EOver Bool
True Exp
x Exp
y)        = Exp -> Exp -> Exp
ESuper Exp
x Exp
y
handleDownup DisplayType
DisplayInline (EUnderover Bool
True Exp
x Exp
y Exp
z) = Exp -> Exp -> Exp -> Exp
ESubsup Exp
x Exp
y Exp
z
handleDownup DisplayType
DisplayBlock  (EUnder Bool
True Exp
x Exp
y)       = Bool -> Exp -> Exp -> Exp
EUnder Bool
False Exp
x Exp
y
handleDownup DisplayType
DisplayBlock  (EOver Bool
True Exp
x Exp
y)        = Bool -> Exp -> Exp -> Exp
EOver Bool
False  Exp
x Exp
y
handleDownup DisplayType
DisplayBlock  (EUnderover Bool
True Exp
x Exp
y Exp
z) = Bool -> Exp -> Exp -> Exp -> Exp
EUnderover Bool
False Exp
x Exp
y Exp
z
handleDownup DisplayType
_             Exp
x                       = Exp
x