{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric #-}
module Text.LaTeX.Base.Syntax
(
Measure (..)
, MathType (..)
, LaTeX (..)
, TeXArg (..)
, (<>), between
, protectString
, protectText
, matchCommand
, lookForCommand
, matchEnv
, lookForEnv
, texmap
, texmapM
, getBody
, getPreamble
) where
import Data.Text (Text,pack)
import qualified Data.Text
import qualified Data.Semigroup as Semigroup
import Data.String
import Control.Applicative
import Control.Monad (replicateM)
import Data.Functor.Identity (runIdentity)
import Data.Data (Data)
import Data.Typeable
import Test.QuickCheck
import Data.Hashable
import GHC.Generics (Generic)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif
data Measure =
Pt Double
| Mm Double
| Cm Double
| In Double
| Ex Double
| Em Double
| CustomMeasure LaTeX
deriving (Data, Eq, Generic, Show, Typeable)
data MathType = Parentheses | Square | Dollar | DoubleDollar
deriving (Data, Eq, Generic, Show, Typeable)
data LaTeX =
TeXRaw Text
| TeXComm String [TeXArg]
| TeXCommS String
| TeXEnv String [TeXArg] LaTeX
| TeXMath MathType LaTeX
| TeXLineBreak (Maybe Measure) Bool
| TeXBraces LaTeX
| TeXComment Text
| TeXSeq LaTeX LaTeX
| TeXEmpty
deriving (Data, Eq, Generic, Show, Typeable)
data TeXArg =
FixArg LaTeX
| OptArg LaTeX
| MOptArg [LaTeX]
| SymArg LaTeX
| MSymArg [LaTeX]
| ParArg LaTeX
| MParArg [LaTeX]
deriving (Data, Eq, Generic, Show, Typeable)
instance Monoid LaTeX where
mempty = TeXEmpty
mappend TeXEmpty x = x
mappend x TeXEmpty = x
mappend (TeXSeq x y) z = TeXSeq x $ mappend y z
mappend x y = TeXSeq x y
instance Semigroup.Semigroup LaTeX where
(<>) = mappend
between :: Monoid m => m -> m -> m -> m
between c l1 l2 = l1 <> c <> l2
instance IsString LaTeX where
fromString = TeXRaw . fromString . protectString
protectString :: String -> String
protectString = mconcat . fmap protectChar
protectText :: Text -> Text
protectText = Data.Text.concatMap (fromString . protectChar)
protectChar :: Char -> String
protectChar '#' = "\\#"
protectChar '$' = "\\$"
protectChar '%' = "\\%"
protectChar '^' = "\\^{}"
protectChar '&' = "\\&"
protectChar '{' = "\\{"
protectChar '}' = "\\}"
protectChar '~' = "\\~{}"
protectChar '\\' = "\\textbackslash{}"
protectChar '_' = "\\_{}"
protectChar x = [x]
lookForCommand :: String
-> LaTeX
-> [[TeXArg]]
lookForCommand = (fmap snd .) . matchCommand . (==)
matchCommand :: (String -> Bool) -> LaTeX -> [(String,[TeXArg])]
matchCommand f (TeXComm str as) =
let xs = concatMap (matchCommandArg f) as
in if f str then (str,as) : xs else xs
matchCommand f (TeXCommS str) = [(str, []) | f str]
matchCommand f (TeXEnv _ as l) =
let xs = concatMap (matchCommandArg f) as
in xs ++ matchCommand f l
matchCommand f (TeXMath _ l) = matchCommand f l
matchCommand f (TeXBraces l) = matchCommand f l
matchCommand f (TeXSeq l1 l2) = matchCommand f l1 ++ matchCommand f l2
matchCommand _ _ = []
matchCommandArg :: (String -> Bool) -> TeXArg -> [(String,[TeXArg])]
matchCommandArg f (OptArg l ) = matchCommand f l
matchCommandArg f (FixArg l ) = matchCommand f l
matchCommandArg f (MOptArg ls) = concatMap (matchCommand f) ls
matchCommandArg f (SymArg l ) = matchCommand f l
matchCommandArg f (MSymArg ls) = concatMap (matchCommand f) ls
matchCommandArg f (ParArg l ) = matchCommand f l
matchCommandArg f (MParArg ls) = concatMap (matchCommand f) ls
lookForEnv :: String -> LaTeX -> [([TeXArg],LaTeX)]
lookForEnv = (fmap (\(_,as,l) -> (as,l)) .) . matchEnv . (==)
matchEnv :: (String -> Bool) -> LaTeX -> [(String,[TeXArg],LaTeX)]
matchEnv f (TeXComm _ as) = concatMap (matchEnvArg f) as
matchEnv f (TeXEnv str as l) =
let xs = concatMap (matchEnvArg f) as
ys = matchEnv f l
zs = xs ++ ys
in if f str then (str,as,l) : zs else zs
matchEnv f (TeXMath _ l) = matchEnv f l
matchEnv f (TeXBraces l) = matchEnv f l
matchEnv f (TeXSeq l1 l2) = matchEnv f l1 ++ matchEnv f l2
matchEnv _ _ = []
matchEnvArg :: (String -> Bool) -> TeXArg -> [(String,[TeXArg],LaTeX)]
matchEnvArg f (OptArg l ) = matchEnv f l
matchEnvArg f (FixArg l ) = matchEnv f l
matchEnvArg f (MOptArg ls) = concatMap (matchEnv f) ls
matchEnvArg f (SymArg l ) = matchEnv f l
matchEnvArg f (MSymArg ls) = concatMap (matchEnv f) ls
matchEnvArg f (ParArg l ) = matchEnv f l
matchEnvArg f (MParArg ls) = concatMap (matchEnv f) ls
texmap :: (LaTeX -> Bool)
-> (LaTeX -> LaTeX)
-> LaTeX -> LaTeX
texmap c f = runIdentity . texmapM c (pure . f)
texmapM :: (Applicative m, Monad m)
=> (LaTeX -> Bool)
-> (LaTeX -> m LaTeX)
-> LaTeX -> m LaTeX
texmapM c f = go
where
go l@(TeXComm str as) = if c l then f l else TeXComm str <$> mapM go' as
go l@(TeXEnv str as b) = if c l then f l else TeXEnv str <$> mapM go' as <*> go b
go l@(TeXMath t b) = if c l then f l else TeXMath t <$> go b
go l@(TeXBraces b) = if c l then f l else TeXBraces <$> go b
go l@(TeXSeq l1 l2) = if c l then f l else liftA2 TeXSeq (go l1) (go l2)
go l = if c l then f l else pure l
go' (FixArg l ) = FixArg <$> go l
go' (OptArg l ) = OptArg <$> go l
go' (MOptArg ls) = MOptArg <$> mapM go ls
go' (SymArg l ) = SymArg <$> go l
go' (MSymArg ls) = MSymArg <$> mapM go ls
go' (ParArg l ) = ParArg <$> go l
go' (MParArg ls) = MParArg <$> mapM go ls
getBody :: LaTeX -> Maybe LaTeX
getBody l =
case lookForEnv "document" l of
((_,b):_) -> Just b
_ -> Nothing
getPreamble :: LaTeX -> LaTeX
getPreamble (TeXEnv "document" _ _) = mempty
getPreamble (TeXSeq l1 l2) = getPreamble l1 <> getPreamble l2
getPreamble l = l
arbitraryChar :: Gen Char
arbitraryChar = elements $
['A'..'Z']
++ ['a'..'z']
++ "\n-+*/!\"().,:;'@<>? "
arbitraryRaw :: Gen Text
arbitraryRaw = do
n <- choose (1,20)
protectText . pack <$> replicateM n arbitraryChar
arbitraryName :: Gen String
arbitraryName = do
n <- choose (1,10)
replicateM n $ elements $ ['a' .. 'z'] ++ ['A' .. 'Z']
instance Arbitrary Measure where
arbitrary = do
n <- choose (0,5)
let f = [Pt,Mm,Cm,In,Ex,Em] !! n
f <$> arbitrary
instance Arbitrary LaTeX where
arbitrary = arbitraryLaTeX False
arbitraryLaTeX :: Bool -> Gen LaTeX
arbitraryLaTeX inDollar = do
n <- choose (0,16 :: Int)
case n of
0 -> if inDollar then arbitraryLaTeX True else pure TeXEmpty
1 -> do m <- choose (0,5)
TeXComm <$> arbitraryName <*> vectorOf m arbitrary
2 -> TeXCommS <$> arbitraryName
3 -> do m <- choose (0,5)
TeXEnv <$> arbitraryName <*> vectorOf m arbitrary <*> arbitrary
4 -> if inDollar
then arbitraryLaTeX True
else do m <- choose (0,3)
let t = [Parentheses,Square,Dollar,DoubleDollar] !! m
TeXMath <$> pure t <*> arbitraryLaTeX (t == Dollar || t == DoubleDollar)
5 -> TeXLineBreak <$> arbitrary <*> arbitrary
6 -> TeXBraces <$> arbitrary
7 -> TeXComment <$> arbitraryRaw
8 -> TeXSeq <$> (if inDollar then arbitraryLaTeX True else arbitrary) <*> arbitrary
_ -> TeXRaw <$> arbitraryRaw
instance Arbitrary TeXArg where
arbitrary = do
n <- choose (0,6 :: Int)
case n of
0 -> OptArg <$> arbitrary
1 -> do m <- choose (1,5)
MOptArg <$> vectorOf m arbitrary
2 -> SymArg <$> arbitrary
3 -> do m <- choose (1,5)
MSymArg <$> vectorOf m arbitrary
4 -> ParArg <$> arbitrary
5 -> do m <- choose (1,5)
MParArg <$> vectorOf m arbitrary
_ -> FixArg <$> arbitrary
instance Hashable Measure
instance Hashable MathType
instance Hashable TeXArg
instance Hashable LaTeX