module Language.LaTeX.Builder.Internal where
import Prelude hiding (sqrt, min, max, lcm, gcd, log, mod, tanh, cosh, tan, sinh,
sin, cos, succ, sum, pi, mapM)
import qualified Data.List as L
import Data.Maybe
import Data.Monoid
import Data.Traversable (sequenceA, mapM)
import Control.Applicative hiding (optional)
import Control.Monad hiding (mapM)
import Control.Monad.Error (throwError)
import Language.LaTeX.Types
import Language.LaTeX.Builder.MonoidUtils
noArg :: Arg a
noArg = NoArg
starArg :: Arg a
starArg = StarArg
starToArg :: Star -> Arg a
starToArg Star = starArg
starToArg NoStar = noArg
mandatory, optional :: a -> Arg a
mandatory = Mandatory . pure
optional = Optional . pure
mandatoryLatexItem, optionalLatexItem :: LatexItem -> Arg AnyItem
mandatoryLatexItem = mandatory . latexItem
optionalLatexItem = optional . latexItem
coordinates :: a -> a -> Arg a
coordinates = Coordinates
mandatoryList :: [a] -> Arg a
mandatoryList = Mandatory
optionals :: [a] -> Arg a
optionals [] = NoArg
optionals xs = Optional xs
named :: String -> a -> Named a
named = Named
namedOpts :: [Named a] -> Arg a
namedOpts [] = NoArg
namedOpts xs = NamedOpts xs
namedArgs :: [Named a] -> Arg a
namedArgs = NamedArgs
optionalLatexItems :: [LatexItem] -> Arg AnyItem
optionalLatexItems = optionals . map latexItem
usepackage :: [AnyItem] -> PackageName -> PreambleItem
usepackage opts pkg =
preambleCmdArgs "usepackage"
[providePackage pkg, optionals opts, mandatory (packageName pkg)]
nilNote :: Note
nilNote = stringNote ""
stringNote :: String -> Note
stringNote = TextNote
intNote :: Int -> Note
intNote = IntNote
locNote :: Loc -> Note
locNote = LocNote
rawArg :: String -> Arg m
rawArg "" = NoArg
rawArg x = RawArg x
liftArg :: (Eq m, Monoid m) => m -> Arg m
liftArg x | x == ø = NoArg
| otherwise = LiftArg x
rawDecls :: [TexDecl] -> LatexItem
rawDecls = mapNonEmpty $ fmap TexDecls . sequenceA
texDecl :: String -> TexDecl
texDecl s = pure $ TexDcl s []
texDecl' :: String -> [Arg AnyItem] -> TexDecl
texDecl' s opts = TexDcl s <$> mapM (mapM anyItmM) opts
texDeclOpt :: String -> AnyItem -> TexDecl
texDeclOpt s opt = texDecl' s [optional opt]
parNote :: Key -> Note -> ParItem -> ParItem
parNote k = fmap . ParNote k
parCmdArgs :: String -> [Arg AnyItem] -> ParItem
parCmdArgs x ys = ParCmdArgs x <$> mapM (mapM anyItmM) ys
parCmdArg :: String -> AnyItem -> ParItem
parCmdArg x y = parCmdArgs x [mandatory y]
latexNote :: Key -> Note -> LatexItem -> LatexItem
latexNote k = fmap . LatexNote k
latexCmdArgs :: String -> [Arg LatexItem] -> LatexItem
latexCmdArgs x ys = LatexCmdArgs x <$> mapM sequenceA ys
latexCmdAnyArgs :: String -> [Arg AnyItem] -> LatexItem
latexCmdAnyArgs x ys = LatexCmdAnyArgs x <$> mapM (mapM anyItmM) ys
latexCmdArg :: String -> LatexItem -> LatexItem
latexCmdArg x y = latexCmdArgs x [mandatory y]
latexCmdAnyArg :: String -> AnyItem -> LatexItem
latexCmdAnyArg x y = latexCmdAnyArgs x [mandatory y]
preambleNote :: Key -> Note -> PreambleItem -> PreambleItem
preambleNote k = fmap . PreambleNote k
preambleCmdArgs :: String -> [Arg AnyItem] -> PreambleItem
preambleCmdArgs x ys = PreambleCmdArgs x <$> mapM (mapM anyItmM) ys
preambleCmdArg :: String -> AnyItem -> PreambleItem
preambleCmdArg x y = preambleCmdArgs x [mandatory y]
preambleEnv :: String -> [Arg AnyItem] -> AnyItem -> PreambleItem
preambleEnv x ys = liftM2 (PreambleEnv x) (mapM (mapM anyItmM) ys) . anyItmM
rawPreamble :: String -> PreambleItem
rawPreamble = mapNonEmpty $ pure . RawPreamble
texLength :: LatexLength -> AnyItem
texLength = AnyItem . pure . Length
mandatoryTexLength :: LatexLength -> Arg AnyItem
mandatoryTexLength = mandatory . texLength
optTexLength :: LatexLength -> Arg AnyItem
optTexLength = optional . texLength
latexItem :: LatexItem -> AnyItem
latexItem = AnyItem . fmap LatexItm
mathItem :: MathItem -> AnyItem
mathItem = AnyItem . fmap MathItm . mathItmM
parItem :: ParItem -> AnyItem
parItem = AnyItem . fmap ParItm
preambleItem :: PreambleItem -> AnyItem
preambleItem = AnyItem . fmap PreambleItm
packageName :: PackageName -> AnyItem
packageName = AnyItem . pure . PackageName
locSpecs :: [LocSpec] -> AnyItem
locSpecs = AnyItem . pure . LocSpecs
rawEncoding :: String -> Encoding
rawEncoding = Encoding
pkgName :: String -> PackageName
pkgName = PkgName
packageDependency :: PackageName -> Arg a
packageDependency = PackageAction . PackageDependency
providePackage :: PackageName -> Arg a
providePackage = PackageAction . ProvidePackage
showPaper :: LatexPaperSize -> String
showPaper A4paper = "a4paper"
showPaper (OtherPaperSize s) = s
latexPaper :: LatexPaperSize -> AnyItem
latexPaper = rawAnyTex . showPaper
otherDocumentClassKind :: String -> DocumentClassKind
otherDocumentClassKind = OtherDocumentClassKind
bool :: Bool -> AnyItem
bool True = rawAnyTex "true"
bool False = rawAnyTex "false"
coord :: Coord -> AnyItem
coord = AnyItem . pure . Coord
latexSaveBin :: SaveBin -> AnyItem
latexSaveBin = AnyItem . pure . SaveBin
latexCast :: AnyItem -> LatexItem
latexCast = fmap cast . anyItmM
where cast (LatexItm x) = x
cast x = LatexCast x
mathCast :: AnyItem -> MathItem
mathCast = MathItem . fmap cast . anyItmM
where cast (MathItm x) = x
cast x = MathCast x
parCast :: AnyItem -> ParItem
parCast = fmap cast . anyItmM
where cast (ParItm x) = x
cast x = ParCast x
preambleCast :: AnyItem -> PreambleItem
preambleCast = fmap cast . anyItmM
where cast (PreambleItm x) = x
cast x = PreambleCast x
latexEnvironmentAny :: String -> [Arg AnyItem] -> AnyItem -> LatexItem
latexEnvironmentAny x ys = liftM2 (Environment x) (mapM (mapM anyItmM) ys) . anyItmM
latexEnvironment :: String -> [Arg AnyItem] -> LatexItem -> LatexItem
latexEnvironment x ys = latexEnvironmentAny x ys . latexItem
latexEnvironmentPar :: String -> [Arg AnyItem] -> ParItem -> LatexItem
latexEnvironmentPar x ys = latexEnvironmentAny x ys . parItem
latexParModeArgs :: String -> [Arg AnyItem] -> ParItem -> LatexItem
latexParModeArgs x ys z = latexCmdAnyArgs x (ys ++ [mandatory (parItem z)])
parEnv :: String -> [Arg AnyItem] -> AnyItem -> ParItem
parEnv x ys = liftM2 (ParEnv x) (mapM (mapM anyItmM) ys) . anyItmM
parEnvironmentPar :: String -> [Arg AnyItem] -> ParItem -> ParItem
parEnvironmentPar x ys = parEnv x ys . parItem
figureLike :: String -> Star -> [LocSpec] -> ParItem -> ParItem
figureLike name star locs
= parEnvironmentPar (starize name star)
[optional . locSpecs $ locs]
listLikeEnv :: String -> [Arg LatexItem] -> [ListItem] -> ParItem
listLikeEnv name opts items =
parEnvironmentPar name ((map.fmap) latexItem opts)
(mconcat <$> mapM (fmap mkItem) items)
where mkItem (ListItm opts' contents) = ParCmdArgs "item" ((map.fmap) LatexItm opts') ⊕ contents
rawTex :: String -> LatexItem
rawTex = mapNonEmpty $ pure . RawTex
rawAnyTex :: String -> AnyItem
rawAnyTex = latexItem . rawTex
rawMath :: String -> MathItem
rawMath = MathItem . pure . RawMath
rawMathChar :: Char -> MathItem
rawMathChar = rawMath . ('{':) . (:"}")
texCmdNoArg :: String -> LatexItem
texCmdNoArg = pure . TexCmdNoArg
latexKey :: Key -> AnyItem
latexKey = AnyItem . pure . Key
latexKeys :: [Key] -> [AnyItem]
latexKeys = map latexKey
latexKeysArg :: [Key] -> Arg AnyItem
latexKeysArg = mandatoryList . latexKeys
latexKeyArg :: Key -> Arg AnyItem
latexKeyArg = mandatory . latexKey
normSpaces :: String -> String
normSpaces = unlines . map (L.unwords . words) . lines
num :: Real a => a -> AnyItem
num = texLength . fromRational . toRational
rat :: Rational -> AnyItem
rat = texLength . fromRational
space :: LatexItem
space = rawTex "{ }"
starize :: String -> Star -> String
starize s NoStar = s
starize s Star = s ++ "*"
unsafeNewsavebox :: Int -> (SaveBin, LatexItem)
unsafeNewsavebox n =
let bin = UnsafeMakeSaveBin n
in (bin, latexCmdAnyArg "newsavebox" $ latexSaveBin bin)
sectioning :: String -> (LatexItem -> ParItem,
Star -> Maybe LatexItem -> LatexItem -> ParItem)
sectioning name = (sect, sect')
where sect = sect' ø Nothing
sect' s opt arg = parCmdArgs (starize name s)
(maybeToList (fmap (optional . latexItem) opt) ++
[mandatory (latexItem arg)])
tabularLike :: ([RowSpec a] -> [Row a] -> b) -> [RowSpec (LatexM a)] -> [Row (LatexM a)] -> LatexM b
tabularLike f specs rows = do
spcs <- mapM sequenceA specs
f spcs <$> (checkRows spcs =<< mapM sequenceA rows)
checkRows :: [RowSpec a] -> [Row a] -> LatexM [Row a]
checkRows specs = mapM checkRow
where checkRow (Cells cs)
| cols /= length cs = err "wrong number of cells" cols "different from" (length cs)
| otherwise = pure $ Cells cs
checkRow Hline = pure Hline
checkRow (Cline c1 c2)
| c1 > cols = err "cline: start column too high" c1 ">" cols
| c1 < 0 = throwError "tabular: cline: negative start column"
| c2 > cols = err "cline: end column too high" c2 ">" cols
| c2 < 0 = throwError "tabular: cline: negative end column"
| otherwise = pure $ Cline c1 c2
cols = length $ filter isCol specs
isCol Rc = True
isCol Rl = True
isCol Rr = True
isCol Rvline = False
isCol (Rtext _) = False
err msg x op y = throwError $ L.unwords ["tabular:", msg, '(' : show x, op, show y ++ ")"]
bgroup, egroup, begingroup, endgroup :: TexDecl
bgroup = texDecl "bgroup"
egroup = texDecl "egroup"
begingroup = texDecl "begingroup"
endgroup = texDecl "endgroup"