{- |
Module      :  ./Common/LaTeX_funs.hs
Description :  auxiliary functions for LaTeX printing
Copyright   :  (c) Klaus Luettich, Uni Bremen 2002-2006
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

Auxiliary functions for LaTeX printing

Functions to calculate the length of a given word as it would be
   printed with LaTeX according to one of four categories of words
   useful for CASL:

   * keywords -- all the things that were printed in boldface

   * structid -- all the names used in the structured context of CASL

   * annotation -- all the comments and annotations of CASL in a smaller font

   * axiom -- identifiers in math mode for CASL Basic specs
-}

module Common.LaTeX_funs
    ( calcLineLen
    , axiom_width
    , latex_macro
    , flushright
    , casl_comment_latex
    , casl_normal_latex

    , hc_sty_small_keyword
    , hc_sty_plain_keyword
    , hc_sty_casl_keyword

    , hc_sty_axiom
    , hc_sty_structid
    , hc_sty_structid_indexed
    , hc_sty_id

    , startTab, endTab, setTab
    , setTabWSp
    , startAnno
    , endAnno
    , escapeSpecial
    , escapeLatex
    ) where

import qualified Data.Map as Map
import Data.Char
import Data.List (isPrefixOf)

import Common.LaTeX_maps
import Common.Lib.Pretty as Pretty
import Common.Parsec
import Text.ParserCombinators.Parsec as Parsec

-- | a constant String for starting a LaTeX indentation with tab stop
startTab :: String
startTab :: String
startTab = "\\@begT@"

-- | a constant String for releasing a LaTeX indentation with tab stop
endTab :: String
endTab :: String
endTab = "\\@endT@"

-- | a constant String to set a tab stop and enable it
setTab :: String
setTab :: String
setTab = "\\="

-- | a constant String indicating the start of a space based indentation
setTabWSp :: String
setTabWSp :: String
setTabWSp = "\\@setTS@{"

{- | functions for calculating an integer value according to a given
   length in LaTeX points.
-}
calcLineLen :: Int -> Int
calcLineLen :: Int -> Int
calcLineLen len :: Int
len = Int -> Int
scaleDown (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* 351
-- Units per mm found in: Karsten Guenther, "Einfuehrung in LaTeX2e" (p.376)

scaleDown :: Int -> Int
scaleDown :: Int -> Int
scaleDown = (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 44) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 15)

{- functions to calculate a word-width in integer with a given word
   type or purpose
-}

data Word_type =
    Keyword | StructId | Normal | Comment | Annotation | AnnotationBold | Axiom
    deriving (Int -> Word_type -> ShowS
[Word_type] -> ShowS
Word_type -> String
(Int -> Word_type -> ShowS)
-> (Word_type -> String)
-> ([Word_type] -> ShowS)
-> Show Word_type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Word_type] -> ShowS
$cshowList :: [Word_type] -> ShowS
show :: Word_type -> String
$cshow :: Word_type -> String
showsPrec :: Int -> Word_type -> ShowS
$cshowsPrec :: Int -> Word_type -> ShowS
Show, Word_type -> Word_type -> Bool
(Word_type -> Word_type -> Bool)
-> (Word_type -> Word_type -> Bool) -> Eq Word_type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Word_type -> Word_type -> Bool
$c/= :: Word_type -> Word_type -> Bool
== :: Word_type -> Word_type -> Bool
$c== :: Word_type -> Word_type -> Bool
Eq)

