hlint code improvements.
This commit is contained in:
John MacFarlane
parent
8b3707de04
commit
b8ffd834cf
66 changed files with 349 additions and 381 deletions
|
|
@ -40,8 +40,8 @@ $endif$
|
|||
.nr FL \n[LL]
|
||||
.\" footnote point size
|
||||
.nr FPS (\n[PS] - 2000)
|
||||
.\" paper size
|
||||
$if(papersize)$
|
||||
.\" paper size
|
||||
.ds paper $papersize$
|
||||
$endif$
|
||||
.\" color used for strikeout
|
||||
|
|
|
|||
|
|
@ -142,11 +142,11 @@ import qualified System.Environment as IO (lookupEnv)
|
|||
import System.FilePath.Glob (match, compile)
|
||||
import System.Directory (createDirectoryIfMissing, getDirectoryContents,
|
||||
doesDirectoryExist)
|
||||
import System.FilePath ((</>), (<.>), takeDirectory,
|
||||
takeExtension, dropExtension, isRelative, normalise)
|
||||
import System.FilePath
|
||||
((</>), (<.>), takeDirectory, takeExtension, dropExtension,
|
||||
isRelative, normalise, splitDirectories)
|
||||
import qualified System.FilePath.Glob as IO (glob)
|
||||
import qualified System.FilePath.Posix as Posix
|
||||
import System.FilePath (splitDirectories)
|
||||
import qualified System.Directory as IO (getModificationTime)
|
||||
import Control.Monad as M (fail)
|
||||
import Control.Monad.State.Strict
|
||||
|
|
|
|||
|
|
@ -51,7 +51,7 @@ applyFilters :: ReaderOptions
|
|||
-> [String]
|
||||
-> Pandoc
|
||||
-> PandocIO Pandoc
|
||||
applyFilters ropts filters args d = do
|
||||
applyFilters ropts filters args d =
|
||||
foldrM ($) d $ map applyFilter filters
|
||||
where
|
||||
applyFilter (JSONFilter f) = JSONFilter.apply ropts args f
|
||||
|
|
|
|||
|
|
@ -65,7 +65,7 @@ runLuaFilter' ropts filterPath format pd = do
|
|||
newtop <- Lua.gettop
|
||||
-- Use the returned filters, or the implicitly defined global filter if
|
||||
-- nothing was returned.
|
||||
luaFilters <- if (newtop - top >= 1)
|
||||
luaFilters <- if newtop - top >= 1
|
||||
then peek (-1)
|
||||
else Lua.getglobal "_G" *> fmap (:[]) popValue
|
||||
runAll luaFilters pd
|
||||
|
|
|
|||
|
|
@ -113,4 +113,3 @@ dataDirScript datadir moduleFile = do
|
|||
return $ case res of
|
||||
Left _ -> Nothing
|
||||
Right s -> Just (unpack s)
|
||||
|
||||
|
|
|
|||
|
|
@ -383,4 +383,3 @@ instance ToLuaStack ReaderOptions where
|
|||
LuaUtil.addValue "defaultImageExtension" defaultImageExtension
|
||||
LuaUtil.addValue "trackChanges" trackChanges
|
||||
LuaUtil.addValue "stripComments" stripComments
|
||||
|
||||
|
|
|
|||
|
|
@ -189,12 +189,12 @@ where
|
|||
|
||||
import Control.Monad.Identity
|
||||
import Control.Monad.Reader
|
||||
import Data.Char (chr, isAlphaNum, isAscii, isAsciiUpper, isHexDigit, isPunctuation, isSpace,
|
||||
ord, toLower, toUpper)
|
||||
import Data.Char (chr, isAlphaNum, isAscii, isAsciiUpper, isHexDigit,
|
||||
isPunctuation, isSpace, ord, toLower, toUpper)
|
||||
import Data.Default
|
||||
import Data.List (intercalate, isSuffixOf, transpose)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Data.Maybe (mapMaybe, fromMaybe)
|
||||
import Data.Monoid ((<>))
|
||||
import qualified Data.Set as Set
|
||||
import Data.Text (Text)
|
||||
|
|
@ -304,7 +304,7 @@ indentWith :: Stream s m Char
|
|||
=> Int -> ParserT s st m [Char]
|
||||
indentWith num = do
|
||||
tabStop <- getOption readerTabStop
|
||||
if (num < tabStop)
|
||||
if num < tabStop
|
||||
then count num (char ' ')
|
||||
else choice [ try (count num (char ' '))
|
||||
, try (char '\t' >> indentWith (num - tabStop)) ]
|
||||
|
|
@ -573,7 +573,7 @@ uri = try $ do
|
|||
let uriChunk = skipMany1 wordChar
|
||||
<|> percentEscaped
|
||||
<|> entity
|
||||
<|> (try $ punct >>
|
||||
<|> try (punct >>
|
||||
lookAhead (void (satisfy isWordChar) <|> percentEscaped))
|
||||
str <- snd <$> withRaw (skipMany1 ( () <$
|
||||
(enclosed (char '(') (char ')') uriChunk
|
||||
|
|
@ -755,7 +755,7 @@ romanOne = (char 'i' >> return (LowerRoman, 1)) <|>
|
|||
|
||||
-- | Parses an ordered list marker and returns list attributes.
|
||||
anyOrderedListMarker :: Stream s m Char => ParserT s ParserState m ListAttributes
|
||||
anyOrderedListMarker = choice $
|
||||
anyOrderedListMarker = choice
|
||||
[delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],
|
||||
numParser <- [decimal, exampleNum, defaultNum, romanOne,
|
||||
lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
|
||||
|
|
@ -896,7 +896,7 @@ widthsFromIndices numColumns' indices =
|
|||
quotient = if totLength > numColumns
|
||||
then fromIntegral totLength
|
||||
else fromIntegral numColumns
|
||||
fracs = map (\l -> (fromIntegral l) / quotient) lengths in
|
||||
fracs = map (\l -> fromIntegral l / quotient) lengths in
|
||||
tail fracs
|
||||
|
||||
---
|
||||
|
|
@ -977,7 +977,7 @@ gridTableHeader headless blocks = try $ do
|
|||
then replicate (length underDashes) ""
|
||||
else map (unlines . map trim) $ transpose
|
||||
$ map (gridTableSplitLine indices) rawContent
|
||||
heads <- fmap sequence $ mapM (parseFromString blocks . trim) rawHeads
|
||||
heads <- sequence <$> mapM (parseFromString blocks . trim) rawHeads
|
||||
return (heads, aligns, indices)
|
||||
|
||||
gridTableRawLine :: Stream s m Char => [Int] -> ParserT s st m [String]
|
||||
|
|
@ -1323,9 +1323,7 @@ failIfInQuoteContext :: (HasQuoteContext st m, Stream s m t)
|
|||
-> ParserT s st m ()
|
||||
failIfInQuoteContext context = do
|
||||
context' <- getQuoteContext
|
||||
if context' == context
|
||||
then fail "already inside quotes"
|
||||
else return ()
|
||||
when (context' == context) $ fail "already inside quotes"
|
||||
|
||||
charOrRef :: Stream s m Char => String -> ParserT s st m Char
|
||||
charOrRef cs =
|
||||
|
|
@ -1418,9 +1416,7 @@ a <+?> b = a >>= flip fmap (try b <|> return mempty) . (<>)
|
|||
extractIdClass :: Attr -> Attr
|
||||
extractIdClass (ident, cls, kvs) = (ident', cls', kvs')
|
||||
where
|
||||
ident' = case lookup "id" kvs of
|
||||
Just v -> v
|
||||
Nothing -> ident
|
||||
ident' = fromMaybe ident (lookup "id" kvs)
|
||||
cls' = case lookup "class" kvs of
|
||||
Just cl -> words cl
|
||||
Nothing -> cls
|
||||
|
|
|
|||
|
|
@ -81,7 +81,7 @@ import qualified Data.ByteString.Lazy as B
|
|||
import Data.Default (Default)
|
||||
import Data.List (delete, intersect)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Maybe (isJust, fromMaybe)
|
||||
import Data.Sequence (ViewL (..), viewl)
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Set as Set
|
||||
|
|
@ -187,7 +187,7 @@ bodyPartsToMeta' :: PandocMonad m => [BodyPart] -> DocxContext m (M.Map String M
|
|||
bodyPartsToMeta' [] = return M.empty
|
||||
bodyPartsToMeta' (bp : bps)
|
||||
| (Paragraph pPr parParts) <- bp
|
||||
, (c : _)<- intersect (pStyle pPr) (M.keys metaStyles)
|
||||
, (c : _)<- (pStyle pPr) `intersect` (M.keys metaStyles)
|
||||
, (Just metaField) <- M.lookup c metaStyles = do
|
||||
inlines <- smushInlines <$> mapM parPartToInlines parParts
|
||||
remaining <- bodyPartsToMeta' bps
|
||||
|
|
@ -340,7 +340,7 @@ blocksToInlinesWarn cmtId blks = do
|
|||
notParaOrPlain (Para _) = False
|
||||
notParaOrPlain (Plain _) = False
|
||||
notParaOrPlain _ = True
|
||||
unless (null $ filter notParaOrPlain blkList) $
|
||||
unless ( not (any notParaOrPlain blkList)) $
|
||||
lift $ P.report $ DocxParserWarning $
|
||||
"Docx comment " ++ cmtId ++ " will not retain formatting"
|
||||
return $ blocksToInlines' blkList
|
||||
|
|
@ -351,7 +351,7 @@ blocksToInlinesWarn cmtId blks = do
|
|||
parPartToInlines :: PandocMonad m => ParPart -> DocxContext m Inlines
|
||||
parPartToInlines parPart =
|
||||
case parPart of
|
||||
(BookMark _ anchor) | not $ anchor `elem` dummyAnchors -> do
|
||||
(BookMark _ anchor) | notElem anchor dummyAnchors -> do
|
||||
inHdrBool <- asks docxInHeaderBlock
|
||||
ils <- parPartToInlines' parPart
|
||||
immedPrevAnchor <- gets docxImmedPrevAnchor
|
||||
|
|
@ -444,9 +444,9 @@ parPartToInlines' (ExternalHyperLink target runs) = do
|
|||
return $ link target "" ils
|
||||
parPartToInlines' (PlainOMath exps) =
|
||||
return $ math $ writeTeX exps
|
||||
parPartToInlines' (SmartTag runs) = do
|
||||
parPartToInlines' (SmartTag runs) =
|
||||
smushInlines <$> mapM runToInlines runs
|
||||
parPartToInlines' (Field info runs) = do
|
||||
parPartToInlines' (Field info runs) =
|
||||
case info of
|
||||
HyperlinkField url -> parPartToInlines' $ ExternalHyperLink url runs
|
||||
UnknownField -> smushInlines <$> mapM runToInlines runs
|
||||
|
|
@ -626,9 +626,7 @@ bodyPartToBlocks (ListItem pPr numId lvl (Just levelInfo) parparts) = do
|
|||
(_, fmt,txt, startFromLevelInfo) = levelInfo
|
||||
start = case startFromState of
|
||||
Just n -> n + 1
|
||||
Nothing -> case startFromLevelInfo of
|
||||
Just n' -> n'
|
||||
Nothing -> 1
|
||||
Nothing -> fromMaybe 1 startFromLevelInfo
|
||||
kvs = [ ("level", lvl)
|
||||
, ("num-id", numId)
|
||||
, ("format", fmt)
|
||||
|
|
|
|||
|
|
@ -46,7 +46,7 @@ parseFieldInfo = parse fieldInfo ""
|
|||
|
||||
fieldInfo :: Parser FieldInfo
|
||||
fieldInfo =
|
||||
(try $ HyperlinkField <$> hyperlink)
|
||||
try (HyperlinkField <$> hyperlink)
|
||||
<|>
|
||||
return UnknownField
|
||||
|
||||
|
|
@ -54,7 +54,7 @@ escapedQuote :: Parser String
|
|||
escapedQuote = string "\\\""
|
||||
|
||||
inQuotes :: Parser String
|
||||
inQuotes = do
|
||||
inQuotes =
|
||||
(try escapedQuote) <|> (anyChar >>= (\c -> return [c]))
|
||||
|
||||
quotedString :: Parser String
|
||||
|
|
@ -63,7 +63,7 @@ quotedString = do
|
|||
concat <$> manyTill inQuotes (try (char '"'))
|
||||
|
||||
unquotedString :: Parser String
|
||||
unquotedString = manyTill anyChar (try (space))
|
||||
unquotedString = manyTill anyChar (try space)
|
||||
|
||||
fieldArgument :: Parser String
|
||||
fieldArgument = quotedString <|> unquotedString
|
||||
|
|
@ -82,7 +82,7 @@ hyperlink = do
|
|||
string "HYPERLINK"
|
||||
spaces
|
||||
farg <- fieldArgument
|
||||
switches <- (spaces *> many hyperlinkSwitch)
|
||||
switches <- spaces *> many hyperlinkSwitch
|
||||
let url = case switches of
|
||||
("\\l", s) : _ -> farg ++ ('#': s)
|
||||
_ -> farg
|
||||
|
|
|
|||
|
|
@ -44,14 +44,14 @@ isListItem (Div (_, classes, _) _) | "list-item" `elem` classes = True
|
|||
isListItem _ = False
|
||||
|
||||
getLevel :: Block -> Maybe Integer
|
||||
getLevel (Div (_, _, kvs) _) = fmap read $ lookup "level" kvs
|
||||
getLevel (Div (_, _, kvs) _) = read <$> lookup "level" kvs
|
||||
getLevel _ = Nothing
|
||||
|
||||
getLevelN :: Block -> Integer
|
||||
getLevelN b = fromMaybe (-1) (getLevel b)
|
||||
|
||||
getNumId :: Block -> Maybe Integer
|
||||
getNumId (Div (_, _, kvs) _) = fmap read $ lookup "num-id" kvs
|
||||
getNumId (Div (_, _, kvs) _) = read <$> lookup "num-id" kvs
|
||||
getNumId _ = Nothing
|
||||
|
||||
getNumIdN :: Block -> Integer
|
||||
|
|
@ -140,8 +140,8 @@ flatToBullets' num xs@(b : elems)
|
|||
(children, remaining) =
|
||||
span
|
||||
(\b' ->
|
||||
(getLevelN b') > bLevel ||
|
||||
((getLevelN b') == bLevel && (getNumIdN b') == bNumId))
|
||||
getLevelN b' > bLevel ||
|
||||
(getLevelN b' == bLevel && getNumIdN b' == bNumId))
|
||||
xs
|
||||
in
|
||||
case getListType b of
|
||||
|
|
|
|||
|
|
@ -358,9 +358,7 @@ archiveToDocument zf = do
|
|||
docElem <- maybeToD $ (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry
|
||||
let namespaces = elemToNameSpaces docElem
|
||||
bodyElem <- maybeToD $ findChildByName namespaces "w" "body" docElem
|
||||
let bodyElem' = case walkDocument namespaces bodyElem of
|
||||
Just e -> e
|
||||
Nothing -> bodyElem
|
||||
let bodyElem' = fromMaybe bodyElem (walkDocument namespaces bodyElem)
|
||||
body <- elemToBody namespaces bodyElem'
|
||||
return $ Document namespaces body
|
||||
|
||||
|
|
@ -603,7 +601,7 @@ elemToTblLook ns element | isElem ns "w" "tblLook" element =
|
|||
Just bitMask -> testBitMask bitMask 0x020
|
||||
Nothing -> False
|
||||
in
|
||||
return $ TblLook{firstRowFormatting = firstRowFmt}
|
||||
return TblLook{firstRowFormatting = firstRowFmt}
|
||||
elemToTblLook _ _ = throwError WrongElem
|
||||
|
||||
elemToRow :: NameSpaces -> Element -> D Row
|
||||
|
|
@ -623,7 +621,7 @@ elemToCell _ _ = throwError WrongElem
|
|||
|
||||
elemToParIndentation :: NameSpaces -> Element -> Maybe ParIndentation
|
||||
elemToParIndentation ns element | isElem ns "w" "ind" element =
|
||||
Just $ ParIndentation {
|
||||
Just ParIndentation {
|
||||
leftParIndent =
|
||||
findAttrByName ns "w" "left" element >>=
|
||||
stringToInteger
|
||||
|
|
@ -1173,8 +1171,7 @@ elemToRunElems ns element
|
|||
let font = do
|
||||
fontElem <- findElement (qualName "rFonts") element
|
||||
stringToFont =<<
|
||||
foldr (<|>) Nothing (
|
||||
map (flip findAttr fontElem . qualName) ["ascii", "hAnsi"])
|
||||
foldr ((<|>) . (flip findAttr fontElem . qualName)) Nothing ["ascii", "hAnsi"]
|
||||
local (setFont font) (mapD (elemToRunElem ns) (elChildren element))
|
||||
elemToRunElems _ _ = throwError WrongElem
|
||||
|
||||
|
|
|
|||
|
|
@ -43,14 +43,14 @@ module Text.Pandoc.Readers.HTML ( readHtml
|
|||
) where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Arrow ((***))
|
||||
import Control.Arrow (first)
|
||||
import Control.Monad (guard, mplus, msum, mzero, unless, void)
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.Reader (ReaderT, ask, asks, lift, local, runReaderT)
|
||||
import Data.Char (isAlphaNum, isDigit, isLetter)
|
||||
import Data.Default (Default (..), def)
|
||||
import Data.Foldable (for_)
|
||||
import Data.List (intercalate, isPrefixOf)
|
||||
import Data.List (isPrefixOf)
|
||||
import Data.List.Split (wordsBy, splitWhen)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
|
|
@ -777,7 +777,7 @@ pCode = try $ do
|
|||
(TagOpen open attr') <- pSatisfy $ tagOpen (`elem` ["code","tt"]) (const True)
|
||||
let attr = toStringAttr attr'
|
||||
result <- manyTill pAnyTag (pCloses open)
|
||||
return $ B.codeWith (mkAttr attr) $ intercalate " " $ lines $ T.unpack $
|
||||
return $ B.codeWith (mkAttr attr) $ unwords $ lines $ T.unpack $
|
||||
innerText result
|
||||
|
||||
pSpan :: PandocMonad m => TagParser m Inlines
|
||||
|
|
@ -1227,7 +1227,7 @@ stripPrefixes = map stripPrefix
|
|||
|
||||
stripPrefix :: Tag Text -> Tag Text
|
||||
stripPrefix (TagOpen s as) =
|
||||
TagOpen (stripPrefix' s) (map (stripPrefix' *** id) as)
|
||||
TagOpen (stripPrefix' s) (map (first stripPrefix') as)
|
||||
stripPrefix (TagClose s) = TagClose (stripPrefix' s)
|
||||
stripPrefix x = x
|
||||
|
||||
|
|
|
|||
|
|
@ -494,4 +494,3 @@ parseInline (Elem e) =
|
|||
"" -> []
|
||||
l -> [l]
|
||||
return $ codeWith (attrValue "id" e,classes',[]) $ strContentRecursive e
|
||||
|
||||
|
|
|
|||
|
|
@ -272,7 +272,7 @@ rawLaTeXBlock = do
|
|||
lookAhead (try (char '\\' >> letter))
|
||||
-- we don't want to apply newly defined latex macros to their own
|
||||
-- definitions:
|
||||
(snd <$> rawLaTeXParser macroDef)
|
||||
snd <$> rawLaTeXParser macroDef
|
||||
<|> ((snd <$> rawLaTeXParser (environment <|> blockCommand)) >>= applyMacros)
|
||||
|
||||
rawLaTeXInline :: (PandocMonad m, HasMacros s, HasReaderOptions s)
|
||||
|
|
@ -351,7 +351,7 @@ totoks pos t =
|
|||
Tok pos (Arg i) ("#" <> t1)
|
||||
: totoks (incSourceColumn pos (1 + T.length t1)) t2
|
||||
Nothing ->
|
||||
Tok pos Symbol ("#")
|
||||
Tok pos Symbol "#"
|
||||
: totoks (incSourceColumn pos 1) t2
|
||||
| c == '^' ->
|
||||
case T.uncons rest of
|
||||
|
|
@ -369,10 +369,10 @@ totoks pos t =
|
|||
| d < '\128' ->
|
||||
Tok pos Esc1 (T.pack ['^','^',d])
|
||||
: totoks (incSourceColumn pos 3) rest''
|
||||
_ -> Tok pos Symbol ("^") :
|
||||
Tok (incSourceColumn pos 1) Symbol ("^") :
|
||||
_ -> Tok pos Symbol "^" :
|
||||
Tok (incSourceColumn pos 1) Symbol "^" :
|
||||
totoks (incSourceColumn pos 2) rest'
|
||||
_ -> Tok pos Symbol ("^")
|
||||
_ -> Tok pos Symbol "^"
|
||||
: totoks (incSourceColumn pos 1) rest
|
||||
| otherwise ->
|
||||
Tok pos Symbol (T.singleton c) : totoks (incSourceColumn pos 1) rest
|
||||
|
|
@ -454,7 +454,7 @@ doMacros n = do
|
|||
addTok _ (Tok _ (CtrlSeq x) txt)
|
||||
acc@(Tok _ Word _ : _)
|
||||
| not (T.null txt) &&
|
||||
(isLetter (T.last txt)) =
|
||||
isLetter (T.last txt) =
|
||||
Tok spos (CtrlSeq x) (txt <> " ") : acc
|
||||
addTok _ t acc = setpos spos t : acc
|
||||
ts' <- getInput
|
||||
|
|
@ -1244,7 +1244,7 @@ inlineEnvironments = M.fromList [
|
|||
]
|
||||
|
||||
inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)
|
||||
inlineCommands = M.union inlineLanguageCommands $ M.fromList $
|
||||
inlineCommands = M.union inlineLanguageCommands $ M.fromList
|
||||
[ ("emph", extractSpaces emph <$> tok)
|
||||
, ("textit", extractSpaces emph <$> tok)
|
||||
, ("textsl", extractSpaces emph <$> tok)
|
||||
|
|
@ -1501,7 +1501,7 @@ foreignlanguage :: PandocMonad m => LP m Inlines
|
|||
foreignlanguage = do
|
||||
babelLang <- T.unpack . untokenize <$> braced
|
||||
case babelLangToBCP47 babelLang of
|
||||
Just lang -> spanWith ("", [], [("lang", renderLang $ lang)]) <$> tok
|
||||
Just lang -> spanWith ("", [], [("lang", renderLang lang)]) <$> tok
|
||||
_ -> tok
|
||||
|
||||
inlineLanguageCommands :: PandocMonad m => M.Map Text (LP m Inlines)
|
||||
|
|
@ -2021,7 +2021,7 @@ closing = do
|
|||
return $ para (trimInlines contents) <> sigs
|
||||
|
||||
blockCommands :: PandocMonad m => M.Map Text (LP m Blocks)
|
||||
blockCommands = M.fromList $
|
||||
blockCommands = M.fromList
|
||||
[ ("par", mempty <$ skipopts)
|
||||
, ("parbox", skipopts >> braced >> grouped blocks)
|
||||
, ("title", mempty <$ (skipopts *>
|
||||
|
|
@ -2444,7 +2444,7 @@ parseAligns = try $ do
|
|||
spaces
|
||||
spec <- braced
|
||||
case safeRead ds of
|
||||
Just n -> do
|
||||
Just n ->
|
||||
getInput >>= setInput . (mconcat (replicate n spec) ++)
|
||||
Nothing -> fail $ "Could not parse " ++ ds ++ " as number"
|
||||
bgroup
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ import Control.Monad
|
|||
import Control.Monad.Except (throwError)
|
||||
import Data.Char (isAlphaNum, isPunctuation, isSpace, toLower)
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import Data.List (findIndex, intercalate, sortBy, transpose)
|
||||
import Data.List (intercalate, sortBy, transpose, elemIndex)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import Data.Monoid ((<>))
|
||||
|
|
@ -162,16 +162,14 @@ inlinesInBalancedBrackets =
|
|||
stripBracket xs = if last xs == ']' then init xs else xs
|
||||
go :: PandocMonad m => Int -> MarkdownParser m ()
|
||||
go 0 = return ()
|
||||
go openBrackets = do
|
||||
go openBrackets =
|
||||
(() <$ (escapedChar <|>
|
||||
code <|>
|
||||
rawHtmlInline <|>
|
||||
rawLaTeXInline') >> go openBrackets)
|
||||
code <|>
|
||||
rawHtmlInline <|>
|
||||
rawLaTeXInline') >> go openBrackets)
|
||||
<|>
|
||||
(do char ']'
|
||||
if openBrackets > 1
|
||||
then go (openBrackets - 1)
|
||||
else return ())
|
||||
Control.Monad.when (openBrackets > 1) $ go (openBrackets - 1))
|
||||
<|>
|
||||
(char '[' >> go (openBrackets + 1))
|
||||
<|>
|
||||
|
|
@ -257,13 +255,13 @@ yamlMetaBlock = try $ do
|
|||
v' <- yamlToMeta v
|
||||
let k' = T.unpack k
|
||||
updateState $ \st -> st{ stateMeta' =
|
||||
(do m <- stateMeta' st
|
||||
-- if there's already a value, leave it unchanged
|
||||
case lookupMeta k' m of
|
||||
Just _ -> return m
|
||||
Nothing -> do
|
||||
v'' <- v'
|
||||
return $ B.setMeta (T.unpack k) v'' m)}
|
||||
do m <- stateMeta' st
|
||||
-- if there's already a value, leave it unchanged
|
||||
case lookupMeta k' m of
|
||||
Just _ -> return m
|
||||
Nothing -> do
|
||||
v'' <- v'
|
||||
return $ B.setMeta (T.unpack k) v'' m}
|
||||
) alist
|
||||
Right Yaml.Null -> return ()
|
||||
Right _ -> do
|
||||
|
|
@ -596,7 +594,7 @@ setextHeader = try $ do
|
|||
underlineChar <- oneOf setextHChars
|
||||
many (char underlineChar)
|
||||
blanklines
|
||||
let level = fromMaybe 0 (findIndex (== underlineChar) setextHChars) + 1
|
||||
let level = fromMaybe 0 (elemIndex underlineChar setextHChars) + 1
|
||||
attr' <- registerHeader attr (runF text defaultParserState)
|
||||
guardDisabled Ext_implicit_header_references
|
||||
<|> registerImplicitHeader raw attr'
|
||||
|
|
@ -851,7 +849,7 @@ orderedListStart mbstydelim = try $ do
|
|||
return (num, style, delim))
|
||||
|
||||
listStart :: PandocMonad m => MarkdownParser m ()
|
||||
listStart = bulletListStart <|> (Control.Monad.void (orderedListStart Nothing))
|
||||
listStart = bulletListStart <|> Control.Monad.void (orderedListStart Nothing)
|
||||
|
||||
listLine :: PandocMonad m => Int -> MarkdownParser m String
|
||||
listLine continuationIndent = try $ do
|
||||
|
|
@ -881,7 +879,7 @@ rawListItem fourSpaceRule start = try $ do
|
|||
pos2 <- getPosition
|
||||
let continuationIndent = if fourSpaceRule
|
||||
then 4
|
||||
else (sourceColumn pos2 - sourceColumn pos1)
|
||||
else sourceColumn pos2 - sourceColumn pos1
|
||||
first <- listLineCommon
|
||||
rest <- many (do notFollowedBy listStart
|
||||
notFollowedBy (() <$ codeBlockFenced)
|
||||
|
|
@ -912,10 +910,10 @@ listContinuation continuationIndent = try $ do
|
|||
return $ concat (x:xs) ++ blanks
|
||||
|
||||
notFollowedByDivCloser :: PandocMonad m => MarkdownParser m ()
|
||||
notFollowedByDivCloser = do
|
||||
notFollowedByDivCloser =
|
||||
guardDisabled Ext_fenced_divs <|>
|
||||
do divLevel <- stateFencedDivLevel <$> getState
|
||||
guard (divLevel < 1) <|> notFollowedBy divFenceEnd
|
||||
do divLevel <- stateFencedDivLevel <$> getState
|
||||
guard (divLevel < 1) <|> notFollowedBy divFenceEnd
|
||||
|
||||
notFollowedByHtmlCloser :: PandocMonad m => MarkdownParser m ()
|
||||
notFollowedByHtmlCloser = do
|
||||
|
|
@ -1222,7 +1220,7 @@ simpleTableHeader headless = try $ do
|
|||
if headless
|
||||
then lookAhead anyLine
|
||||
else return rawContent
|
||||
let aligns = zipWith alignType (map ((: [])) rawHeads) lengths
|
||||
let aligns = zipWith alignType (map (: []) rawHeads) lengths
|
||||
let rawHeads' = if headless
|
||||
then replicate (length dashes) ""
|
||||
else rawHeads
|
||||
|
|
@ -1418,11 +1416,11 @@ pipeTableHeaderPart = try $ do
|
|||
skipMany spaceChar
|
||||
let len = length pipe + maybe 0 (const 1) left + maybe 0 (const 1) right
|
||||
return
|
||||
((case (left,right) of
|
||||
(Nothing,Nothing) -> AlignDefault
|
||||
(Just _,Nothing) -> AlignLeft
|
||||
(Nothing,Just _) -> AlignRight
|
||||
(Just _,Just _) -> AlignCenter), len)
|
||||
(case (left,right) of
|
||||
(Nothing,Nothing) -> AlignDefault
|
||||
(Just _,Nothing) -> AlignLeft
|
||||
(Nothing,Just _) -> AlignRight
|
||||
(Just _,Just _) -> AlignCenter, len)
|
||||
|
||||
-- Succeed only if current line contains a pipe.
|
||||
scanForPipe :: PandocMonad m => ParserT [Char] st m ()
|
||||
|
|
@ -1929,7 +1927,7 @@ rawConTeXtEnvironment = try $ do
|
|||
(try $ string "\\stop" >> string completion)
|
||||
return $ "\\start" ++ completion ++ concat contents ++ "\\stop" ++ completion
|
||||
|
||||
inBrackets :: PandocMonad m => (ParserT [Char] st m Char) -> ParserT [Char] st m String
|
||||
inBrackets :: PandocMonad m => ParserT [Char] st m Char -> ParserT [Char] st m String
|
||||
inBrackets parser = do
|
||||
char '['
|
||||
contents <- many parser
|
||||
|
|
@ -2150,6 +2148,6 @@ doubleQuoted :: PandocMonad m => MarkdownParser m (F Inlines)
|
|||
doubleQuoted = try $ do
|
||||
doubleQuoteStart
|
||||
contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)
|
||||
(withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return
|
||||
withQuoteContext InDoubleQuote (doubleQuoteEnd >> return
|
||||
(fmap B.doubleQuoted . trimInlinesF $ contents))
|
||||
<|> (return $ return (B.str "\8220") <> contents)
|
||||
<|> return (return (B.str "\8220") <> contents)
|
||||
|
|
|
|||
|
|
@ -482,7 +482,7 @@ definitionList :: PandocMonad m => MuseParser m (F Blocks)
|
|||
definitionList = try $ do
|
||||
many spaceChar
|
||||
pos <- getPosition
|
||||
(guardDisabled Ext_amuse) <|> (guard (sourceColumn pos /= 1)) -- Initial space is required by Amusewiki, but not Emacs Muse
|
||||
guardDisabled Ext_amuse <|> guard (sourceColumn pos /= 1) -- Initial space is required by Amusewiki, but not Emacs Muse
|
||||
first <- definitionListItem 0
|
||||
rest <- many $ try (optionMaybe blankline >> definitionListItem (sourceColumn pos - 1))
|
||||
return $ B.definitionList <$> sequence (first : rest)
|
||||
|
|
|
|||
|
|
@ -211,9 +211,9 @@ a ^>>?% f = arr a >>?^ (uncurry f)
|
|||
---
|
||||
(>>?%?) :: (ArrowChoice a)
|
||||
=> FallibleArrow a x f (b,b')
|
||||
-> (b -> b' -> (Either f c))
|
||||
-> (b -> b' -> Either f c)
|
||||
-> FallibleArrow a x f c
|
||||
a >>?%? f = a >>?^? (uncurry f)
|
||||
a >>?%? f = a >>?^? uncurry f
|
||||
|
||||
infixr 1 >>?, >>?^, >>?^?
|
||||
infixr 1 ^>>?, >>?!
|
||||
|
|
|
|||
|
|
@ -322,7 +322,7 @@ type InlineModifier = Inlines -> Inlines
|
|||
modifierFromStyleDiff :: PropertyTriple -> InlineModifier
|
||||
modifierFromStyleDiff propertyTriple =
|
||||
composition $
|
||||
(getVPosModifier propertyTriple)
|
||||
getVPosModifier propertyTriple
|
||||
: map (first ($ propertyTriple) >>> ifThen_else ignore)
|
||||
[ (hasEmphChanged , emph )
|
||||
, (hasChanged isStrong , strong )
|
||||
|
|
@ -352,7 +352,7 @@ modifierFromStyleDiff propertyTriple =
|
|||
]
|
||||
|
||||
hasChanged property triple@(_, property -> newProperty, _) =
|
||||
maybe True (/=newProperty) (lookupPreviousValue property triple)
|
||||
(/= Just newProperty) (lookupPreviousValue property triple)
|
||||
|
||||
hasChangedM property triple@(_, textProps,_) =
|
||||
fromMaybe False $ (/=) <$> property textProps <*> lookupPreviousValueM property triple
|
||||
|
|
@ -362,7 +362,7 @@ modifierFromStyleDiff propertyTriple =
|
|||
lookupPreviousValueM f = lookupPreviousStyleValue ((f =<<).textProperties)
|
||||
|
||||
lookupPreviousStyleValue f (ReaderState{..},_,mFamily)
|
||||
= ( findBy f $ extendedStylePropertyChain styleTrace styleSet )
|
||||
= findBy f (extendedStylePropertyChain styleTrace styleSet)
|
||||
<|> ( f =<< fmap (lookupDefaultStyle' styleSet) mFamily )
|
||||
|
||||
|
||||
|
|
@ -793,8 +793,7 @@ read_image_src = matchingElement NsDraw "image"
|
|||
Left _ -> returnV "" -< ()
|
||||
|
||||
read_frame_title :: InlineMatcher
|
||||
read_frame_title = matchingElement NsSVG "title"
|
||||
$ (matchChildContent [] read_plain_text)
|
||||
read_frame_title = matchingElement NsSVG "title" (matchChildContent [] read_plain_text)
|
||||
|
||||
read_frame_text_box :: InlineMatcher
|
||||
read_frame_text_box = matchingElement NsDraw "text-box"
|
||||
|
|
@ -803,12 +802,12 @@ read_frame_text_box = matchingElement NsDraw "text-box"
|
|||
arr read_img_with_caption -< toList paragraphs
|
||||
|
||||
read_img_with_caption :: [Block] -> Inlines
|
||||
read_img_with_caption ((Para [Image attr alt (src,title)]) : _) =
|
||||
read_img_with_caption (Para [Image attr alt (src,title)] : _) =
|
||||
singleton (Image attr alt (src, 'f':'i':'g':':':title)) -- no text, default caption
|
||||
read_img_with_caption (Para (Image attr _ (src,title) : txt) : _) =
|
||||
singleton (Image attr txt (src, 'f':'i':'g':':':title) ) -- override caption with the text that follows
|
||||
read_img_with_caption ( (Para (_ : xs)) : ys) =
|
||||
read_img_with_caption ((Para xs) : ys)
|
||||
read_img_with_caption ( Para (_ : xs) : ys) =
|
||||
read_img_with_caption (Para xs : ys)
|
||||
read_img_with_caption _ =
|
||||
mempty
|
||||
|
||||
|
|
@ -909,8 +908,8 @@ post_process (Pandoc m blocks) =
|
|||
Pandoc m (post_process' blocks)
|
||||
|
||||
post_process' :: [Block] -> [Block]
|
||||
post_process' ((Table _ a w h r) : (Div ("", ["caption"], _) [Para inlines] ) : xs) =
|
||||
(Table inlines a w h r) : ( post_process' xs )
|
||||
post_process' (Table _ a w h r : Div ("", ["caption"], _) [Para inlines] : xs) =
|
||||
Table inlines a w h r : post_process' xs
|
||||
post_process' bs = bs
|
||||
|
||||
read_body :: OdtReader _x (Pandoc, MediaBag)
|
||||
|
|
|
|||
|
|
@ -48,7 +48,7 @@ instance NameSpaceID Namespace where
|
|||
|
||||
|
||||
findID :: NameSpaceIRI -> Maybe Namespace
|
||||
findID iri = listToMaybe [nsID | (iri',~nsID) <- nsIDs, iri' `isPrefixOf` iri]
|
||||
findID iri = listToMaybe [nsID | (iri',nsID) <- nsIDs, iri' `isPrefixOf` iri]
|
||||
|
||||
nsIDmap :: NameSpaceIRIs Namespace
|
||||
nsIDmap = foldr (uncurry $ flip M.insert) M.empty nsIDs
|
||||
|
|
|
|||
|
|
@ -131,13 +131,12 @@ type StyleReaderSafe a b = XMLReaderSafe FontPitches a b
|
|||
-- | A reader for font pitches
|
||||
fontPitchReader :: XMLReader _s _x FontPitches
|
||||
fontPitchReader = executeIn NsOffice "font-face-decls" (
|
||||
( withEveryL NsStyle "font-face" $ liftAsSuccess (
|
||||
withEveryL NsStyle "font-face" (liftAsSuccess (
|
||||
findAttr' NsStyle "name"
|
||||
&&&
|
||||
lookupDefaultingAttr NsStyle "font-pitch"
|
||||
)
|
||||
)
|
||||
>>?^ ( M.fromList . (foldl accumLegalPitches []) )
|
||||
))
|
||||
>>?^ ( M.fromList . foldl accumLegalPitches [] )
|
||||
)
|
||||
where accumLegalPitches ls (Nothing,_) = ls
|
||||
accumLegalPitches ls (Just n,p) = (n,p):ls
|
||||
|
|
@ -383,11 +382,11 @@ data ListLevelStyle = ListLevelStyle { listLevelType :: ListLevelType
|
|||
|
||||
instance Show ListLevelStyle where
|
||||
show ListLevelStyle{..} = "<LLS|"
|
||||
++ (show listLevelType)
|
||||
++ show listLevelType
|
||||
++ "|"
|
||||
++ (maybeToString listItemPrefix)
|
||||
++ (show listItemFormat)
|
||||
++ (maybeToString listItemSuffix)
|
||||
++ maybeToString listItemPrefix
|
||||
++ show listItemFormat
|
||||
++ maybeToString listItemSuffix
|
||||
++ ">"
|
||||
where maybeToString = fromMaybe ""
|
||||
|
||||
|
|
@ -483,14 +482,14 @@ readTextProperties =
|
|||
( liftA6 PropT
|
||||
( searchAttr NsXSL_FO "font-style" False isFontEmphasised )
|
||||
( searchAttr NsXSL_FO "font-weight" False isFontBold )
|
||||
( findPitch )
|
||||
findPitch
|
||||
( getAttr NsStyle "text-position" )
|
||||
( readUnderlineMode )
|
||||
( readStrikeThroughMode )
|
||||
readUnderlineMode
|
||||
readStrikeThroughMode
|
||||
)
|
||||
where isFontEmphasised = [("normal",False),("italic",True),("oblique",True)]
|
||||
isFontBold = ("normal",False):("bold",True)
|
||||
:(map ((,True).show) ([100,200..900]::[Int]))
|
||||
:map ((,True).show) ([100,200..900]::[Int])
|
||||
|
||||
readUnderlineMode :: StyleReaderSafe _x (Maybe UnderlineMode)
|
||||
readUnderlineMode = readLineMode "text-underline-mode"
|
||||
|
|
@ -510,7 +509,7 @@ readLineMode modeAttr styleAttr = proc x -> do
|
|||
Nothing -> returnA -< Just UnderlineModeNormal
|
||||
else returnA -< Nothing
|
||||
where
|
||||
isLinePresent = [("none",False)] ++ map (,True)
|
||||
isLinePresent = ("none",False) : map (,True)
|
||||
[ "dash" , "dot-dash" , "dot-dot-dash" , "dotted"
|
||||
, "long-dash" , "solid" , "wave"
|
||||
]
|
||||
|
|
@ -547,20 +546,18 @@ readListStyle =
|
|||
findAttr NsStyle "name"
|
||||
>>?! keepingTheValue
|
||||
( liftA ListStyle
|
||||
$ ( liftA3 SM.union3
|
||||
$ liftA3 SM.union3
|
||||
( readListLevelStyles NsText "list-level-style-number" LltNumbered )
|
||||
( readListLevelStyles NsText "list-level-style-bullet" LltBullet )
|
||||
( readListLevelStyles NsText "list-level-style-image" LltImage )
|
||||
) >>^ M.mapMaybe chooseMostSpecificListLevelStyle
|
||||
( readListLevelStyles NsText "list-level-style-image" LltImage ) >>^ M.mapMaybe chooseMostSpecificListLevelStyle
|
||||
)
|
||||
--
|
||||
readListLevelStyles :: Namespace -> ElementName
|
||||
-> ListLevelType
|
||||
-> StyleReaderSafe _x (SM.SetMap Int ListLevelStyle)
|
||||
readListLevelStyles namespace elementName levelType =
|
||||
( tryAll namespace elementName (readListLevelStyle levelType)
|
||||
tryAll namespace elementName (readListLevelStyle levelType)
|
||||
>>^ SM.fromList
|
||||
)
|
||||
|
||||
--
|
||||
readListLevelStyle :: ListLevelType -> StyleReader _x (Int, ListLevelStyle)
|
||||
|
|
@ -632,7 +629,7 @@ parents style styles = unfoldr findNextParent style -- Ha!
|
|||
getStyleFamily :: Style -> Styles -> Maybe StyleFamily
|
||||
getStyleFamily style@Style{..} styles
|
||||
= styleFamily
|
||||
<|> (F.asum $ map (`getStyleFamily` styles) $ parents style styles)
|
||||
<|> F.asum (map (`getStyleFamily` styles) $ parents style styles)
|
||||
|
||||
-- | Each 'Style' has certain 'StyleProperties'. But sometimes not all property
|
||||
-- values are specified. Instead, a value might be inherited from a
|
||||
|
|
@ -654,7 +651,7 @@ stylePropertyChain style styles
|
|||
--
|
||||
extendedStylePropertyChain :: [Style] -> Styles -> [StyleProperties]
|
||||
extendedStylePropertyChain [] _ = []
|
||||
extendedStylePropertyChain [style] styles = (stylePropertyChain style styles)
|
||||
++ (maybeToList (fmap (lookupDefaultStyle' styles) (getStyleFamily style styles)))
|
||||
extendedStylePropertyChain (style:trace) styles = (stylePropertyChain style styles)
|
||||
++ (extendedStylePropertyChain trace styles)
|
||||
extendedStylePropertyChain [style] styles = stylePropertyChain style styles
|
||||
++ maybeToList (fmap (lookupDefaultStyle' styles) (getStyleFamily style styles))
|
||||
extendedStylePropertyChain (style:trace) styles = stylePropertyChain style styles
|
||||
++ extendedStylePropertyChain trace styles
|
||||
|
|
|
|||
|
|
@ -516,7 +516,7 @@ include = try $ do
|
|||
blocksParser <- case includeArgs of
|
||||
("example" : _) -> return $ pure . B.codeBlock <$> parseRaw
|
||||
["export"] -> return . returnF $ B.fromList []
|
||||
("export" : format : []) -> return $ pure . B.rawBlock format <$> parseRaw
|
||||
["export", format] -> return $ pure . B.rawBlock format <$> parseRaw
|
||||
("src" : rest) -> do
|
||||
let attr = case rest of
|
||||
[lang] -> (mempty, [lang], mempty)
|
||||
|
|
|
|||
|
|
@ -1263,7 +1263,7 @@ simpleTableHeader headless = try $ do
|
|||
let rawHeads = if headless
|
||||
then replicate (length dashes) ""
|
||||
else simpleTableSplitLine indices rawContent
|
||||
heads <- mapM ( (parseFromString' (mconcat <$> many plain)) . trim) rawHeads
|
||||
heads <- mapM ( parseFromString' (mconcat <$> many plain) . trim) rawHeads
|
||||
return (heads, aligns, indices)
|
||||
|
||||
-- Parse a simple table.
|
||||
|
|
@ -1414,7 +1414,7 @@ renderRole contents fmt role attr = case role of
|
|||
pepUrl = "http://www.python.org/dev/peps/pep-" ++ padNo ++ "/"
|
||||
|
||||
addClass :: String -> Attr -> Attr
|
||||
addClass c (ident, classes, keyValues) = (ident, union classes [c], keyValues)
|
||||
addClass c (ident, classes, keyValues) = (ident, classes `union` [c], keyValues)
|
||||
|
||||
roleName :: PandocMonad m => RSTParser m String
|
||||
roleName = many1 (letter <|> char '-')
|
||||
|
|
@ -1454,7 +1454,7 @@ endline = try $ do
|
|||
notFollowedBy blankline
|
||||
-- parse potential list-starts at beginning of line differently in a list:
|
||||
st <- getState
|
||||
when ((stateParserContext st) == ListItemState) $ notFollowedBy (anyOrderedListMarker >> spaceChar) >>
|
||||
when (stateParserContext st == ListItemState) $ notFollowedBy (anyOrderedListMarker >> spaceChar) >>
|
||||
notFollowedBy' bulletListStart
|
||||
return B.softbreak
|
||||
|
||||
|
|
@ -1577,7 +1577,7 @@ note = try $ do
|
|||
-- not yet in this implementation.
|
||||
updateState $ \st -> st{ stateNotes = [] }
|
||||
contents <- parseFromString' parseBlocks raw
|
||||
let newnotes = if (ref == "*" || ref == "#") -- auto-numbered
|
||||
let newnotes = if ref == "*" || ref == "#" -- auto-numbered
|
||||
-- delete the note so the next auto-numbered note
|
||||
-- doesn't get the same contents:
|
||||
then deleteFirstsBy (==) notes [(ref,raw)]
|
||||
|
|
|
|||
|
|
@ -110,7 +110,7 @@ noteBlock = try $ do
|
|||
startPos <- getPosition
|
||||
ref <- noteMarker
|
||||
optional blankline
|
||||
contents <- fmap unlines $ many1Till anyLine (blanklines <|> noteBlock)
|
||||
contents <- unlines <$> many1Till anyLine (blanklines <|> noteBlock)
|
||||
endPos <- getPosition
|
||||
let newnote = (ref, contents ++ "\n")
|
||||
st <- getState
|
||||
|
|
@ -360,7 +360,7 @@ cellAttributes = try $ do
|
|||
tableCell :: PandocMonad m => ParserT [Char] ParserState m ((Bool, Alignment), Blocks)
|
||||
tableCell = try $ do
|
||||
char '|'
|
||||
(isHeader, alignment) <- option (False, AlignDefault) $ cellAttributes
|
||||
(isHeader, alignment) <- option (False, AlignDefault) cellAttributes
|
||||
notFollowedBy blankline
|
||||
raw <- trim <$>
|
||||
many (noneOf "|\n" <|> try (char '\n' <* notFollowedBy blankline))
|
||||
|
|
@ -499,7 +499,7 @@ copy = do
|
|||
|
||||
note :: PandocMonad m => ParserT [Char] ParserState m Inlines
|
||||
note = try $ do
|
||||
ref <- (char '[' *> many1 digit <* char ']')
|
||||
ref <- char '[' *> many1 digit <* char ']'
|
||||
notes <- stateNotes <$> getState
|
||||
case lookup ref notes of
|
||||
Nothing -> fail "note not found"
|
||||
|
|
@ -530,7 +530,7 @@ hyphenedWords = do
|
|||
wordChunk :: PandocMonad m => ParserT [Char] ParserState m String
|
||||
wordChunk = try $ do
|
||||
hd <- noneOf wordBoundaries
|
||||
tl <- many ( (noneOf wordBoundaries) <|>
|
||||
tl <- many ( noneOf wordBoundaries <|>
|
||||
try (notFollowedBy' note *> oneOf markupChars
|
||||
<* lookAhead (noneOf wordBoundaries) ) )
|
||||
return $ hd:tl
|
||||
|
|
@ -614,7 +614,7 @@ escapedEqs = B.str <$>
|
|||
-- | literal text escaped btw <notextile> tags
|
||||
escapedTag :: PandocMonad m => ParserT [Char] ParserState m Inlines
|
||||
escapedTag = B.str <$>
|
||||
(try $ string "<notextile>" *>
|
||||
try (string "<notextile>" *>
|
||||
manyTill anyChar' (try $ string "</notextile>"))
|
||||
|
||||
-- | Any special symbol defined in wordBoundaries
|
||||
|
|
@ -630,7 +630,8 @@ code = code1 <|> code2
|
|||
-- any character except a newline before a blank line
|
||||
anyChar' :: PandocMonad m => ParserT [Char] ParserState m Char
|
||||
anyChar' =
|
||||
satisfy (/='\n') <|> (try $ char '\n' <* notFollowedBy blankline)
|
||||
satisfy (/='\n') <|>
|
||||
try (char '\n' <* notFollowedBy blankline)
|
||||
|
||||
code1 :: PandocMonad m => ParserT [Char] ParserState m Inlines
|
||||
code1 = B.code <$> surrounded (char '@') anyChar'
|
||||
|
|
|
|||
|
|
@ -168,7 +168,7 @@ table = try $ do
|
|||
where
|
||||
-- The headers are as many empty srings as the number of columns
|
||||
-- in the first row
|
||||
headers rows = map (B.plain . B.str) $replicate (length $ rows !! 0) ""
|
||||
headers rows = map (B.plain . B.str) $replicate (length $ head rows) ""
|
||||
|
||||
para :: PandocMonad m => TikiWikiParser m B.Blocks
|
||||
para = fmap (result . mconcat) ( many1Till inline endOfParaElement)
|
||||
|
|
@ -238,8 +238,8 @@ fixListNesting [first] = [recurseOnList first]
|
|||
fixListNesting (first:second:rest) =
|
||||
let secondBlock = head $ B.toList second in
|
||||
case secondBlock of
|
||||
BulletList _ -> fixListNesting $ (mappend (recurseOnList first) (recurseOnList second)) : rest
|
||||
OrderedList _ _ -> fixListNesting $ (mappend (recurseOnList first) (recurseOnList second)) : rest
|
||||
BulletList _ -> fixListNesting $ mappend (recurseOnList first) (recurseOnList second) : rest
|
||||
OrderedList _ _ -> fixListNesting $ mappend (recurseOnList first) (recurseOnList second) : rest
|
||||
_ -> recurseOnList first : fixListNesting (second:rest)
|
||||
|
||||
-- This function walks the Block structure for fixListNesting,
|
||||
|
|
@ -285,7 +285,7 @@ spanFoldUpList ln (first:rest) =
|
|||
-- level and of the same type.
|
||||
splitListNesting :: ListNesting -> (ListNesting, B.Blocks) -> Bool
|
||||
splitListNesting ln1 (ln2, _)
|
||||
| (lnnest ln1) < (lnnest ln2) =
|
||||
| lnnest ln1 < lnnest ln2 =
|
||||
True
|
||||
| ln1 == ln2 =
|
||||
True
|
||||
|
|
@ -341,7 +341,7 @@ listItemLine nest = lineContent >>= parseContent
|
|||
lineContent = do
|
||||
content <- anyLine
|
||||
continuation <- optionMaybe listContinuation
|
||||
return $ filterSpaces content ++ "\n" ++ maybe "" id continuation
|
||||
return $ filterSpaces content ++ "\n" ++ Data.Maybe.fromMaybe "" continuation
|
||||
filterSpaces = reverse . dropWhile (== ' ') . reverse
|
||||
listContinuation = string (replicate nest '+') >> lineContent
|
||||
parseContent x = do
|
||||
|
|
@ -410,7 +410,7 @@ inline = choice [ whitespace
|
|||
] <?> "inline"
|
||||
|
||||
whitespace :: PandocMonad m => TikiWikiParser m B.Inlines
|
||||
whitespace = (lb <|> regsp)
|
||||
whitespace = lb <|> regsp
|
||||
where lb = try $ skipMany spaceChar >> linebreak >> return B.space
|
||||
regsp = try $ skipMany1 spaceChar >> return B.space
|
||||
|
||||
|
|
@ -501,7 +501,7 @@ escapedChar = try $ do
|
|||
string "~"
|
||||
inner <- many1 $ oneOf "0123456789"
|
||||
string "~"
|
||||
return $B.str [(toEnum (read inner :: Int)) :: Char]
|
||||
return $B.str [toEnum (read inner :: Int) :: Char]
|
||||
|
||||
-- UNSUPPORTED, as there doesn't seem to be any facility in calibre
|
||||
-- for this
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ import Control.Monad.Except (catchError, throwError)
|
|||
import Control.Monad.Reader (Reader, asks, runReader)
|
||||
import Data.Char (toLower)
|
||||
import Data.Default
|
||||
import Data.List (intercalate, intersperse, transpose)
|
||||
import Data.List (intercalate, transpose)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text)
|
||||
|
|
@ -463,7 +463,7 @@ titleLink = try $ do
|
|||
char ']'
|
||||
let link' = last tokens
|
||||
guard $ not $ null link'
|
||||
let tit = concat (intersperse " " (init tokens))
|
||||
let tit = unwords (init tokens)
|
||||
return $ B.link link' "" (B.text tit)
|
||||
|
||||
-- Link with image
|
||||
|
|
|
|||
|
|
@ -388,9 +388,7 @@ bulletListMarkers = "ul" <$ (char '*' <|> char '-')
|
|||
|
||||
orderedListMarkers :: PandocMonad m => VwParser m String
|
||||
orderedListMarkers =
|
||||
("ol" <$choice (orderedListMarker Decimal Period:(($OneParen)
|
||||
<$> orderedListMarker
|
||||
<$> [Decimal, LowerRoman, UpperRoman, LowerAlpha, UpperAlpha])))
|
||||
("ol" <$choice (orderedListMarker Decimal Period:(($OneParen) . orderedListMarker <$> [Decimal, LowerRoman, UpperRoman, LowerAlpha, UpperAlpha])))
|
||||
<|> ("ol" <$ char '#')
|
||||
|
||||
--many need trimInlines
|
||||
|
|
|
|||
|
|
@ -494,7 +494,7 @@ hierarchicalizeWithIds (Header level attr@(_,classes,_) title':xs) = do
|
|||
return $ Sec level newnum attr title' sectionContents' : rest'
|
||||
hierarchicalizeWithIds (Div ("",["references"],[])
|
||||
(Header level (ident,classes,kvs) title' : xs):ys) =
|
||||
hierarchicalizeWithIds (Header level (ident,("references":classes),kvs)
|
||||
hierarchicalizeWithIds (Header level (ident,"references":classes,kvs)
|
||||
title' : (xs ++ ys))
|
||||
hierarchicalizeWithIds (x:rest) = do
|
||||
rest' <- hierarchicalizeWithIds rest
|
||||
|
|
|
|||
|
|
@ -265,8 +265,7 @@ blockToAsciiDoc opts (OrderedList (_start, sty, _delim) items) = do
|
|||
let markers' = map (\m -> if length m < 3
|
||||
then m ++ replicate (3 - length m) ' '
|
||||
else m) markers
|
||||
contents <- mapM (uncurry (orderedListItemToAsciiDoc opts)) $
|
||||
zip markers' items
|
||||
contents <- zipWithM (orderedListItemToAsciiDoc opts) markers' items
|
||||
return $ cat contents <> blankline
|
||||
blockToAsciiDoc opts (DefinitionList items) = do
|
||||
contents <- mapM (definitionListItemToAsciiDoc opts) items
|
||||
|
|
@ -452,7 +451,7 @@ inlineToAsciiDoc opts (Link _ txt (src, _tit)) = do
|
|||
else prefix <> text src <> "[" <> linktext <> "]"
|
||||
inlineToAsciiDoc opts (Image attr alternate (src, tit)) = do
|
||||
-- image:images/logo.png[Company logo, title="blah"]
|
||||
let txt = if (null alternate) || (alternate == [Str ""])
|
||||
let txt = if null alternate || (alternate == [Str ""])
|
||||
then [Str "image"]
|
||||
else alternate
|
||||
linktext <- inlineListToAsciiDoc opts txt
|
||||
|
|
|
|||
|
|
@ -1057,12 +1057,9 @@ getParaProps displayMathPara = do
|
|||
props <- asks envParaProperties
|
||||
listLevel <- asks envListLevel
|
||||
numid <- asks envListNumId
|
||||
let listPr = if listLevel >= 0 && not displayMathPara
|
||||
then [ mknode "w:numPr" []
|
||||
[ mknode "w:numId" [("w:val",show numid)] ()
|
||||
, mknode "w:ilvl" [("w:val",show listLevel)] () ]
|
||||
]
|
||||
else []
|
||||
let listPr = [mknode "w:numPr" []
|
||||
[ mknode "w:numId" [("w:val",show numid)] ()
|
||||
, mknode "w:ilvl" [("w:val",show listLevel)] () ] | listLevel >= 0 && not displayMathPara]
|
||||
return $ case props ++ listPr of
|
||||
[] -> []
|
||||
ps -> [mknode "w:pPr" [] ps]
|
||||
|
|
@ -1145,7 +1142,7 @@ inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do
|
|||
return $ \f -> do
|
||||
x <- f
|
||||
return [ mknode "w:ins"
|
||||
[("w:id", (show insId)),
|
||||
[("w:id", show insId),
|
||||
("w:author", author),
|
||||
("w:date", date)] x ]
|
||||
else return id
|
||||
|
|
@ -1272,7 +1269,7 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do
|
|||
Nothing ->
|
||||
catchError
|
||||
(do (img, mt) <- P.fetchItem src
|
||||
ident <- ("rId"++) `fmap` ((lift . lift) getUniqueId)
|
||||
ident <- ("rId"++) `fmap` (lift . lift) getUniqueId
|
||||
let (xpt,ypt) = desiredSizeInPoints opts attr
|
||||
(either (const def) id (imageSize opts img))
|
||||
-- 12700 emu = 1 pt
|
||||
|
|
|
|||
|
|
@ -131,8 +131,7 @@ description meta' = do
|
|||
_ -> return []
|
||||
return $ el "description"
|
||||
[ el "title-info" (genre : (bt ++ as ++ dd ++ lang))
|
||||
, el "document-info" ([ el "program-used" "pandoc" ] -- FIXME: +version
|
||||
++ coverpage)
|
||||
, el "document-info" (el "program-used" "pandoc" : coverpage)
|
||||
]
|
||||
|
||||
booktitle :: PandocMonad m => Meta -> FBM m [Content]
|
||||
|
|
|
|||
|
|
@ -56,7 +56,8 @@ import qualified Data.Text.Lazy as TL
|
|||
import Network.HTTP (urlEncode)
|
||||
import Network.URI (URI (..), parseURIReference, unEscapeString)
|
||||
import Numeric (showHex)
|
||||
import Text.Blaze.Internal (customLeaf, MarkupM(Empty))
|
||||
import Text.Blaze.Internal
|
||||
(customLeaf, MarkupM(Empty), preEscapedString, preEscapedText)
|
||||
import Text.Blaze.Html hiding (contents)
|
||||
import Text.Pandoc.Definition
|
||||
import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight,
|
||||
|
|
@ -424,7 +425,7 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen
|
|||
modify (\st -> st{ stElement = False})
|
||||
return res
|
||||
|
||||
let isSec (Sec{}) = True
|
||||
let isSec Sec{} = True
|
||||
isSec (Blk _) = False
|
||||
let isPause (Blk x) = x == Para [Str ".",Space,Str ".",Space,Str "."]
|
||||
isPause _ = False
|
||||
|
|
@ -618,7 +619,7 @@ imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf",
|
|||
|
||||
treatAsImage :: FilePath -> Bool
|
||||
treatAsImage fp =
|
||||
let path = fromMaybe fp (uriPath `fmap` parseURIReference fp)
|
||||
let path = maybe fp uriPath (parseURIReference fp)
|
||||
ext = map toLower $ drop 1 $ takeExtension path
|
||||
in null ext || ext `elem` imageExts
|
||||
|
||||
|
|
@ -797,8 +798,8 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
|
|||
let numstyle' = case numstyle of
|
||||
Example -> "decimal"
|
||||
_ -> camelCaseToHyphenated $ show numstyle
|
||||
let attribs = ([A.start $ toValue startnum | startnum /= 1]) ++
|
||||
([A.class_ "example" | numstyle == Example]) ++
|
||||
let attribs = [A.start $ toValue startnum | startnum /= 1] ++
|
||||
[A.class_ "example" | numstyle == Example] ++
|
||||
(if numstyle /= DefaultStyle
|
||||
then if html5
|
||||
then [A.type_ $
|
||||
|
|
@ -819,7 +820,7 @@ blockToHtml opts (DefinitionList lst) = do
|
|||
do term' <- if null term
|
||||
then return mempty
|
||||
else liftM H.dt $ inlineListToHtml opts term
|
||||
defs' <- mapM (liftM (\x -> H.dd $ (x >> nl opts)) .
|
||||
defs' <- mapM (liftM (\x -> H.dd (x >> nl opts)) .
|
||||
blockListToHtml opts) defs
|
||||
return $ mconcat $ nl opts : term' : nl opts :
|
||||
intersperse (nl opts) defs') lst
|
||||
|
|
|
|||
|
|
@ -168,8 +168,7 @@ blockToHaddock opts (OrderedList (start,_,delim) items) = do
|
|||
let markers' = map (\m -> if length m < 3
|
||||
then m ++ replicate (3 - length m) ' '
|
||||
else m) markers
|
||||
contents <- mapM (uncurry (orderedListItemToHaddock opts)) $
|
||||
zip markers' items
|
||||
contents <- zipWithM (orderedListItemToHaddock opts) markers' items
|
||||
return $ cat contents <> blankline
|
||||
blockToHaddock opts (DefinitionList items) = do
|
||||
contents <- mapM (definitionListItemToHaddock opts) items
|
||||
|
|
|
|||
|
|
@ -154,7 +154,7 @@ writeICML opts (Pandoc meta blocks) = do
|
|||
-- | Auxilary functions for parStylesToDoc and charStylesToDoc.
|
||||
contains :: String -> (String, (String, String)) -> [(String, String)]
|
||||
contains s rule =
|
||||
[snd rule | isInfixOf (fst rule) s]
|
||||
[snd rule | (fst rule) `isInfixOf` s]
|
||||
|
||||
-- | The monospaced font to use as default.
|
||||
monospacedFont :: Doc
|
||||
|
|
@ -282,7 +282,7 @@ hyperlinksToDoc (x:xs) = hyp x $$ hyperlinksToDoc xs
|
|||
("Source","htss-"++show ident), ("Visible","true"), ("DestinationUniqueKey","1")]
|
||||
$ inTags True "Properties" []
|
||||
$ inTags False "BorderColor" [("type","enumeration")] (text "Black")
|
||||
$$ inTags False "Destination" [("type","object")] (text $ "HyperlinkURLDestination/"++(escapeColons (escapeStringForXML url))) -- HyperlinkURLDestination with more than one colon crashes CS6
|
||||
$$ inTags False "Destination" [("type","object")] (text $ "HyperlinkURLDestination/"++escapeColons (escapeStringForXML url)) -- HyperlinkURLDestination with more than one colon crashes CS6
|
||||
|
||||
|
||||
-- | Convert a list of Pandoc blocks to ICML.
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isPunctuation, ord,
|
|||
toLower)
|
||||
import Data.List (foldl', intercalate, intersperse, isInfixOf, nubBy,
|
||||
stripPrefix, (\\))
|
||||
import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe)
|
||||
import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, isNothing)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Network.URI (unEscapeString)
|
||||
|
|
@ -401,7 +401,7 @@ elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts)
|
|||
let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "fragile",
|
||||
"b", "c", "t", "environment",
|
||||
"label", "plain", "shrink", "standout"]
|
||||
let optionslist = ["fragile" | fragile && lookup "fragile" kvs == Nothing] ++
|
||||
let optionslist = ["fragile" | fragile && isNothing (lookup "fragile" kvs)] ++
|
||||
[k | k <- classes, k `elem` frameoptions] ++
|
||||
[k ++ "=" ++ v | (k,v) <- kvs, k `elem` frameoptions]
|
||||
let options = if null optionslist
|
||||
|
|
@ -819,7 +819,7 @@ listItemToLaTeX lst
|
|||
-- we need to put some text before a header if it's the first
|
||||
-- element in an item. This will look ugly in LaTeX regardless, but
|
||||
-- this will keep the typesetter from throwing an error.
|
||||
| (Header _ _ _ :_) <- lst =
|
||||
| (Header{} :_) <- lst =
|
||||
blockListToLaTeX lst >>= return . (text "\\item ~" $$) . nest 2
|
||||
| otherwise = blockListToLaTeX lst >>= return . (text "\\item" $$) .
|
||||
nest 2
|
||||
|
|
@ -856,7 +856,7 @@ sectionHeader unnumbered ident level lst = do
|
|||
plain <- stringToLaTeX TextString $ concatMap stringify lst
|
||||
let removeInvalidInline (Note _) = []
|
||||
removeInvalidInline (Span (id', _, _) _) | not (null id') = []
|
||||
removeInvalidInline (Image{}) = []
|
||||
removeInvalidInline Image{} = []
|
||||
removeInvalidInline x = [x]
|
||||
let lstNoNotes = foldr (mappend . (\x -> walkM removeInvalidInline x)) mempty lst
|
||||
txtNoNotes <- inlineListToLaTeX lstNoNotes
|
||||
|
|
|
|||
|
|
@ -114,7 +114,7 @@ notesToMan :: PandocMonad m => WriterOptions -> [[Block]] -> StateT WriterState
|
|||
notesToMan opts notes =
|
||||
if null notes
|
||||
then return empty
|
||||
else mapM (uncurry (noteToMan opts)) (zip [1..] notes) >>=
|
||||
else zipWithM (noteToMan opts) [1..] notes >>=
|
||||
return . (text ".SH NOTES" $$) . vcat
|
||||
|
||||
-- | Return man representation of a note.
|
||||
|
|
|
|||
|
|
@ -218,7 +218,7 @@ blockToMuse (DefinitionList items) = do
|
|||
descriptionToMuse :: PandocMonad m
|
||||
=> [Block]
|
||||
-> StateT WriterState m Doc
|
||||
descriptionToMuse desc = (hang 4 " :: ") <$> blockListToMuse desc
|
||||
descriptionToMuse desc = hang 4 " :: " <$> blockListToMuse desc
|
||||
blockToMuse (Header level (ident,_,_) inlines) = do
|
||||
opts <- gets stOptions
|
||||
contents <- inlineListToMuse inlines
|
||||
|
|
|
|||
|
|
@ -104,5 +104,5 @@ fitToPage :: (Double, Double) -> Integer -> (Integer, Integer)
|
|||
fitToPage (x, y) pageWidth
|
||||
-- Fixes width to the page width and scales the height
|
||||
| x > fromIntegral pageWidth =
|
||||
(pageWidth, floor $ ((fromIntegral pageWidth) / x) * y)
|
||||
(pageWidth, floor $ (fromIntegral pageWidth / x) * y)
|
||||
| otherwise = (floor x, floor y)
|
||||
|
|
|
|||
|
|
@ -594,7 +594,7 @@ paraStyle attrs = do
|
|||
tight = if t then [ ("fo:margin-top" , "0in" )
|
||||
, ("fo:margin-bottom" , "0in" )]
|
||||
else []
|
||||
indent = if (i /= 0 || b)
|
||||
indent = if i /= 0 || b
|
||||
then [ ("fo:margin-left" , indentVal)
|
||||
, ("fo:margin-right" , "0in" )
|
||||
, ("fo:text-indent" , "0in" )
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
{-# LANGUAGE PatternGuards #-}
|
||||
|
||||
|
||||
{-
|
||||
Copyright (C) 2017-2018 Jesse Rosenthal <jrosenthal@jhu.edu>
|
||||
|
|
|
|||
|
|
@ -72,7 +72,7 @@ import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element"
|
|||
import Text.Pandoc.Writers.Shared (metaValueToInlines)
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
import Data.Maybe (maybeToList)
|
||||
import Data.Maybe (maybeToList, fromMaybe)
|
||||
import Text.Pandoc.Highlighting
|
||||
import qualified Data.Text as T
|
||||
import Control.Applicative ((<|>))
|
||||
|
|
@ -136,7 +136,7 @@ reservedSlideIds = S.fromList [ metadataSlideId
|
|||
|
||||
uniqueSlideId' :: Integer -> S.Set SlideId -> String -> SlideId
|
||||
uniqueSlideId' n idSet s =
|
||||
let s' = if n == 0 then s else (s ++ "-" ++ show n)
|
||||
let s' = if n == 0 then s else s ++ "-" ++ show n
|
||||
in if SlideId s' `S.member` idSet
|
||||
then uniqueSlideId' (n+1) idSet s
|
||||
else SlideId s'
|
||||
|
|
@ -152,7 +152,7 @@ runUniqueSlideId s = do
|
|||
return sldId
|
||||
|
||||
addLogMessage :: LogMessage -> Pres ()
|
||||
addLogMessage msg = modify $ \st -> st{stLog = msg : (stLog st)}
|
||||
addLogMessage msg = modify $ \st -> st{stLog = msg : stLog st}
|
||||
|
||||
type Pres = ReaderT WriterEnv (State WriterState)
|
||||
|
||||
|
|
@ -180,7 +180,7 @@ data DocProps = DocProps { dcTitle :: Maybe String
|
|||
|
||||
data Slide = Slide { slideId :: SlideId
|
||||
, slideLayout :: Layout
|
||||
, slideNotes :: (Maybe Notes)
|
||||
, slideNotes :: Maybe Notes
|
||||
} deriving (Show, Eq)
|
||||
|
||||
newtype SlideId = SlideId String
|
||||
|
|
@ -345,12 +345,12 @@ inlineToParElems (SmallCaps ils) =
|
|||
inlineToParElems Space = inlineToParElems (Str " ")
|
||||
inlineToParElems SoftBreak = inlineToParElems (Str " ")
|
||||
inlineToParElems LineBreak = return [Break]
|
||||
inlineToParElems (Link _ ils (url, title)) = do
|
||||
inlineToParElems (Link _ ils (url, title)) =
|
||||
local (\r ->r{envRunProps = (envRunProps r){rLink = Just $ ExternalTarget (url, title)}}) $
|
||||
inlinesToParElems ils
|
||||
inlineToParElems (Code _ str) = do
|
||||
inlinesToParElems ils
|
||||
inlineToParElems (Code _ str) =
|
||||
local (\r ->r{envRunProps = (envRunProps r){rPropCode = True}}) $
|
||||
inlineToParElems $ Str str
|
||||
inlineToParElems $ Str str
|
||||
inlineToParElems (Math mathtype str) =
|
||||
return [MathElem mathtype (TeXString str)]
|
||||
inlineToParElems (Note blks) = do
|
||||
|
|
@ -409,7 +409,7 @@ blockToParagraphs (CodeBlock attr str) =
|
|||
Just sty ->
|
||||
case highlight synMap (formatSourceLines sty) attr str of
|
||||
Right pElems -> do pProps <- asks envParaProps
|
||||
return $ [Paragraph pProps pElems]
|
||||
return [Paragraph pProps pElems]
|
||||
Left _ -> blockToParagraphs $ Para [Str str]
|
||||
Nothing -> blockToParagraphs $ Para [Str str]
|
||||
-- We can't yet do incremental lists, but we should render a
|
||||
|
|
@ -463,7 +463,7 @@ blockToParagraphs (DefinitionList entries) = do
|
|||
definition <- concatMapM (blockToParagraphs . BlockQuote) blksLst
|
||||
return $ term ++ definition
|
||||
concatMapM go entries
|
||||
blockToParagraphs (Div (_, ("notes" : []), _) _) = return []
|
||||
blockToParagraphs (Div (_, "notes" : [], _) _) = return []
|
||||
blockToParagraphs (Div _ blks) = concatMapM blockToParagraphs blks
|
||||
blockToParagraphs blk = do
|
||||
addLogMessage $ BlockNotRendered blk
|
||||
|
|
@ -481,7 +481,7 @@ multiParBullet (b:bs) = do
|
|||
|
||||
cellToParagraphs :: Alignment -> TableCell -> Pres [Paragraph]
|
||||
cellToParagraphs algn tblCell = do
|
||||
paras <- mapM (blockToParagraphs) tblCell
|
||||
paras <- mapM blockToParagraphs tblCell
|
||||
let alignment = case algn of
|
||||
AlignLeft -> Just AlgnLeft
|
||||
AlignRight -> Just AlgnRight
|
||||
|
|
@ -494,7 +494,7 @@ rowToParagraphs :: [Alignment] -> [TableCell] -> Pres [[Paragraph]]
|
|||
rowToParagraphs algns tblCells = do
|
||||
-- We have to make sure we have the right number of alignments
|
||||
let pairs = zip (algns ++ repeat AlignDefault) tblCells
|
||||
mapM (\(a, tc) -> cellToParagraphs a tc) pairs
|
||||
mapM (uncurry cellToParagraphs) pairs
|
||||
|
||||
withAttr :: Attr -> Shape -> Shape
|
||||
withAttr attr (Pic picPr url caption) =
|
||||
|
|
@ -507,17 +507,17 @@ withAttr _ sp = sp
|
|||
|
||||
blockToShape :: Block -> Pres Shape
|
||||
blockToShape (Plain (il:_)) | Image attr ils (url, _) <- il =
|
||||
(withAttr attr . Pic def url) <$> (inlinesToParElems ils)
|
||||
(withAttr attr . Pic def url) <$> inlinesToParElems ils
|
||||
blockToShape (Para (il:_)) | Image attr ils (url, _) <- il =
|
||||
(withAttr attr . Pic def url) <$> (inlinesToParElems ils)
|
||||
(withAttr attr . Pic def url) <$> inlinesToParElems ils
|
||||
blockToShape (Plain (il:_)) | Link _ (il':_) target <- il
|
||||
, Image attr ils (url, _) <- il' =
|
||||
(withAttr attr . Pic def {picPropLink = Just $ ExternalTarget target} url) <$>
|
||||
(inlinesToParElems ils)
|
||||
inlinesToParElems ils
|
||||
blockToShape (Para (il:_)) | Link _ (il':_) target <- il
|
||||
, Image attr ils (url, _) <- il' =
|
||||
(withAttr attr . Pic def{picPropLink = Just $ ExternalTarget target} url) <$>
|
||||
(inlinesToParElems ils)
|
||||
inlinesToParElems ils
|
||||
blockToShape (Table caption algn _ hdrCells rows) = do
|
||||
caption' <- inlinesToParElems caption
|
||||
hdrCells' <- rowToParagraphs algn hdrCells
|
||||
|
|
@ -537,11 +537,11 @@ blockToShape blk = do paras <- blockToParagraphs blk
|
|||
|
||||
combineShapes :: [Shape] -> [Shape]
|
||||
combineShapes [] = []
|
||||
combineShapes (s : []) = [s]
|
||||
combineShapes (pic@(Pic _ _ _) : ss) = pic : combineShapes ss
|
||||
combineShapes ((TextBox []) : ss) = combineShapes ss
|
||||
combineShapes[s] = [s]
|
||||
combineShapes (pic@(Pic{}) : ss) = pic : combineShapes ss
|
||||
combineShapes (TextBox [] : ss) = combineShapes ss
|
||||
combineShapes (s : TextBox [] : ss) = combineShapes (s : ss)
|
||||
combineShapes ((TextBox (p:ps)) : (TextBox (p':ps')) : ss) =
|
||||
combineShapes (TextBox (p:ps) : TextBox (p':ps') : ss) =
|
||||
combineShapes $ TextBox ((p:ps) ++ (p':ps')) : ss
|
||||
combineShapes (s:ss) = s : combineShapes ss
|
||||
|
||||
|
|
@ -549,8 +549,8 @@ blocksToShapes :: [Block] -> Pres [Shape]
|
|||
blocksToShapes blks = combineShapes <$> mapM blockToShape blks
|
||||
|
||||
isImage :: Inline -> Bool
|
||||
isImage (Image _ _ _) = True
|
||||
isImage (Link _ ((Image _ _ _) : _) _) = True
|
||||
isImage (Image{}) = True
|
||||
isImage (Link _ (Image _ _ _ : _) _) = True
|
||||
isImage _ = False
|
||||
|
||||
splitBlocks' :: [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
|
||||
|
|
@ -565,27 +565,27 @@ splitBlocks' cur acc (h@(Header n _ _) : blks) = do
|
|||
GT -> splitBlocks' (cur ++ [h]) acc blks
|
||||
-- `blockToParagraphs` treats Plain and Para the same, so we can save
|
||||
-- some code duplication by treating them the same here.
|
||||
splitBlocks' cur acc ((Plain ils) : blks) = splitBlocks' cur acc ((Para ils) : blks)
|
||||
splitBlocks' cur acc ((Para (il:ils)) : blks) | isImage il = do
|
||||
splitBlocks' cur acc (Plain ils : blks) = splitBlocks' cur acc (Para ils : blks)
|
||||
splitBlocks' cur acc (Para (il:ils) : blks) | isImage il = do
|
||||
slideLevel <- asks envSlideLevel
|
||||
case cur of
|
||||
(Header n _ _) : [] | n == slideLevel ->
|
||||
[(Header n _ _)] | n == slideLevel ->
|
||||
splitBlocks' []
|
||||
(acc ++ [cur ++ [Para [il]]])
|
||||
(if null ils then blks else (Para ils) : blks)
|
||||
(if null ils then blks else Para ils : blks)
|
||||
_ -> splitBlocks' []
|
||||
(acc ++ (if null cur then [] else [cur]) ++ [[Para [il]]])
|
||||
(if null ils then blks else (Para ils) : blks)
|
||||
splitBlocks' cur acc (tbl@(Table _ _ _ _ _) : blks) = do
|
||||
(if null ils then blks else Para ils : blks)
|
||||
splitBlocks' cur acc (tbl@(Table{}) : blks) = do
|
||||
slideLevel <- asks envSlideLevel
|
||||
case cur of
|
||||
(Header n _ _) : [] | n == slideLevel ->
|
||||
[(Header n _ _)] | n == slideLevel ->
|
||||
splitBlocks' [] (acc ++ [cur ++ [tbl]]) blks
|
||||
_ -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[tbl]]) blks
|
||||
splitBlocks' cur acc (d@(Div (_, classes, _) _): blks) | "columns" `elem` classes = do
|
||||
slideLevel <- asks envSlideLevel
|
||||
case cur of
|
||||
(Header n _ _) : [] | n == slideLevel ->
|
||||
[(Header n _ _)] | n == slideLevel ->
|
||||
splitBlocks' [] (acc ++ [cur ++ [d]]) blks
|
||||
_ -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[d]]) blks
|
||||
splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks
|
||||
|
|
@ -594,12 +594,12 @@ splitBlocks :: [Block] -> Pres [[Block]]
|
|||
splitBlocks = splitBlocks' [] []
|
||||
|
||||
blocksToSlide' :: Int -> [Block] -> Pres Slide
|
||||
blocksToSlide' lvl ((Header n (ident, _, _) ils) : blks)
|
||||
blocksToSlide' lvl (Header n (ident, _, _) ils : blks)
|
||||
| n < lvl = do
|
||||
registerAnchorId ident
|
||||
sldId <- asks envCurSlideId
|
||||
hdr <- inlinesToParElems ils
|
||||
return $ Slide sldId (TitleSlide {titleSlideHeader = hdr}) Nothing
|
||||
return $ Slide sldId TitleSlide {titleSlideHeader = hdr} Nothing
|
||||
| n == lvl = do
|
||||
registerAnchorId ident
|
||||
hdr <- inlinesToParElems ils
|
||||
|
|
@ -614,7 +614,7 @@ blocksToSlide' lvl ((Header n (ident, _, _) ils) : blks)
|
|||
blocksToSlide' _ (blk : blks)
|
||||
| Div (_, classes, _) divBlks <- blk
|
||||
, "columns" `elem` classes
|
||||
, (Div (_, clsL, _) blksL) : (Div (_, clsR, _) blksR) : remaining <- divBlks
|
||||
, Div (_, clsL, _) blksL : Div (_, clsR, _) blksR : remaining <- divBlks
|
||||
, "column" `elem` clsL, "column" `elem` clsR = do
|
||||
unless (null blks)
|
||||
(mapM (addLogMessage . BlockNotRendered) blks >> return ())
|
||||
|
|
@ -672,7 +672,7 @@ makeNoteEntry n blks =
|
|||
in
|
||||
case blks of
|
||||
(Para ils : blks') -> (Para $ enum : Space : ils) : blks'
|
||||
_ -> (Para [enum]) : blks
|
||||
_ -> Para [enum] : blks
|
||||
|
||||
forceFontSize :: Pixels -> Pres a -> Pres a
|
||||
forceFontSize px x = do
|
||||
|
|
@ -860,7 +860,7 @@ blocksToPresentationSlides blks = do
|
|||
(\env -> env { envCurSlideId = endNotesSlideId
|
||||
, envInNoteSlide = True
|
||||
})
|
||||
(blocksToSlide $ endNotesSlideBlocks)
|
||||
(blocksToSlide endNotesSlideBlocks)
|
||||
return [endNotesSlide]
|
||||
|
||||
let slides = metadataslides ++ tocSlides ++ bodyslides ++ endNotesSlides
|
||||
|
|
@ -889,9 +889,7 @@ documentToPresentation :: WriterOptions
|
|||
documentToPresentation opts (Pandoc meta blks) =
|
||||
let env = def { envOpts = opts
|
||||
, envMetadata = meta
|
||||
, envSlideLevel = case writerSlideLevel opts of
|
||||
Just lvl -> lvl
|
||||
Nothing -> getSlideLevel blks
|
||||
, envSlideLevel = fromMaybe (getSlideLevel blks) (writerSlideLevel opts)
|
||||
}
|
||||
(presSlides, msgs) = runPres env def $ blocksToPresentationSlides blks
|
||||
docProps = metaToDocProps meta
|
||||
|
|
|
|||
|
|
@ -132,7 +132,7 @@ keyToRST (label, (src, _)) = do
|
|||
-- | Return RST representation of notes.
|
||||
notesToRST :: PandocMonad m => [[Block]] -> RST m Doc
|
||||
notesToRST notes =
|
||||
mapM (uncurry noteToRST) (zip [1..] notes) >>=
|
||||
zipWithM noteToRST [1..] notes >>=
|
||||
return . vsep
|
||||
|
||||
-- | Return RST representation of a note.
|
||||
|
|
@ -306,8 +306,7 @@ blockToRST (OrderedList (start, style', delim) items) = do
|
|||
let maxMarkerLength = maximum $ map length markers
|
||||
let markers' = map (\m -> let s = maxMarkerLength - length m
|
||||
in m ++ replicate s ' ') markers
|
||||
contents <- mapM (uncurry orderedListItemToRST) $
|
||||
zip markers' items
|
||||
contents <- zipWithM orderedListItemToRST markers' items
|
||||
-- ensure that sublists have preceding blank line
|
||||
return $ blankline $$ chomp (vcat contents) $$ blankline
|
||||
blockToRST (DefinitionList items) = do
|
||||
|
|
@ -356,12 +355,12 @@ blockListToRST' topLevel blocks = do
|
|||
let fixBlocks (b1:b2@(BlockQuote _):bs)
|
||||
| toClose b1 = b1 : commentSep : b2 : fixBlocks bs
|
||||
where
|
||||
toClose (Plain{}) = False
|
||||
toClose (Header{}) = False
|
||||
toClose (LineBlock{}) = False
|
||||
toClose (HorizontalRule) = False
|
||||
toClose Plain{} = False
|
||||
toClose Header{} = False
|
||||
toClose LineBlock{} = False
|
||||
toClose HorizontalRule = False
|
||||
toClose (Para [Image _ _ (_,'f':'i':'g':':':_)]) = True
|
||||
toClose (Para{}) = False
|
||||
toClose Para{} = False
|
||||
toClose _ = True
|
||||
commentSep = RawBlock "rst" "..\n\n"
|
||||
fixBlocks (b:bs) = b : fixBlocks bs
|
||||
|
|
|
|||
|
|
@ -31,6 +31,7 @@ Conversion of 'Pandoc' documents to RTF (rich text format).
|
|||
module Text.Pandoc.Writers.RTF ( writeRTF
|
||||
) where
|
||||
import Control.Monad.Except (catchError, throwError)
|
||||
import Control.Monad
|
||||
import qualified Data.ByteString as B
|
||||
import Data.Char (chr, isDigit, ord)
|
||||
import Data.List (intercalate, isSuffixOf)
|
||||
|
|
@ -278,8 +279,7 @@ blockToRTF indent alignment (BulletList lst) = (spaceAtEnd . concat) <$>
|
|||
mapM (listItemToRTF alignment indent (bulletMarker indent)) lst
|
||||
blockToRTF indent alignment (OrderedList attribs lst) =
|
||||
(spaceAtEnd . concat) <$>
|
||||
mapM (uncurry (listItemToRTF alignment indent))
|
||||
(zip (orderedMarkers indent attribs) lst)
|
||||
zipWithM (listItemToRTF alignment indent) (orderedMarkers indent attribs) lst
|
||||
blockToRTF indent alignment (DefinitionList lst) = (spaceAtEnd . concat) <$>
|
||||
mapM (definitionListItemToRTF alignment indent) lst
|
||||
blockToRTF indent _ HorizontalRule = return $
|
||||
|
|
@ -303,8 +303,8 @@ tableRowToRTF header indent aligns sizes' cols = do
|
|||
let sizes = if all (== 0) sizes'
|
||||
then replicate (length cols) (1.0 / fromIntegral (length cols))
|
||||
else sizes'
|
||||
columns <- concat <$> mapM (uncurry (tableItemToRTF indent))
|
||||
(zip aligns cols)
|
||||
columns <- concat <$>
|
||||
zipWithM (tableItemToRTF indent) aligns cols
|
||||
let rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips))
|
||||
(0 :: Integer) sizes
|
||||
let cellDefs = map (\edge -> (if header
|
||||
|
|
|
|||
|
|
@ -475,7 +475,7 @@ inlineToTexinfo (Link _ txt (src@('#':_), _)) = do
|
|||
inlineToTexinfo (Link _ txt (src, _)) =
|
||||
case txt of
|
||||
[Str x] | escapeURI x == src -> -- autolink
|
||||
do return $ text $ "@url{" ++ x ++ "}"
|
||||
return $ text $ "@url{" ++ x ++ "}"
|
||||
_ -> do contents <- escapeCommas $ inlineListToTexinfo txt
|
||||
let src1 = stringToTexinfo src
|
||||
return $ text ("@uref{" ++ src1 ++ ",") <> contents <>
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ runTest testname pandocpath cmd inp norm = testCase testname $ do
|
|||
-- filter \r so the tests will work on Windows machines
|
||||
let out = filter (/= '\r') $ err' ++ out'
|
||||
result <- if ec == ExitSuccess
|
||||
then do
|
||||
then
|
||||
if out == norm
|
||||
then return TestPassed
|
||||
else return
|
||||
|
|
@ -52,6 +52,7 @@ runTest testname pandocpath cmd inp norm = testCase testname $ do
|
|||
assertBool (show result) (result == TestPassed)
|
||||
|
||||
tests :: TestTree
|
||||
{-# NOINLINE tests #-}
|
||||
tests = unsafePerformIO $ do
|
||||
pandocpath <- findPandoc
|
||||
files <- filter (".md" `isSuffixOf`) <$>
|
||||
|
|
@ -89,7 +90,6 @@ extractCommandTest pandocpath fp = unsafePerformIO $ do
|
|||
contents <- UTF8.toText <$> BS.readFile ("command" </> fp)
|
||||
Pandoc _ blocks <- runIOorExplode (readMarkdown
|
||||
def{ readerExtensions = pandocExtensions } contents)
|
||||
let codeblocks = map extractCode $ filter isCodeBlock $ blocks
|
||||
let codeblocks = map extractCode $ filter isCodeBlock blocks
|
||||
let cases = map (runCommandTest pandocpath) $ zip [1..] codeblocks
|
||||
return $ testGroup fp cases
|
||||
|
||||
|
|
|
|||
|
|
@ -224,7 +224,7 @@ tests = [
|
|||
<> " bar")
|
||||
, "escaped auto link" =:
|
||||
"foo ~http://foo.example.com/bar/baz.html bar"
|
||||
=?> para ("foo http://foo.example.com/bar/baz.html bar")
|
||||
=?> para "foo http://foo.example.com/bar/baz.html bar"
|
||||
, "wiki link simple" =:
|
||||
"foo [[http://foo.example.com/foo.png]] bar"
|
||||
=?> para ("foo "
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@ import qualified Data.ByteString as BS
|
|||
import qualified Data.ByteString.Lazy as B
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Text as T
|
||||
import Data.Maybe
|
||||
import System.IO.Unsafe
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
|
|
@ -46,7 +47,7 @@ compareOutput opts docxFile nativeFile = do
|
|||
nf <- UTF8.toText <$> BS.readFile nativeFile
|
||||
p <- runIOorExplode $ readDocx opts df
|
||||
df' <- runIOorExplode $ readNative def nf
|
||||
return $ (noNorm p, noNorm df')
|
||||
return (noNorm p, noNorm df')
|
||||
|
||||
testCompareWithOptsIO :: ReaderOptions -> String -> FilePath -> FilePath -> IO TestTree
|
||||
testCompareWithOptsIO opts name docxFile nativeFile = do
|
||||
|
|
@ -87,11 +88,9 @@ compareMediaPathIO mediaPath mediaBag docxPath = do
|
|||
Nothing -> error ("couldn't find " ++
|
||||
mediaPath ++
|
||||
" in media bag")
|
||||
docxBS = case docxMedia of
|
||||
Just bs -> bs
|
||||
Nothing -> error ("couldn't find " ++
|
||||
mediaPath ++
|
||||
" in media bag")
|
||||
docxBS = fromMaybe (error ("couldn't find " ++
|
||||
mediaPath ++
|
||||
" in media bag")) docxMedia
|
||||
return $ mbBS == docxBS
|
||||
|
||||
compareMediaBagIO :: FilePath -> IO Bool
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ getMediaBag fp = do
|
|||
|
||||
testMediaBag :: FilePath -> [(String, String, Int)] -> IO ()
|
||||
testMediaBag fp bag = do
|
||||
actBag <- (mediaDirectory <$> getMediaBag fp)
|
||||
actBag <- mediaDirectory <$> getMediaBag fp
|
||||
assertBool (show "MediaBag did not match:\nExpected: "
|
||||
++ show bag
|
||||
++ "\nActual: "
|
||||
|
|
|
|||
|
|
@ -30,8 +30,8 @@ spcSep = mconcat . intersperse space
|
|||
-- Tables and definition lists don't round-trip yet
|
||||
|
||||
makeRoundTrip :: Block -> Block
|
||||
makeRoundTrip (Table{}) = Para [Str "table was here"]
|
||||
makeRoundTrip (DefinitionList{}) = Para [Str "deflist was here"]
|
||||
makeRoundTrip Table{} = Para [Str "table was here"]
|
||||
makeRoundTrip DefinitionList{} = Para [Str "deflist was here"]
|
||||
makeRoundTrip x = x
|
||||
|
||||
-- Demand that any AST produced by Muse reader and written by Muse writer can be read back exactly the same way.
|
||||
|
|
@ -44,7 +44,7 @@ roundTrip b = d'' == d'''
|
|||
d'' = rewrite d'
|
||||
d''' = rewrite d''
|
||||
rewrite = amuse . T.pack . (++ "\n") . T.unpack .
|
||||
(purely $ writeMuse def { writerExtensions = extensionsFromList [Ext_amuse]
|
||||
purely (writeMuse def { writerExtensions = extensionsFromList [Ext_amuse]
|
||||
, writerWrapText = WrapPreserve
|
||||
})
|
||||
|
||||
|
|
|
|||
|
|
@ -130,7 +130,7 @@ tests =
|
|||
mconcat [ para "foo"
|
||||
, headerWith ("thing-other-thing", [], [])
|
||||
1
|
||||
((strikeout "thing") <> " other thing")
|
||||
(strikeout "thing" <> " other thing")
|
||||
]
|
||||
|
||||
, "Comment Trees" =:
|
||||
|
|
|
|||
|
|
@ -75,16 +75,16 @@ tests =
|
|||
]
|
||||
|
||||
, "Bullet List with Decreasing Indent" =:
|
||||
(" - Discovery\n\
|
||||
\ - Human After All\n") =?>
|
||||
" - Discovery\n\
|
||||
\ - Human After All\n" =?>
|
||||
mconcat [ bulletList [ plain "Discovery" ]
|
||||
, bulletList [ plain ("Human" <> space <> "After" <> space <> "All")]
|
||||
]
|
||||
|
||||
, "Header follows Bullet List" =:
|
||||
(" - Discovery\n\
|
||||
" - Discovery\n\
|
||||
\ - Human After All\n\
|
||||
\* Homework") =?>
|
||||
\* Homework" =?>
|
||||
mconcat [ bulletList [ plain "Discovery"
|
||||
, plain ("Human" <> space <> "After" <> space <> "All")
|
||||
]
|
||||
|
|
@ -92,9 +92,9 @@ tests =
|
|||
]
|
||||
|
||||
, "Bullet List Unindented with trailing Header" =:
|
||||
("- Discovery\n\
|
||||
"- Discovery\n\
|
||||
\- Homework\n\
|
||||
\* NotValidListItem") =?>
|
||||
\* NotValidListItem" =?>
|
||||
mconcat [ bulletList [ plain "Discovery"
|
||||
, plain "Homework"
|
||||
]
|
||||
|
|
@ -166,14 +166,14 @@ tests =
|
|||
, "Ordered List in Bullet List" =:
|
||||
("- Emacs\n" <>
|
||||
" 1. Org\n") =?>
|
||||
bulletList [ (plain "Emacs") <>
|
||||
(orderedList [ plain "Org"])
|
||||
bulletList [ plain "Emacs" <>
|
||||
orderedList [ plain "Org"]
|
||||
]
|
||||
|
||||
, "Bullet List in Ordered List" =:
|
||||
("1. GNU\n" <>
|
||||
" - Freedom\n") =?>
|
||||
orderedList [ (plain "GNU") <> bulletList [ (plain "Freedom") ] ]
|
||||
orderedList [ plain "GNU" <> bulletList [ plain "Freedom" ] ]
|
||||
|
||||
, "Definition List" =:
|
||||
T.unlines [ "- PLL :: phase-locked loop"
|
||||
|
|
|
|||
|
|
@ -107,8 +107,8 @@ tests =
|
|||
] =?>
|
||||
mconcat [ para "first block"
|
||||
, orderedList
|
||||
[ (para "top-level section 1" <>
|
||||
orderedList [ para "subsection" ])
|
||||
[ para "top-level section 1" <>
|
||||
orderedList [ para "subsection" ]
|
||||
, para "top-level section 2" ]
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ tests =
|
|||
|
||||
, "Underline" =:
|
||||
"_underline_" =?>
|
||||
para (underlineSpan $ "underline")
|
||||
para (underlineSpan "underline")
|
||||
|
||||
, "Strikeout" =:
|
||||
"+Kill Bill+" =?>
|
||||
|
|
@ -127,11 +127,12 @@ tests =
|
|||
|
||||
, "Markup should work properly after a blank line" =:
|
||||
T.unlines ["foo", "", "/bar/"] =?>
|
||||
(para $ text "foo") <> (para $ emph $ text "bar")
|
||||
para (text "foo") <>
|
||||
para (emph $ text "bar")
|
||||
|
||||
, "Inline math must stay within three lines" =:
|
||||
T.unlines [ "$a", "b", "c$", "$d", "e", "f", "g$" ] =?>
|
||||
para ((math "a\nb\nc") <> softbreak <>
|
||||
para (math "a\nb\nc" <> softbreak <>
|
||||
"$d" <> softbreak <> "e" <> softbreak <>
|
||||
"f" <> softbreak <> "g$")
|
||||
|
||||
|
|
@ -139,7 +140,7 @@ tests =
|
|||
"$a$ $b$! $c$?" =?>
|
||||
para (spcSep [ math "a"
|
||||
, "$b$!"
|
||||
, (math "c") <> "?"
|
||||
, math "c" <> "?"
|
||||
])
|
||||
|
||||
, "Markup may not span more than two lines" =:
|
||||
|
|
@ -166,12 +167,12 @@ tests =
|
|||
para (mconcat $ intersperse softbreak
|
||||
[ "a" <> subscript "(a(b)(c)d)"
|
||||
, "e" <> superscript "(f(g)h)"
|
||||
, "i" <> (subscript "(jk)") <> "l)"
|
||||
, "m" <> (superscript "()") <> "n"
|
||||
, "i" <> subscript "(jk)" <> "l)"
|
||||
, "m" <> superscript "()" <> "n"
|
||||
, "o" <> subscript "p{q{}r}"
|
||||
, "s" <> superscript "t{u}v"
|
||||
, "w" <> (subscript "xy") <> "z}"
|
||||
, "1" <> (superscript "") <> "2"
|
||||
, "w" <> subscript "xy" <> "z}"
|
||||
, "1" <> superscript "" <> "2"
|
||||
, "3" <> subscript "{}"
|
||||
, "4" <> superscript ("(a(" <> strong "b(c" <> ")d))")
|
||||
])
|
||||
|
|
@ -182,17 +183,17 @@ tests =
|
|||
, testGroup "Images"
|
||||
[ "Image" =:
|
||||
"[[./sunset.jpg]]" =?>
|
||||
(para $ image "./sunset.jpg" "" "")
|
||||
para (image "./sunset.jpg" "" "")
|
||||
|
||||
, "Image with explicit file: prefix" =:
|
||||
"[[file:sunrise.jpg]]" =?>
|
||||
(para $ image "sunrise.jpg" "" "")
|
||||
para (image "sunrise.jpg" "" "")
|
||||
|
||||
, "Multiple images within a paragraph" =:
|
||||
T.unlines [ "[[file:sunrise.jpg]]"
|
||||
, "[[file:sunset.jpg]]"
|
||||
] =?>
|
||||
(para $ (image "sunrise.jpg" "" "")
|
||||
para ((image "sunrise.jpg" "" "")
|
||||
<> softbreak
|
||||
<> (image "sunset.jpg" "" ""))
|
||||
|
||||
|
|
@ -200,75 +201,75 @@ tests =
|
|||
T.unlines [ "#+ATTR_HTML: :width 50%"
|
||||
, "[[file:guinea-pig.gif]]"
|
||||
] =?>
|
||||
(para $ imageWith ("", [], [("width", "50%")]) "guinea-pig.gif" "" "")
|
||||
para (imageWith ("", [], [("width", "50%")]) "guinea-pig.gif" "" "")
|
||||
]
|
||||
|
||||
, "Explicit link" =:
|
||||
"[[http://zeitlens.com/][pseudo-random /nonsense/]]" =?>
|
||||
(para $ link "http://zeitlens.com/" ""
|
||||
para (link "http://zeitlens.com/" ""
|
||||
("pseudo-random" <> space <> emph "nonsense"))
|
||||
|
||||
, "Self-link" =:
|
||||
"[[http://zeitlens.com/]]" =?>
|
||||
(para $ link "http://zeitlens.com/" "" "http://zeitlens.com/")
|
||||
para (link "http://zeitlens.com/" "" "http://zeitlens.com/")
|
||||
|
||||
, "Absolute file link" =:
|
||||
"[[/url][hi]]" =?>
|
||||
(para $ link "file:///url" "" "hi")
|
||||
para (link "file:///url" "" "hi")
|
||||
|
||||
, "Link to file in parent directory" =:
|
||||
"[[../file.txt][moin]]" =?>
|
||||
(para $ link "../file.txt" "" "moin")
|
||||
para (link "../file.txt" "" "moin")
|
||||
|
||||
, "Empty link (for gitit interop)" =:
|
||||
"[[][New Link]]" =?>
|
||||
(para $ link "" "" "New Link")
|
||||
para (link "" "" "New Link")
|
||||
|
||||
, "Image link" =:
|
||||
"[[sunset.png][file:dusk.svg]]" =?>
|
||||
(para $ link "sunset.png" "" (image "dusk.svg" "" ""))
|
||||
para (link "sunset.png" "" (image "dusk.svg" "" ""))
|
||||
|
||||
, "Image link with non-image target" =:
|
||||
"[[http://example.com][./logo.png]]" =?>
|
||||
(para $ link "http://example.com" "" (image "./logo.png" "" ""))
|
||||
para (link "http://example.com" "" (image "./logo.png" "" ""))
|
||||
|
||||
, "Plain link" =:
|
||||
"Posts on http://zeitlens.com/ can be funny at times." =?>
|
||||
(para $ spcSep [ "Posts", "on"
|
||||
para (spcSep [ "Posts", "on"
|
||||
, link "http://zeitlens.com/" "" "http://zeitlens.com/"
|
||||
, "can", "be", "funny", "at", "times."
|
||||
])
|
||||
|
||||
, "Angle link" =:
|
||||
"Look at <http://moltkeplatz.de> for fnords." =?>
|
||||
(para $ spcSep [ "Look", "at"
|
||||
para (spcSep [ "Look", "at"
|
||||
, link "http://moltkeplatz.de" "" "http://moltkeplatz.de"
|
||||
, "for", "fnords."
|
||||
])
|
||||
|
||||
, "Absolute file link" =:
|
||||
"[[file:///etc/passwd][passwd]]" =?>
|
||||
(para $ link "file:///etc/passwd" "" "passwd")
|
||||
para (link "file:///etc/passwd" "" "passwd")
|
||||
|
||||
, "File link" =:
|
||||
"[[file:target][title]]" =?>
|
||||
(para $ link "target" "" "title")
|
||||
para (link "target" "" "title")
|
||||
|
||||
, "Anchor" =:
|
||||
"<<anchor>> Link here later." =?>
|
||||
(para $ spanWith ("anchor", [], []) mempty <>
|
||||
para (spanWith ("anchor", [], []) mempty <>
|
||||
"Link" <> space <> "here" <> space <> "later.")
|
||||
|
||||
, "Inline code block" =:
|
||||
"src_emacs-lisp{(message \"Hello\")}" =?>
|
||||
(para $ codeWith ( ""
|
||||
para (codeWith ( ""
|
||||
, [ "commonlisp" ]
|
||||
, [ ("org-language", "emacs-lisp") ])
|
||||
"(message \"Hello\")")
|
||||
|
||||
, "Inline code block with arguments" =:
|
||||
"src_sh[:export both :results output]{echo 'Hello, World'}" =?>
|
||||
(para $ codeWith ( ""
|
||||
para (codeWith ( ""
|
||||
, [ "bash" ]
|
||||
, [ ("org-language", "sh")
|
||||
, ("export", "both")
|
||||
|
|
@ -279,7 +280,7 @@ tests =
|
|||
|
||||
, "Inline code block with toggle" =:
|
||||
"src_sh[:toggle]{echo $HOME}" =?>
|
||||
(para $ codeWith ( ""
|
||||
para (codeWith ( ""
|
||||
, [ "bash" ]
|
||||
, [ ("org-language", "sh")
|
||||
, ("toggle", "yes")
|
||||
|
|
@ -415,7 +416,7 @@ tests =
|
|||
in [
|
||||
"Berkeley-style in-text citation" =:
|
||||
"See @Dominik201408." =?>
|
||||
(para $ "See "
|
||||
para ("See "
|
||||
<> cite [dominikInText] "@Dominik201408"
|
||||
<> ".")
|
||||
|
||||
|
|
@ -468,7 +469,7 @@ tests =
|
|||
|
||||
, "MathML symbol in LaTeX-style" =:
|
||||
"There is a hackerspace in Lübeck, Germany, called nbsp (unicode symbol: '\\nbsp')." =?>
|
||||
para ("There is a hackerspace in Lübeck, Germany, called nbsp (unicode symbol: ' ').")
|
||||
para "There is a hackerspace in Lübeck, Germany, called nbsp (unicode symbol: ' ')."
|
||||
|
||||
, "MathML symbol in LaTeX-style, including braces" =:
|
||||
"\\Aacute{}stor" =?>
|
||||
|
|
|
|||
|
|
@ -84,4 +84,3 @@ tests =
|
|||
, para "next"
|
||||
]
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -38,9 +38,9 @@ tests =
|
|||
|
||||
, test orgSmart "Single quotes can be followed by emphasized text"
|
||||
("Singles on the '/meat market/'" =?>
|
||||
para ("Singles on the " <> (singleQuoted $ emph "meat market")))
|
||||
para ("Singles on the " <> singleQuoted (emph "meat market")))
|
||||
|
||||
, test orgSmart "Double quotes can be followed by emphasized text"
|
||||
("Double income, no kids: \"/DINK/\"" =?>
|
||||
para ("Double income, no kids: " <> (doubleQuoted $ emph "DINK")))
|
||||
para ("Double income, no kids: " <> doubleQuoted (emph "DINK")))
|
||||
]
|
||||
|
|
|
|||
|
|
@ -30,32 +30,32 @@ tests =
|
|||
, "Title" =:
|
||||
"#+TITLE: Hello, World" =?>
|
||||
let titleInline = toList $ "Hello," <> space <> "World"
|
||||
meta = setMeta "title" (MetaInlines titleInline) $ nullMeta
|
||||
meta = setMeta "title" (MetaInlines titleInline) nullMeta
|
||||
in Pandoc meta mempty
|
||||
|
||||
, "Author" =:
|
||||
"#+author: John /Emacs-Fanboy/ Doe" =?>
|
||||
let author = toList . spcSep $ [ "John", emph "Emacs-Fanboy", "Doe" ]
|
||||
meta = setMeta "author" (MetaList [MetaInlines author]) $ nullMeta
|
||||
meta = setMeta "author" (MetaList [MetaInlines author]) nullMeta
|
||||
in Pandoc meta mempty
|
||||
|
||||
, "Multiple authors" =:
|
||||
"#+author: James Dewey Watson, Francis Harry Compton Crick " =?>
|
||||
let watson = MetaInlines $ toList "James Dewey Watson"
|
||||
crick = MetaInlines $ toList "Francis Harry Compton Crick"
|
||||
meta = setMeta "author" (MetaList [watson, crick]) $ nullMeta
|
||||
meta = setMeta "author" (MetaList [watson, crick]) nullMeta
|
||||
in Pandoc meta mempty
|
||||
|
||||
, "Date" =:
|
||||
"#+Date: Feb. *28*, 2014" =?>
|
||||
let date = toList . spcSep $ [ "Feb.", (strong "28") <> ",", "2014" ]
|
||||
meta = setMeta "date" (MetaInlines date) $ nullMeta
|
||||
let date = toList . spcSep $ [ "Feb.", strong "28" <> ",", "2014" ]
|
||||
meta = setMeta "date" (MetaInlines date) nullMeta
|
||||
in Pandoc meta mempty
|
||||
|
||||
, "Description" =:
|
||||
"#+DESCRIPTION: Explanatory text" =?>
|
||||
let description = "Explanatory text"
|
||||
meta = setMeta "description" (MetaString description) $ nullMeta
|
||||
meta = setMeta "description" (MetaString description) nullMeta
|
||||
in Pandoc meta mempty
|
||||
|
||||
, "Properties drawer" =:
|
||||
|
|
@ -94,7 +94,7 @@ tests =
|
|||
, "#+author: Max"
|
||||
] =?>
|
||||
let author = MetaInlines [Str "Max"]
|
||||
meta = setMeta "author" (MetaList [author]) $ nullMeta
|
||||
meta = setMeta "author" (MetaList [author]) nullMeta
|
||||
in Pandoc meta mempty
|
||||
|
||||
, "Logbook drawer" =:
|
||||
|
|
@ -135,7 +135,7 @@ tests =
|
|||
|
||||
, "Search links are read as emph" =:
|
||||
"[[Wally][Where's Wally?]]" =?>
|
||||
(para (emph $ "Where's" <> space <> "Wally?"))
|
||||
para (emph $ "Where's" <> space <> "Wally?")
|
||||
|
||||
, "Link to nonexistent anchor" =:
|
||||
T.unlines [ "<<link-here>> Target."
|
||||
|
|
@ -149,25 +149,25 @@ tests =
|
|||
T.unlines [ "#+LINK: wp https://en.wikipedia.org/wiki/%s"
|
||||
, "[[wp:Org_mode][Wikipedia on Org-mode]]"
|
||||
] =?>
|
||||
(para (link "https://en.wikipedia.org/wiki/Org_mode" ""
|
||||
("Wikipedia" <> space <> "on" <> space <> "Org-mode")))
|
||||
para (link "https://en.wikipedia.org/wiki/Org_mode" ""
|
||||
("Wikipedia" <> space <> "on" <> space <> "Org-mode"))
|
||||
|
||||
, "Link abbreviation, defined after first use" =:
|
||||
T.unlines [ "[[zl:non-sense][Non-sense articles]]"
|
||||
, "#+LINK: zl http://zeitlens.com/tags/%s.html"
|
||||
] =?>
|
||||
(para (link "http://zeitlens.com/tags/non-sense.html" ""
|
||||
("Non-sense" <> space <> "articles")))
|
||||
para (link "http://zeitlens.com/tags/non-sense.html" ""
|
||||
("Non-sense" <> space <> "articles"))
|
||||
|
||||
, "Link abbreviation, URL encoded arguments" =:
|
||||
T.unlines [ "#+link: expl http://example.com/%h/foo"
|
||||
, "[[expl:Hello, World!][Moin!]]"
|
||||
] =?>
|
||||
(para (link "http://example.com/Hello%2C%20World%21/foo" "" "Moin!"))
|
||||
para (link "http://example.com/Hello%2C%20World%21/foo" "" "Moin!")
|
||||
|
||||
, "Link abbreviation, append arguments" =:
|
||||
T.unlines [ "#+link: expl http://example.com/"
|
||||
, "[[expl:foo][bar]]"
|
||||
] =?>
|
||||
(para (link "http://example.com/foo" "" "bar"))
|
||||
para (link "http://example.com/foo" "" "bar")
|
||||
]
|
||||
|
|
|
|||
|
|
@ -36,8 +36,8 @@ tests = [ "line block with blank line" =:
|
|||
, ":Parameter i: integer"
|
||||
, ":Final: item"
|
||||
, " on two lines" ]
|
||||
=?> ( doc
|
||||
$ para "para" <>
|
||||
=?>
|
||||
doc (para "para" <>
|
||||
definitionList [ (str "Hostname", [para "media08"])
|
||||
, (text "IP address", [para "10.0.0.19"])
|
||||
, (str "Size", [para "3ru"])
|
||||
|
|
@ -56,10 +56,10 @@ tests = [ "line block with blank line" =:
|
|||
, ""
|
||||
, ":Version: 1"
|
||||
]
|
||||
=?> ( setMeta "version" (para "1")
|
||||
$ setMeta "title" ("Title" :: Inlines)
|
||||
=?>
|
||||
setMeta "version" (para "1") (setMeta "title" ("Title" :: Inlines)
|
||||
$ setMeta "subtitle" ("Subtitle" :: Inlines)
|
||||
$ doc mempty )
|
||||
$ doc mempty)
|
||||
, "with inline markup" =: T.unlines
|
||||
[ ":*Date*: today"
|
||||
, ""
|
||||
|
|
@ -73,8 +73,8 @@ tests = [ "line block with blank line" =:
|
|||
, ".. _two: http://example.com"
|
||||
, ".. _three: http://example.org"
|
||||
]
|
||||
=?> ( setMeta "date" (str "today")
|
||||
$ doc
|
||||
=?>
|
||||
setMeta "date" (str "today") (doc
|
||||
$ definitionList [ (emph "one", [para "emphasis"])
|
||||
, (link "http://example.com" "" "two", [para "reference"])
|
||||
, (link "http://example.org" "" "three", [para "another one"])
|
||||
|
|
@ -102,13 +102,12 @@ tests = [ "line block with blank line" =:
|
|||
, " def func(x):"
|
||||
, " return y"
|
||||
] =?>
|
||||
( doc $ codeBlockWith
|
||||
doc (codeBlockWith
|
||||
( ""
|
||||
, ["sourceCode", "python", "numberLines", "class1", "class2", "class3"]
|
||||
, [ ("startFrom", "34") ]
|
||||
)
|
||||
"def func(x):\n return y"
|
||||
)
|
||||
"def func(x):\n return y")
|
||||
, "Code directive with number-lines, no line specified" =: T.unlines
|
||||
[ ".. code::python"
|
||||
, " :number-lines: "
|
||||
|
|
@ -116,13 +115,12 @@ tests = [ "line block with blank line" =:
|
|||
, " def func(x):"
|
||||
, " return y"
|
||||
] =?>
|
||||
( doc $ codeBlockWith
|
||||
doc (codeBlockWith
|
||||
( ""
|
||||
, ["sourceCode", "python", "numberLines"]
|
||||
, [ ("startFrom", "") ]
|
||||
)
|
||||
"def func(x):\n return y"
|
||||
)
|
||||
"def func(x):\n return y")
|
||||
, testGroup "literal / line / code blocks"
|
||||
[ "indented literal block" =: T.unlines
|
||||
[ "::"
|
||||
|
|
@ -131,7 +129,8 @@ tests = [ "line block with blank line" =:
|
|||
, ""
|
||||
, " can go on for many lines"
|
||||
, "but must stop here"]
|
||||
=?> (doc $
|
||||
=?>
|
||||
doc (
|
||||
codeBlock "block quotes\n\ncan go on for many lines" <>
|
||||
para "but must stop here")
|
||||
, "line block with 3 lines" =: "| a\n| b\n| c"
|
||||
|
|
@ -185,6 +184,6 @@ tests = [ "line block with blank line" =:
|
|||
, ".. [1]"
|
||||
, " bar"
|
||||
] =?>
|
||||
(para $ "foo" <> (note $ para "bar"))
|
||||
para ("foo" <> (note $ para "bar"))
|
||||
]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -30,11 +30,11 @@ simpleTable' :: Int
|
|||
-> [Blocks]
|
||||
-> [[Blocks]]
|
||||
-> Blocks
|
||||
simpleTable' n = table "" (take n $ repeat (AlignCenter, 0.0))
|
||||
simpleTable' n = table "" (replicate n (AlignCenter, 0.0))
|
||||
|
||||
tests :: [TestTree]
|
||||
tests =
|
||||
[ testGroup "Inlines" $
|
||||
[ testGroup "Inlines"
|
||||
[ "Plain String" =:
|
||||
"Hello, World" =?>
|
||||
para (spcSep [ "Hello,", "World" ])
|
||||
|
|
@ -114,7 +114,7 @@ tests =
|
|||
|
||||
]
|
||||
|
||||
, testGroup "Basic Blocks" $
|
||||
, testGroup "Basic Blocks"
|
||||
["Paragraph, lines grouped together" =:
|
||||
"A paragraph\n A blank line ends the \n current paragraph\n"
|
||||
=?> para "A paragraph\n A blank line ends the\n current paragraph"
|
||||
|
|
@ -197,7 +197,7 @@ tests =
|
|||
|
||||
]
|
||||
|
||||
, testGroup "Lists" $
|
||||
, testGroup "Lists"
|
||||
[ "Simple Bullet Lists" =:
|
||||
("- Item1\n" <>
|
||||
"- Item2\n") =?>
|
||||
|
|
|
|||
|
|
@ -19,21 +19,21 @@ tests = [ testGroup "compactifyDL"
|
|||
|
||||
testCollapse :: [TestTree]
|
||||
testCollapse = map (testCase "collapse")
|
||||
[ (collapseFilePath (joinPath [ ""]) @?= (joinPath [ ""]))
|
||||
, (collapseFilePath (joinPath [ ".","foo"]) @?= (joinPath [ "foo"]))
|
||||
, (collapseFilePath (joinPath [ ".",".","..","foo"]) @?= (joinPath [ joinPath ["..", "foo"]]))
|
||||
, (collapseFilePath (joinPath [ "..","foo"]) @?= (joinPath [ "..","foo"]))
|
||||
, (collapseFilePath (joinPath [ "","bar","..","baz"]) @?= (joinPath [ "","baz"]))
|
||||
, (collapseFilePath (joinPath [ "","..","baz"]) @?= (joinPath [ "","..","baz"]))
|
||||
, (collapseFilePath (joinPath [ ".","foo","..",".","bar","..",".",".","baz"]) @?= (joinPath [ "baz"]))
|
||||
, (collapseFilePath (joinPath [ ".",""]) @?= (joinPath [ ""]))
|
||||
, (collapseFilePath (joinPath [ ".",".",""]) @?= (joinPath [ ""]))
|
||||
, (collapseFilePath (joinPath [ "..",""]) @?= (joinPath [ ".."]))
|
||||
, (collapseFilePath (joinPath [ "..",".",""]) @?= (joinPath [ ".."]))
|
||||
, (collapseFilePath (joinPath [ ".","..",""]) @?= (joinPath [ ".."]))
|
||||
, (collapseFilePath (joinPath [ "..","..",""]) @?= (joinPath [ "..",".."]))
|
||||
, (collapseFilePath (joinPath [ "parent","foo","baz","..","bar"]) @?= (joinPath [ "parent","foo","bar"]))
|
||||
, (collapseFilePath (joinPath [ "parent","foo","baz","..","..","bar"]) @?= (joinPath [ "parent","bar"]))
|
||||
, (collapseFilePath (joinPath [ "parent","foo",".."]) @?= (joinPath [ "parent"]))
|
||||
, (collapseFilePath (joinPath [ "","parent","foo","..","..","bar"]) @?= (joinPath [ "","bar"]))
|
||||
, (collapseFilePath (joinPath [ "",".","parent","foo"]) @?= (joinPath [ "","parent","foo"]))]
|
||||
[ collapseFilePath (joinPath [ ""]) @?= (joinPath [ ""])
|
||||
, collapseFilePath (joinPath [ ".","foo"]) @?= (joinPath [ "foo"])
|
||||
, collapseFilePath (joinPath [ ".",".","..","foo"]) @?= (joinPath [ joinPath ["..", "foo"]])
|
||||
, collapseFilePath (joinPath [ "..","foo"]) @?= (joinPath [ "..","foo"])
|
||||
, collapseFilePath (joinPath [ "","bar","..","baz"]) @?= (joinPath [ "","baz"])
|
||||
, collapseFilePath (joinPath [ "","..","baz"]) @?= (joinPath [ "","..","baz"])
|
||||
, collapseFilePath (joinPath [ ".","foo","..",".","bar","..",".",".","baz"]) @?= (joinPath [ "baz"])
|
||||
, collapseFilePath (joinPath [ ".",""]) @?= (joinPath [ ""])
|
||||
, collapseFilePath (joinPath [ ".",".",""]) @?= (joinPath [ ""])
|
||||
, collapseFilePath (joinPath [ "..",""]) @?= (joinPath [ ".."])
|
||||
, collapseFilePath (joinPath [ "..",".",""]) @?= (joinPath [ ".."])
|
||||
, collapseFilePath (joinPath [ ".","..",""]) @?= (joinPath [ ".."])
|
||||
, collapseFilePath (joinPath [ "..","..",""]) @?= (joinPath [ "..",".."])
|
||||
, collapseFilePath (joinPath [ "parent","foo","baz","..","bar"]) @?= (joinPath [ "parent","foo","bar"])
|
||||
, collapseFilePath (joinPath [ "parent","foo","baz","..","..","bar"]) @?= (joinPath [ "parent","bar"])
|
||||
, collapseFilePath (joinPath [ "parent","foo",".."]) @?= (joinPath [ "parent"])
|
||||
, collapseFilePath (joinPath [ "","parent","foo","..","..","bar"]) @?= (joinPath [ "","bar"])
|
||||
, collapseFilePath (joinPath [ "",".","parent","foo"]) @?= (joinPath [ "","parent","foo"])]
|
||||
|
|
|
|||
|
|
@ -41,9 +41,9 @@ tests = [ testGroup "inline code"
|
|||
, "without '}'" =: code "]" =?> "\\type{]}"
|
||||
, testProperty "code property" $ \s -> null s ||
|
||||
if '{' `elem` s || '}' `elem` s
|
||||
then (context' $ code s) == "\\mono{" ++
|
||||
(context' $ str s) ++ "}"
|
||||
else (context' $ code s) == "\\type{" ++ s ++ "}"
|
||||
then context' (code s) == "\\mono{" ++
|
||||
context' (str s) ++ "}"
|
||||
else context' (code s) == "\\type{" ++ s ++ "}"
|
||||
]
|
||||
, testGroup "headers"
|
||||
[ "level 1" =:
|
||||
|
|
@ -124,4 +124,3 @@ tests = [ testGroup "inline code"
|
|||
, "\\stopplacetable" ]
|
||||
]
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -230,7 +230,7 @@ tests = [ testGroup "line blocks"
|
|||
]
|
||||
]
|
||||
]
|
||||
, testGroup "writer options" $
|
||||
, testGroup "writer options"
|
||||
[ testGroup "top-level division" $
|
||||
let
|
||||
headers = header 1 (text "header1")
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ tests = [ testGroup "block elements"
|
|||
]
|
||||
, testGroup "inlines"
|
||||
[
|
||||
"Emphasis" =: emph ("emphasized")
|
||||
"Emphasis" =: emph "emphasized"
|
||||
=?> fb2 "<emphasis>emphasized</emphasis>"
|
||||
]
|
||||
, "bullet list" =: bulletList [ plain $ text "first"
|
||||
|
|
|
|||
|
|
@ -120,5 +120,3 @@ tests = [ testGroup "inline code"
|
|||
\</sec>"
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -80,7 +80,7 @@ noteTestDoc =
|
|||
".") <>
|
||||
blockQuote (para ("A note inside a block quote." <>
|
||||
note (para "The second note.")) <>
|
||||
para ("A second paragraph.")) <>
|
||||
para "A second paragraph.") <>
|
||||
header 1 "Second Header" <>
|
||||
para "Some more text."
|
||||
|
||||
|
|
@ -91,7 +91,7 @@ noteTests = testGroup "note and reference location"
|
|||
[ test (markdownWithOpts defopts)
|
||||
"footnotes at the end of a document" $
|
||||
noteTestDoc =?>
|
||||
(unlines $ [ "First Header"
|
||||
(unlines [ "First Header"
|
||||
, "============"
|
||||
, ""
|
||||
, "This is a footnote.[^1] And this is a [link](https://www.google.com)."
|
||||
|
|
@ -112,7 +112,7 @@ noteTests = testGroup "note and reference location"
|
|||
, test (markdownWithOpts defopts{writerReferenceLocation=EndOfBlock})
|
||||
"footnotes at the end of blocks" $
|
||||
noteTestDoc =?>
|
||||
(unlines $ [ "First Header"
|
||||
(unlines [ "First Header"
|
||||
, "============"
|
||||
, ""
|
||||
, "This is a footnote.[^1] And this is a [link](https://www.google.com)."
|
||||
|
|
@ -133,7 +133,7 @@ noteTests = testGroup "note and reference location"
|
|||
, test (markdownWithOpts defopts{writerReferenceLocation=EndOfBlock, writerReferenceLinks=True})
|
||||
"footnotes and reference links at the end of blocks" $
|
||||
noteTestDoc =?>
|
||||
(unlines $ [ "First Header"
|
||||
(unlines [ "First Header"
|
||||
, "============"
|
||||
, ""
|
||||
, "This is a footnote.[^1] And this is a [link]."
|
||||
|
|
@ -156,7 +156,7 @@ noteTests = testGroup "note and reference location"
|
|||
, test (markdownWithOpts defopts{writerReferenceLocation=EndOfSection})
|
||||
"footnotes at the end of section" $
|
||||
noteTestDoc =?>
|
||||
(unlines $ [ "First Header"
|
||||
(unlines [ "First Header"
|
||||
, "============"
|
||||
, ""
|
||||
, "This is a footnote.[^1] And this is a [link](https://www.google.com)."
|
||||
|
|
@ -186,27 +186,27 @@ shortcutLinkRefsTests =
|
|||
(=:) = test (purely (writeMarkdown defopts{writerReferenceLinks = True}) . toPandoc)
|
||||
in testGroup "Shortcut reference links"
|
||||
[ "Simple link (shortcutable)"
|
||||
=: (para (link "/url" "title" "foo"))
|
||||
=: para (link "/url" "title" "foo")
|
||||
=?> "[foo]\n\n [foo]: /url \"title\""
|
||||
, "Followed by another link (unshortcutable)"
|
||||
=: (para ((link "/url1" "title1" "first")
|
||||
<> (link "/url2" "title2" "second")))
|
||||
=: para ((link "/url1" "title1" "first")
|
||||
<> (link "/url2" "title2" "second"))
|
||||
=?> unlines [ "[first][][second]"
|
||||
, ""
|
||||
, " [first]: /url1 \"title1\""
|
||||
, " [second]: /url2 \"title2\""
|
||||
]
|
||||
, "Followed by space and another link (unshortcutable)"
|
||||
=: (para ((link "/url1" "title1" "first") <> " "
|
||||
<> (link "/url2" "title2" "second")))
|
||||
=: para ((link "/url1" "title1" "first") <> " "
|
||||
<> (link "/url2" "title2" "second"))
|
||||
=?> unlines [ "[first][] [second]"
|
||||
, ""
|
||||
, " [first]: /url1 \"title1\""
|
||||
, " [second]: /url2 \"title2\""
|
||||
]
|
||||
, "Reference link is used multiple times (unshortcutable)"
|
||||
=: (para ((link "/url1" "" "foo") <> (link "/url2" "" "foo")
|
||||
<> (link "/url3" "" "foo")))
|
||||
=: para ((link "/url1" "" "foo") <> (link "/url2" "" "foo")
|
||||
<> (link "/url3" "" "foo"))
|
||||
=?> unlines [ "[foo][][foo][1][foo][2]"
|
||||
, ""
|
||||
, " [foo]: /url1"
|
||||
|
|
@ -214,8 +214,8 @@ shortcutLinkRefsTests =
|
|||
, " [2]: /url3"
|
||||
]
|
||||
, "Reference link is used multiple times (unshortcutable)"
|
||||
=: (para ((link "/url1" "" "foo") <> " " <> (link "/url2" "" "foo")
|
||||
<> " " <> (link "/url3" "" "foo")))
|
||||
=: para ((link "/url1" "" "foo") <> " " <> (link "/url2" "" "foo")
|
||||
<> " " <> (link "/url3" "" "foo"))
|
||||
=?> unlines [ "[foo][] [foo][1] [foo][2]"
|
||||
, ""
|
||||
, " [foo]: /url1"
|
||||
|
|
@ -223,43 +223,43 @@ shortcutLinkRefsTests =
|
|||
, " [2]: /url3"
|
||||
]
|
||||
, "Reference link is followed by text in brackets"
|
||||
=: (para ((link "/url" "" "link") <> "[text in brackets]"))
|
||||
=: para ((link "/url" "" "link") <> "[text in brackets]")
|
||||
=?> unlines [ "[link][]\\[text in brackets\\]"
|
||||
, ""
|
||||
, " [link]: /url"
|
||||
]
|
||||
, "Reference link is followed by space and text in brackets"
|
||||
=: (para ((link "/url" "" "link") <> " [text in brackets]"))
|
||||
=: para ((link "/url" "" "link") <> " [text in brackets]")
|
||||
=?> unlines [ "[link][] \\[text in brackets\\]"
|
||||
, ""
|
||||
, " [link]: /url"
|
||||
]
|
||||
, "Reference link is followed by RawInline"
|
||||
=: (para ((link "/url" "" "link") <> rawInline "markdown" "[rawText]"))
|
||||
=: para ((link "/url" "" "link") <> rawInline "markdown" "[rawText]")
|
||||
=?> unlines [ "[link][][rawText]"
|
||||
, ""
|
||||
, " [link]: /url"
|
||||
]
|
||||
, "Reference link is followed by space and RawInline"
|
||||
=: (para ((link "/url" "" "link") <> space <> rawInline "markdown" "[rawText]"))
|
||||
=: para ((link "/url" "" "link") <> space <> rawInline "markdown" "[rawText]")
|
||||
=?> unlines [ "[link][] [rawText]"
|
||||
, ""
|
||||
, " [link]: /url"
|
||||
]
|
||||
, "Reference link is followed by RawInline with space"
|
||||
=: (para ((link "/url" "" "link") <> rawInline "markdown" " [rawText]"))
|
||||
=: para ((link "/url" "" "link") <> rawInline "markdown" " [rawText]")
|
||||
=?> unlines [ "[link][] [rawText]"
|
||||
, ""
|
||||
, " [link]: /url"
|
||||
]
|
||||
, "Reference link is followed by citation"
|
||||
=: (para ((link "/url" "" "link") <> cite [Citation "author" [] [] NormalCitation 0 0] (str "[@author]")))
|
||||
=: para ((link "/url" "" "link") <> cite [Citation "author" [] [] NormalCitation 0 0] (str "[@author]"))
|
||||
=?> unlines [ "[link][][@author]"
|
||||
, ""
|
||||
, " [link]: /url"
|
||||
]
|
||||
, "Reference link is followed by space and citation"
|
||||
=: (para ((link "/url" "" "link") <> space <> cite [Citation "author" [] [] NormalCitation 0 0] (str "[@author]")))
|
||||
=: para ((link "/url" "" "link") <> space <> cite [Citation "author" [] [] NormalCitation 0 0] (str "[@author]"))
|
||||
=?> unlines [ "[link][] [@author]"
|
||||
, ""
|
||||
, " [link]: /url"
|
||||
|
|
|
|||
|
|
@ -18,5 +18,5 @@ p_write_blocks_rt bs =
|
|||
tests :: [TestTree]
|
||||
tests = [ testProperty "p_write_rt" p_write_rt
|
||||
, testProperty "p_write_blocks_rt" $ mapSize
|
||||
(\x -> if x > 3 then 3 else x) $ p_write_blocks_rt
|
||||
(\x -> if x > 3 then 3 else x) p_write_blocks_rt
|
||||
]
|
||||
|
|
|
|||
|
|
@ -72,7 +72,7 @@ numSlideTests = testGroup "Number of slides in output"
|
|||
def
|
||||
(doc $
|
||||
para "first slide" <>
|
||||
(para $ image "lalune.jpg" "" "") <>
|
||||
para (image "lalune.jpg" "" "") <>
|
||||
para "foo")
|
||||
, testNumberOfSlides
|
||||
"With image slide, header" 3
|
||||
|
|
@ -80,14 +80,14 @@ numSlideTests = testGroup "Number of slides in output"
|
|||
(doc $
|
||||
para "first slide" <>
|
||||
header 2 "image header" <>
|
||||
(para $ image "lalune.jpg" "" "") <>
|
||||
para (image "lalune.jpg" "" "") <>
|
||||
para "foo")
|
||||
, testNumberOfSlides
|
||||
"With table, no header" 3
|
||||
def
|
||||
(doc $
|
||||
para "first slide" <>
|
||||
(simpleTable [para "foo" <> para "bar"] [[para "this" <> para "that"]]) <>
|
||||
simpleTable [para "foo" <> para "bar"] [[para "this" <> para "that"]] <>
|
||||
para "foo")
|
||||
, testNumberOfSlides
|
||||
"With table, header" 3
|
||||
|
|
@ -95,7 +95,7 @@ numSlideTests = testGroup "Number of slides in output"
|
|||
(doc $
|
||||
para "first slide" <>
|
||||
header 2 "table header" <>
|
||||
(simpleTable [para "foo" <> para "bar"] [[para "this" <> para "that"]]) <>
|
||||
simpleTable [para "foo" <> para "bar"] [[para "this" <> para "that"]] <>
|
||||
para "foo")
|
||||
, testNumberOfSlides
|
||||
"hrule" 2
|
||||
|
|
@ -117,7 +117,7 @@ contentTypesFileExists opts pd =
|
|||
testCase "Existence of [Content_Types].xml file" $
|
||||
do archive <- getPptxArchive opts pd
|
||||
assertBool "Missing [Content_Types].xml file" $
|
||||
"[Content_Types].xml" `elem` (filesInArchive archive)
|
||||
"[Content_Types].xml" `elem` filesInArchive archive
|
||||
|
||||
|
||||
|
||||
|
|
@ -138,7 +138,7 @@ prop_ContentOverrides pd = do
|
|||
Nothing -> throwIO $
|
||||
PandocSomeError "Missing [Content_Types].xml file"
|
||||
typesElem <- case parseXMLDoc contentTypes of
|
||||
Just element -> return $ element
|
||||
Just element -> return element
|
||||
Nothing -> throwIO $
|
||||
PandocSomeError "[Content_Types].xml cannot be parsed"
|
||||
let ns = findAttr (QName "xmlns" Nothing Nothing) typesElem
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@ tests = [ testGroup "block elements"
|
|||
]
|
||||
, testGroup "inlines"
|
||||
[
|
||||
"Emphasis" =: emph ("emphasized")
|
||||
"Emphasis" =: emph "emphasized"
|
||||
=?> "<p><hi rendition=\"simple:italic\">emphasized</hi></p>"
|
||||
,"SingleQuoted" =: singleQuoted (text "quoted material")
|
||||
=?> "<p><quote>quoted material</quote></p>"
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue