{-# 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