calc_word_width :: Word_type -> String -> Int
calc_word_width :: Word_type -> String -> Int
calc_word_width wt :: Word_type
wt s :: String
s = Int -> Int
scaleDown (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Word_type -> String -> Int
calc_word_widthAux Word_type
wt String
s

calc_word_widthAux :: Word_type -> String -> Int
calc_word_widthAux :: Word_type -> String -> Int
calc_word_widthAux wt :: Word_type
wt s :: String
s = Int -> String -> Map String Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault
  (ShowS -> Map String Int -> Map Char [String] -> String -> Int
sum_char_width_deb (String -> ShowS
showString "In map \"" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word_type -> ShowS
forall a. Show a => a -> ShowS
shows Word_type
wt ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString "\" \'")
   Map String Int
wFM Map Char [String]
k_wFM String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
correction) String
s Map String Int
wFM
    where (wFM :: Map String Int
wFM, k_wFM :: Map Char [String]
k_wFM) = case Word_type
wt of
                        Keyword -> (Map String Int
keyword_map, Map Char [String]
key_keyword_map)
                        StructId -> (Map String Int
structid_map, Map Char [String]
key_structid_map)
                        Comment -> (Map String Int
comment_map, Map Char [String]
key_comment_map)
                        Annotation -> (Map String Int
annotation_map, Map Char [String]
key_annotation_map)
                        AnnotationBold -> (Map String Int
annotationbf_map,
                                           Map Char [String]
key_annotationbf_map)
                        Axiom -> (Map String Int
axiom_map, Map Char [String]
key_axiom_map)
                        Normal -> (Map String Int
normal_map, Map Char [String]
key_normal_map)
          correction :: Int
correction = case Word_type
wt of
                       Axiom -> String -> Int
itCorrection String
s
                       _ -> 0

itCorrection :: String -> Int
itCorrection :: String -> Int
itCorrection [] = 0
itCorrection s :: String
s
    | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 Bool -> Bool -> Bool
|| String -> Char
forall a. [a] -> a
head String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\\' = 0
    | Bool
otherwise = Int -> String -> Int
itCorrection' 0 String
s
    where itCorrection' :: Int -> String -> Int
          itCorrection' :: Int -> String -> Int
itCorrection' _ [] = String -> Int
forall a. HasCallStack => String -> a
error "itCorrection' applied to empty List"
          itCorrection' r :: Int
r ys :: String
ys@[y1 :: Char
y1, y2 :: Char
y2]
              | Bool -> Bool
not (Char -> Bool
isAlphaNum Char
y1) = Int
r
              | Bool -> Bool
not (Char -> Bool
isAlphaNum Char
y2) = Int
r
              | Bool
otherwise = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
lookupCorrection String
ys

          itCorrection' r :: Int
r (y1 :: Char
y1 : ys :: String
ys@(y2 :: Char
y2 : _))
              | Bool -> Bool
not (Char -> Bool
isAlphaNum Char
y1) = Int -> String -> Int
itCorrection' Int
r String
ys
              | Bool
otherwise =
                  Int -> String -> Int
itCorrection'
                        (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
lookupCorrection [Char
y1, Char
y2])
                        String
ys
          itCorrection' _ _ = String -> Int
forall a. HasCallStack => String -> a
error ("itCorrection' doesn't work with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
          lookupCorrection :: String -> Int
lookupCorrection str :: String
str = Int -> String -> Map String Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
def_cor String
str
                                 Map String Int
italiccorrection_map
          def_cor :: Int
def_cor = 610

sum_char_width_deb :: (String -> String) -- only used for an hackie debug thing
                   -> Map.Map String Int
                   -> Map.Map Char [String] -> String -> Int
sum_char_width_deb :: ShowS -> Map String Int -> Map Char [String] -> String -> Int
sum_char_width_deb _pref_fun :: ShowS
_pref_fun cFM :: Map String Int
cFM key_cFM :: Map Char [String]
key_cFM s :: String
s = String -> Int -> Int
sum_char_width' String
s 0
    where sum_char_width' :: String -> Int -> Int
sum_char_width' [] r :: Int
r = Int
r
          sum_char_width' [c :: Char
c] r :: Int
r = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case Char
c of
              '}' -> 0
              '{' -> 0
              ' ' -> String -> Int
lookupWithDefault_cFM "~"
              _ -> String -> Int
lookupWithDefault_cFM [Char
c]
          sum_char_width' full :: String
full@(c1 :: Char
c1 : rest :: String
rest@(c2 :: Char
c2 : cs :: String
cs)) r :: Int
r
              | String -> Bool
isLigature [Char
c1, Char
c2] = case String -> Map String Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char
c1, Char
c2] Map String Int
cFM of
                                        Just l :: Int
l -> String -> Int -> Int
sum_char_width' String
cs (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l)
                                        Nothing -> String -> Int -> Int
sum_char_width' String
rest Int
nl
              | [Char
c1, Char
c2] String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "\\ " =
                  String -> Int -> Int
sum_char_width' String
cs (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
lookupWithDefault_cFM "~")
              | Char
c1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' =
                  String -> Int -> Int
sum_char_width' String
rest (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
lookupWithDefault_cFM "~")
              | Bool
otherwise = case String -> Map Char [String] -> Maybe String
prefixIsKey String
full Map Char [String]
key_cFM of
                            Just key :: String
key -> String -> Int -> Int
sum_char_width'
                                        (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
key) String
full)
                                        (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Map String Int
cFM Map String Int -> String -> Int
forall k a. Ord k => Map k a -> k -> a
Map.! String
key)
                            Nothing -> if Char
