module Language.LaTeX.Types where
import Prelude hiding (and, foldr, foldl, foldr1, foldl1, elem, concatMap, concat)
import Data.Monoid (Monoid(..))
import Data.List (intercalate)
import Data.Ratio ((%))
import Data.Traversable
import Data.Foldable
import Data.String (IsString(..))
import Data.Data
import Data.DeriveTH
import Control.Applicative
import Control.Arrow (second)
import Control.Monad.Writer (Writer)
import Control.Monad.Trans ()
import Control.Monad.Error
data Document = Document { documentClass :: DocumentClss
, documentPreamble :: PreambleItm
, documentBody :: ParItm }
deriving (Show, Eq, Typeable, Data)
type LineNumber = Int
type CharNumber = Int
data Loc = Loc { locFile :: FilePath
, locLine :: LineNumber
, locChar :: CharNumber
}
deriving (Show, Eq, Typeable, Data)
data Note = TextNote String
| IntNote Int
| LocNote Loc
deriving (Show, Eq, Typeable, Data)
data DocumentClassKind = Article
| Book
| Report
| Letter
| OtherDocumentClassKind String
deriving (Show, Eq, Typeable, Data)
data DocumentClss
= DocClass { docClassKind :: DocumentClassKind
, docClassOptions :: [AnyItm]
}
deriving (Show, Eq, Typeable, Data)
data AnyItm = PreambleItm PreambleItm
| LatexItm LatexItm
| MathItm MathItm
| ParItm ParItm
| LocSpecs [LocSpec]
| Key Key
| PackageName PackageName
| Coord Coord
| Length LatexLength
| SaveBin SaveBin
deriving (Show, Eq, Typeable, Data)
data PreambleItm = PreambleCmdArgs String [Arg AnyItm]
| PreambleEnv String [Arg AnyItm] AnyItm
| PreambleCast AnyItm
| PreambleConcat [PreambleItm]
| RawPreamble String
| PreambleNote Key Note PreambleItm
deriving (Show, Eq, Typeable, Data)
instance Monoid PreambleItm where
mempty = PreambleConcat []
PreambleConcat xs `mappend` PreambleConcat ys = PreambleConcat (xs ++ ys)
PreambleConcat xs `mappend` y = PreambleConcat (xs ++ [y])
x `mappend` PreambleConcat ys = PreambleConcat (x : ys)
x `mappend` y = PreambleConcat [x, y]
data TexDcl = TexDcl { texDeclName :: String
, texDeclArgs :: [Arg AnyItm]
}
deriving (Show, Eq, Typeable, Data)
data LatexItm
= LatexCmdArgs String [Arg LatexItm]
| LatexCmdAnyArgs String [Arg AnyItm]
| TexDecls [TexDcl]
| TexCmdNoArg String
| TexCmdArg String LatexItm
| Environment String [Arg AnyItm] AnyItm
| RawTex String
| LatexCast AnyItm
| TexGroup LatexItm
| LatexEmpty
| LatexAppend LatexItm LatexItm
| LatexNote Key Note LatexItm
deriving (Show, Eq, Typeable, Data)
appendAny :: AnyItm -> AnyItm -> Maybe AnyItm
appendAny (PreambleItm x) (PreambleItm y) = Just $ PreambleItm (x `mappend` y)
appendAny (LatexItm x) (LatexItm y) = Just $ LatexItm (x `mappend` y)
appendAny (MathItm x) (MathItm y) = Just $ MathItm (x `mappend` y)
appendAny (ParItm x) (ParItm y) = Just $ ParItm (x `mappend` y)
appendAny (LocSpecs x) (LocSpecs y) = Just $ LocSpecs (x `mappend` y)
appendAny PreambleItm{} _ = Nothing
appendAny LatexItm{} _ = Nothing
appendAny MathItm{} _ = Nothing
appendAny ParItm{} _ = Nothing
appendAny LocSpecs{} _ = Nothing
appendAny Key{} _ = Nothing
appendAny PackageName{} _ = Nothing
appendAny Coord{} _ = Nothing
appendAny Length{} _ = Nothing
appendAny SaveBin{} _ = Nothing
instance Monoid LatexItm where
mempty = LatexEmpty
RawTex xs `mappend` RawTex ys = RawTex (xs ++ ys)
LatexCast x `mappend` LatexCast y | Just z <- appendAny x y = LatexCast z
LatexEmpty `mappend` x = x
x `mappend` LatexEmpty = x
LatexAppend x y `mappend` z = x `mappend` (y `mappend` z)
x `mappend` LatexAppend y z =
case x `mappend` y of
LatexAppend x' y' -> x' `LatexAppend` (y' `mappend` z)
xy -> xy `mappend` z
x `mappend` y = x `LatexAppend` y
instance IsString LatexItm where
fromString s
| null s = mempty
| otherwise = f s
where f = RawTex . concatMap rawhchar . intercalate "\n" . filter (not . null) . lines
data Named a = Named String a
deriving (Show, Eq, Typeable, Data)
data PackageAction = PackageDependency PackageName
| ProvidePackage PackageName
deriving (Show, Eq, Typeable, Data)
data Arg a = NoArg
| StarArg
| Mandatory [a]
| Optional [a]
| NamedArgs [Named a]
| NamedOpts [Named a]
| Coordinates a a
| RawArg String
| LiftArg a
| PackageAction PackageAction
deriving (Show, Eq, Typeable, Data)
data Star = Star | NoStar
deriving (Show, Eq, Typeable, Data)
instance Monoid Star where
mempty = NoStar
NoStar `mappend` x = x
x `mappend` _ = x
data Coord = MkCoord LatexLength LatexLength
deriving (Show, Eq, Typeable, Data)
newtype Percentage = Percentage { percentage :: Int } deriving (Eq,Show,Ord,Num)
data ParItm = ParCmdArgs String [Arg AnyItm]
| ParEnv String [Arg AnyItm] AnyItm
| Tabular [RowSpec LatexItm] [Row LatexItm]
| RawParMode String
| ParCast AnyItm
| ParGroup ParItm
| ParConcat [ParItm]
| ParNote Key Note ParItm
deriving (Show, Eq, Typeable, Data)
instance Monoid ParItm where
mempty = ParConcat []
ParConcat xs `mappend` ParConcat ys = ParConcat (xs ++ ys)
ParConcat xs `mappend` y = ParConcat (xs ++ [y])
x `mappend` ParConcat ys = ParConcat (x : ys)
x `mappend` y = ParConcat [x, y]
unParNote :: ParItm -> Maybe (Key, Note, ParItm)
unParNote (ParNote k n p) = Just (k, n, p)
unParNote _ = Nothing
uncatParItm :: ParItm -> [ParItm]
uncatParItm (ParConcat pars) = pars
uncatParItm par = [par]
newtype MathDcl = MathDcl String
deriving (Show, Eq, Typeable, Data)
data MathItm = MathDecls [MathDcl]
| MathCmdArgs String [Arg AnyItm]
| MathArray [RowSpec MathItm] [Row MathItm]
| RawMath String
| MathCast AnyItm
| MathRat Rational
| MathGroup MathItm
| MathConcat [MathItm]
| MathBinOp String MathItm MathItm
| MathUnOp String MathItm
| MathNote Key Note MathItm
deriving (Show, Eq, Typeable, Data)
instance Monoid MathItm where
mempty = MathConcat []
MathConcat xs `mappend` MathConcat ys = MathConcat (xs ++ ys)
MathConcat xs `mappend` y = MathConcat (xs ++ [y])
x `mappend` MathConcat ys = MathConcat (x : ys)
x `mappend` y = MathConcat [x, y]
instance Num MathItm where
(+) = MathBinOp "+"
(*) = MathBinOp "*"
() = MathBinOp "-"
negate = MathUnOp "-"
abs x = MathCmdArgs "abs" [Mandatory [MathItm x]]
signum = error "MathItm.signum is undefined"
fromInteger = MathRat . (%1)
instance Fractional MathItm where
(/) = MathBinOp "/"
fromRational = MathRat
data TexUnit
= Sp
| Pt
| Bp
| Dd
| Em
| Ex
| Cm
| Mm
| In
| Pc
| Cc
| Mu
deriving (Eq, Ord, Enum, Show, Typeable, Data)
data LatexLength = LengthScaledBy Rational LatexLength
| LengthCmdRatArg String Rational
| LengthCmd String
| LengthCst (Maybe TexUnit) Rational
deriving (Show, Eq, Typeable, Data)
lengthCst :: LatexLength -> Maybe (Maybe TexUnit, Rational)
lengthCst (LengthScaledBy rat len) = second (rat *) <$> lengthCst len
lengthCst (LengthCmdRatArg _ _) = Nothing
lengthCst (LengthCmd _) = Nothing
lengthCst (LengthCst mtu rat) = Just (mtu, rat)
safeLengthOp :: String -> (Rational -> Rational -> Rational) -> LatexLength -> LatexLength -> LatexLength
safeLengthOp _ op (LengthCst Nothing rx) (LengthCst munit ry)
= LengthCst munit (op rx ry)
safeLengthOp _ op (LengthCst (Just unit) rx) (LengthCst Nothing ry)
= LengthCst (Just unit) (op rx ry)
safeLengthOp op _ x y
= error $ "LatexLength." ++ op
++ ": undefined on non constants terms (" ++ show x ++ op ++ show y ++ ")"
scaleBy :: Rational -> LatexLength -> LatexLength
scaleBy rx (LengthScaledBy ry l) = LengthScaledBy (rx * ry) l
scaleBy rx (LengthCst munit ry) = LengthCst munit (rx * ry)
scaleBy rx (LengthCmd cmd) = LengthScaledBy rx (LengthCmd cmd)
scaleBy rx (LengthCmdRatArg cmd r) = LengthScaledBy rx (LengthCmdRatArg cmd r)
instance Num LatexLength where
LengthCst Nothing x * y = scaleBy x y
x * LengthCst Nothing y = scaleBy y x
x * y = safeLengthOp "*" (*) x y
(+) = safeLengthOp "+" (+)
() = safeLengthOp "-" ()
negate x = LengthCst Nothing (1) * x
abs = error "LatexLength.abs is undefined"
signum = error "LatexLength.signum is undefined"
fromInteger = LengthCst Nothing . (%1)
instance Monoid LatexLength where
mempty = 0
mappend = (+)
instance Fractional LatexLength where
x / LengthCst Nothing ry = scaleBy (1/ry) x
x / y = safeLengthOp "/" (/) x y
fromRational = LengthCst Nothing
data RowSpec a = Rc
| Rl
| Rr
| Rvline
| Rtext a
deriving (Show, Eq, Typeable, Data)
data LocSpec = Lh
| Lt
| Lb
| Lp
deriving (Show, Eq, Typeable, Data)
locSpecChar :: LocSpec -> Char
locSpecChar Lh = 'h'
locSpecChar Lt = 't'
locSpecChar Lb = 'b'
locSpecChar Lp = 'p'
data Pos = Centered
| FlushLeft
| FlushRight
| Stretch
charPos :: Pos -> Char
charPos Centered = 'c'
charPos FlushLeft = 'l'
charPos FlushRight = 'r'
charPos Stretch = 's'
data LatexPaperSize = A4paper | OtherPaperSize String
deriving (Show, Eq, Typeable, Data)
data Row cell = Cells [cell]
| Hline
| Cline Int Int
deriving (Show, Eq, Typeable, Data)
data ListItm = ListItm { itemOptions :: [Arg LatexItm], itemContents :: ParItm }
newtype PackageName = PkgName { getPkgName :: String }
deriving (Ord, Eq, Show, Typeable, Data)
newtype Key = MkKey { getKey :: String }
deriving (Eq, Show, Typeable, Data)
newtype SaveBin = UnsafeMakeSaveBin { unsafeGetSaveBin :: Int }
deriving (Eq, Show, Typeable, Data)
data LatexState = LS { freshSaveBin :: SaveBin }
instance (Error a, Eq a, Show a, Num b) => Num (Either a b) where
fromInteger = pure . fromInteger
(+) = liftM2 (+)
() = liftM2 ()
(*) = liftM2 (*)
negate = liftM negate
abs = liftM abs
signum = liftM signum
instance (Error a, Eq a, Show a, Fractional b) => Fractional (Either a b) where
(/) = liftM2 (/)
fromRational = pure . fromRational
type ErrorMessage = String
newtype LatexM a = LatexM { runLatexM :: Either ErrorMessage a }
deriving (Functor, Applicative, Monad, MonadPlus,
MonadError ErrorMessage, Show, Eq, Num, Fractional,
Typeable, Data)
instance Monoid a => Monoid (LatexM a) where
mempty = pure mempty
mappend = liftM2 mappend
mconcat = liftM mconcat . sequenceA
instance IsString a => IsString (LatexM a) where fromString = pure . fromString
type TexDecl = LatexM TexDcl
type LatexItem = LatexM LatexItm
type ParItem = LatexM ParItm
type MathDecl = LatexM MathDcl
newtype AnyItem = AnyItem { anyItmM :: LatexM AnyItm }
deriving (Eq, Show, Typeable, Data)
newtype MathItem = MathItem { mathItmM :: LatexM MathItm }
deriving (Monoid, Eq, Show, Num, Fractional, Typeable, Data)
type ListItem = LatexM ListItm
type PreambleItem = LatexM PreambleItm
type DocumentClass = LatexM DocumentClss
type TexDeclW = Writer TexDecl ()
type LatexItemW = Writer LatexItem ()
type ParItemW = Writer ParItem ()
type MathDeclW = Writer MathDecl ()
type MathItemW = Writer MathItem ()
type PreambleItemW = Writer PreambleItem ()
rawhchar :: Char -> String
rawhchar '\\' = "\\textbackslash{}"
rawhchar '<' = "\\textless{}"
rawhchar '>' = "\\textgreater{}"
rawhchar '|' = "\\textbar{}"
rawhchar x
| x `elem` "~^_#&{}$%" = ['\\',x,'{','}']
| x `elem` ":][" = ['{', x, '}']
| otherwise = [x]
newtype Encoding = Encoding { fromEncoding :: String }
deriving (Eq,Ord,Show)
$(derive makeFunctor ''Named)
$(derive makeFoldable ''Named)
$(derive makeTraversable ''Named)
$(derive makeFunctor ''Arg)
$(derive makeFoldable ''Arg)
$(derive makeTraversable ''Arg)
$(derive makeFunctor ''RowSpec)
$(derive makeFoldable ''RowSpec)
$(derive makeTraversable ''RowSpec)
$(derive makeFunctor ''Row)
$(derive makeFoldable ''Row)
$(derive makeTraversable ''Row)