c1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\\' then
                                        String -> Int -> Int
sum_char_width'
                                        ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isAlpha String
rest)
                                         (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
lookupWithDefault_cFM "~"
                                        else String -> Int -> Int
sum_char_width' String
rest Int
nl
              where nl :: Int
nl = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
lookupWithDefault_cFM [Char
c1]
          lookupWithDefault_cFM :: String -> Int
lookupWithDefault_cFM s' :: String
s' = Int -> String -> Map String Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault 2200 String
s' Map String Int
cFM
              -- 2200 may not be optimal


prefixIsKey :: String -> Map.Map Char [String] -> Maybe String
prefixIsKey :: String -> Map Char [String] -> Maybe String
prefixIsKey [] _ = Maybe String
forall a. Maybe a
Nothing
prefixIsKey ls :: String
ls@(c :: Char
c : _) key_cFM :: Map Char [String]
key_cFM = case (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
ls)
        ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> Char -> Map Char [String] -> [String]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Char
c Map Char [String]
key_cFM of
    [] -> Maybe String
forall a. Maybe a
Nothing
    s :: String
s : _ -> String -> Maybe String
forall a. a -> Maybe a
Just String
s

isLigature :: String -> Bool
isLigature :: String -> Bool
isLigature s :: String
s = case String
s of
  [_, _] -> Bool -> String -> Map String Bool -> Bool
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Bool
False String
s Map String Bool
ligatures
  _ -> Bool
False

keyword_width, structid_width, axiom_width, annotationbf_width,
    comment_width, normal_width :: String -> Int
annotationbf_width :: String -> Int
annotationbf_width = Word_type -> String -> Int
calc_word_width Word_type
AnnotationBold
keyword_width :: String -> Int
keyword_width = Word_type -> String -> Int
calc_word_width Word_type
Keyword
structid_width :: String -> Int
structid_width = Word_type -> String -> Int
calc_word_width Word_type
StructId
comment_width :: String -> Int
comment_width = Word_type -> String -> Int
calc_word_width Word_type
Comment
normal_width :: String -> Int
normal_width = Word_type -> String -> Int
calc_word_width Word_type
Normal
axiom_width :: String -> Int
axiom_width = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (String -> [Int]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Word_type -> String -> Int
calc_word_width Word_type
Axiom) ([String] -> [Int]) -> (String -> [String]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
parseAxiomString

{- |
latex_macro creates a document ('Doc') containing String
that has a zero width.
So it can be used for LaTeX-macros not needing any space, i.e.
@\textit{@ or @}@ -}
latex_macro :: String -> Doc
latex_macro :: String -> Doc
latex_macro = Int -> String -> Doc
sizedText 0

casl_keyword_latex, casl_annotationbf_latex,
       casl_axiom_latex,
       casl_comment_latex, casl_structid_latex,
       casl_normal_latex :: String -> Doc
casl_annotationbf_latex :: String -> Doc
casl_annotationbf_latex s :: String
s = Int -> String -> Doc
sizedText (String -> Int
annotationbf_width String
s) String
s
casl_structid_latex :: String -> Doc
casl_structid_latex s :: String
s = Int -> String -> Doc
sizedText (String -> Int
structid_width String
s) String
s
casl_comment_latex :: String -> Doc
casl_comment_latex s :: String
s = Int -> String -> Doc
sizedText (String -> Int
comment_width String
s) String
s
casl_keyword_latex :: String -> Doc
casl_keyword_latex s :: String
s = Int -> String -> Doc
sizedText (String -> Int
keyword_width String
s) String
s
casl_normal_latex :: String -> Doc
casl_normal_latex s :: String
s = Int -> String -> Doc
sizedText (String -> Int
normal_width String
s) String
s
casl_axiom_latex :: String -> Doc
casl_axiom_latex s :: String
s = Int -> String -> Doc
sizedText (String -> Int
axiom_width String
s) String
s

-- | sort, op, pred, type and its plurals
hc_sty_casl_keyword :: String -> Doc
hc_sty_casl_keyword :: String -> Doc
hc_sty_casl_keyword str :: String
str =
    Int -> String -> Doc
sizedText (String -> Int
keyword_width "preds") (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ '\\' Char -> ShowS
forall a. a -> [a] -> [a]
: (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
str

hc_sty_plain_keyword :: String -> Doc
hc_sty_plain_keyword :: String -> Doc
hc_sty_plain_keyword kw :: String
kw =
    String -> Doc
latex_macro "\\KW{" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
casl_keyword_latex (ShowS
escapeSpecial String
kw)
                    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
latex_macro "}"

hc_sty_small_keyword :: String -> Doc
hc_sty_small_keyword :: String -> Doc
hc_sty_small_keyword kw :: String
kw =
    String -> Doc
latex_macro "\\KW{" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
casl_annotationbf_latex (ShowS
escapeSpecial String
kw)
                    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
latex_macro "}"

hc_sty_axiom, hc_sty_structid, hc_sty_id, hc_sty_structid_indexed
    :: String -> Doc
hc_sty_structid :: String -> Doc
hc_sty_structid sid :: String
sid = String -> Doc
latex_macro "\\SId{" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
sid_doc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
latex_macro "}"
    where sid_doc :: Doc
sid_doc = String -> Doc
casl_structid_latex (ShowS
escapeSpecial String
sid)
hc_sty_structid_indexed :: String -> Doc
hc_sty_structid_indexed sid :: String
sid =
    String -> Doc
latex_macro "\\SIdIndex{" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
sid_doc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
latex_macro "}"
    where sid_doc :: Doc
sid_doc = String -> Doc
casl_structid_latex (ShowS
escapeSpecial String
sid)
hc_sty_id :: String -> Doc
hc_sty_id i :: String
i = String -> Doc
latex_macro "\\Id{" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
id_doc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
latex_macro "}"
    where id_doc :: Doc
id_doc = String -> Doc
casl_axiom_latex String
i
hc_sty_axiom :: String -> Doc
hc_sty_axiom ax :: String
ax = String -> Doc
latex_macro "\\Ax{" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
ax_doc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
latex_macro "}"
    where ax_doc :: Doc
ax_doc = String -> Doc
casl_axiom_latex String
ax

-- | flush argument doc to the right
flushright :: Doc -> Doc
flushright :: Doc -> Doc
flushright = (String -> Doc
latex_macro "\\`" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>)

-- | a constant String for the start of annotations
startAnno :: String
startAnno :: String
startAnno = "{\\small{}"

-- | a constant string ending an annotation
endAnno :: String
endAnno :: String
endAnno = "%@%small@}"

escapeSpecial :: String -> String
escapeSpecial :: ShowS
escapeSpecial = (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> String) -> ShowS) -> (Char -> String) -> ShowS
forall a b. (a -> b) -> a -> b
$ \ c :: Char
c -> if Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c "_%$&{}#" then '\\' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char
c] else
  String -> Char -> Map Char String -> String
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [Char
c] Char
c Map Char String
escapeMap

{- http://dhelta.net/hprojects/HaTeX/code/HaTeX-3.1.0/Text/LaTeX/Base/Syntax.hs
changes _ to \_{} -}

escapeLatex :: String -> String
escapeLatex :: ShowS
escapeLatex = (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> String) -> ShowS) -> (Char -> String) -> ShowS
forall a b. (a -> b) -> a -> b
$ \ c :: Char
c -> case () of
  ()
    | Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c "_%$&{}#" -> "\\Ax{\\" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: "}"
    | Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c "<|>=-!()[]?:;,./*+@" -> "\\Ax{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: "}"
    | Bool
otherwise -> String -> Char -> Map Char String -> String
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [Char
c] Char
c Map Char String
escapeMap

parseAxiomString :: String -> [String]
parseAxiomString :: String -> [String]
parseAxiomString s :: String
s = case Parsec String () [String]
-> String -> String -> Either ParseError [String]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () [String]
forall st. CharParser st [String]
axiomString "" String
s of
    Left _ -> [String
s]
    Right l :: [String]
l -> [String]
l

axiomString :: CharParser st [String]
axiomString :: CharParser st [String]
axiomString = do
  [[String]]
l <- CharParser st [String] -> ParsecT String st Identity [[String]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many CharParser st [String]
forall st. CharParser st [String]
parseAtom
  ParsecT String st Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  [String] -> CharParser st [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> CharParser st [String])
-> [String] -> CharParser st [String]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
l

parseAtom :: CharParser st [String]
parseAtom :: CharParser st [String]
parseAtom = ([[String]] -> [String])
-> ParsecT String st Identity [[String]] -> CharParser st [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    ((String -> CharParser st String
forall st. String -> CharParser st String
tryString "\\Ax{" CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> CharParser st String
forall st. String -> CharParser st String
tryString "\\Id{" CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "{")
    CharParser st String
-> ParsecT String st Identity [[String]]
-> ParsecT String st Identity [[String]]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser st [String] -> ParsecT String st Identity [[String]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many CharParser st [String]
forall st. CharParser st [String]
parseAtom ParsecT String st Identity [[String]]
-> ParsecT String st Identity Char
-> ParsecT String st Identity [[String]]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char '}')
 CharParser st [String]
-> CharParser st [String] -> CharParser st [String]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
    Char
b <- Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char '\\'
    String
s <- (Char -> String)
-> ParsecT String st Identity Char -> CharParser st String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> ShowS
forall a. a -> [a] -> [a]
: []) ((Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\ c :: Char
c -> Char -> Bool
isSpace Char
c
                                      Bool -> Bool -> Bool
|| Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c "_~^|\'\",;:.`\\{}[]%$&#()"))
         CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity Char -> CharParser st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
    [String] -> CharParser st [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
b Char -> ShowS
forall a. a -> [a] -> [a]
: String
s]
 CharParser st [String]
-> CharParser st [String] -> CharParser st [String]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
    String
s <- ParsecT String st Identity Char -> CharParser st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
    [String] -> CharParser st [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
s]
 CharParser st [String]
-> CharParser st [String] -> CharParser st [String]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
    Char
c <- (Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '}')
    [String] -> CharParser st [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char
c]]

-- | a character map for special latex characters
escapeMap :: Map.Map Char String
escapeMap :: Map Char String
escapeMap = [(Char, String)] -> Map Char String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
 [('\\', "\\Ax{\\setminus}"),
  ('^', "\\Ax{\\hat{\\ }}"),
  ('"', "''"),
  ('~', "\\Ax{\\sim}"),
  ('\160', "\\ "),
  ('\162', "\\Id{\\textcent}"),
  ('\164', "\\Id{\\textcurrency}"),
  ('\165', "\\Id{\\textyen}"),
  ('\166', "\\Id{\\textbrokenbar}"),
  ('\170', "\\Id{\\textordfeminine}"),
  ('\171', "\\Id{\\guillemotleft}"),
  ('\172', "\\Ax{\\neg}"),
  ('\173', "-"),
  ('\174', "\\Id{\\textregistered}"),
  ('\175', "\\Ax{\\bar{\\ }}"),
  ('\176', "\\Id{\\textdegree}"),
  ('\177', "\\Ax{\\pm}"),
  ('\178', "\\Ax{^2}"),
  ('\179', "\\Ax{^3}"),
  ('\180', "\\Ax{\\acute{\\ }}"),
  ('\181', "\\Ax{\\mu}"),
  ('\185', "\\Ax{^1}"),
  ('\186', "\\Id{\\textordmasculine}"),
  ('\187', "\\Id{\\guillemotright}"),
  ('\192', "\\Ax{\\grave{A}}"),
  ('\193', "\\Ax{\\acute{A}}"),
  ('\200', "\\Ax{\\grave{E}}"),
  ('\201', "\\Ax{\\acute{E}}"),
  ('\204', "\\Ax{\\grave{I}}"),
  ('\205', "\\Ax{\\acute{I}}"),
  ('\208', "\\Id{\\DH}"),
  ('\210', "\\Ax{\\grave{O}}"),
  ('\211', "\\Ax{\\acute{O}}"),
  ('\215', "\\Ax{\\times}"),
  ('\217', "\\Ax{\\grave{U}}"),
  ('\218', "\\Ax{\\acute{U}}"),
  ('\221', "\\Ax{\\acute{Y}}"),
  ('\222', "\\Id{\\TH}"),
  ('\224', "\\Ax{\\grave{a}}"),
  ('\225', "\\Ax{\\acute{a}}"),
  ('\232', "\\Ax{\\grave{e}}"),
  ('\233', "\\Ax{\\acute{e}}"),
  ('\236', "\\Ax{\\grave{\\Id{\\i}}}"),
  ('\237', "\\Ax{\\acute{\\Id{\\i}}}"),
  ('\240', "\\Id{\\dh}"),
  ('\242', "\\Ax{\\grave{o}}"),
  ('\243', "\\Ax{\\acute{o}}"),
  ('\247', "\\Ax{\\div}"),
  ('\249', "\\Ax{\\grave{u}}"),
  ('\250', "\\Ax{\\acute{u}}"),
  ('\253', "\\Ax{\\acute{y}}"),
  ('\254', "\\Id{\\th}")]

{- acute and grave characters don't work in a tabbing environment
   \textcent upto textbrokenbar requires \usepackage{textcomp}
    whereas \guillemot, eth, and thorn  \usepackage[T1]{fontenc}
-}