Apply linter suggestions. Add fix_spacing to lint target in Makefile.
This commit is contained in:
parent
6cd77d4c63
commit
4c3db9273f
51 changed files with 247 additions and 279 deletions
14
Makefile
14
Makefile
|
@ -1,6 +1,6 @@
|
|||
version?=$(shell grep '^[Vv]ersion:' pandoc.cabal | awk '{print $$2;}')
|
||||
pandoc=$(shell find dist -name pandoc -type f -exec ls -t {} \; | head -1)
|
||||
SOURCEFILES?=$(shell find pandoc.hs src test -name '*.hs')
|
||||
SOURCEFILES?=$(shell git ls-tree -r master --name-only | grep "\.hs$$")
|
||||
BRANCH?=master
|
||||
RESOLVER?=lts-13
|
||||
GHCOPTS=-fdiagnostics-color=always
|
||||
|
@ -45,8 +45,14 @@ weigh:
|
|||
reformat:
|
||||
for f in $(SOURCEFILES); do echo $$f; stylish-haskell -i $$f ; done
|
||||
|
||||
lint:
|
||||
for f in $(SOURCEFILES); do echo $$f; hlint --verbose --refactor --refactor-options='-i -s' $$f; done
|
||||
lint: hlint fix_spacing
|
||||
|
||||
hlint:
|
||||
for f in $(SOURCEFILES); do echo $$f; hlint --verbose --refactor --refactor-options='-s -o -' $$f; done
|
||||
|
||||
fix_spacing:
|
||||
# Fix trailing newlines and spaces at ends of lines
|
||||
for f in $(SOURCEFILES); do printf '%s\n' "`cat $$f`" | sed -e 's/ *$$//' > $$f.tmp; mv $$f.tmp $$f; done
|
||||
|
||||
changes_github:
|
||||
pandoc --filter tools/extract-changes.hs changelog.md -t gfm --wrap=none | sed -e 's/\\#/#/g' | pbcopy
|
||||
|
@ -142,4 +148,4 @@ update-website:
|
|||
clean:
|
||||
stack clean
|
||||
|
||||
.PHONY: deps quick full haddock install clean test bench changes_github macospkg dist prof download_stats reformat lint weigh doc/lua-filters.md packages pandoc-templates trypandoc update-website debpkg macospkg winpkg checkdocs ghcid ghci
|
||||
.PHONY: deps quick full haddock install clean test bench changes_github macospkg dist prof download_stats reformat lint weigh doc/lua-filters.md packages pandoc-templates trypandoc update-website debpkg macospkg winpkg checkdocs ghcid ghci fix_spacing hlint
|
||||
|
|
|
@ -48,5 +48,3 @@ weighReader doc name reader = do
|
|||
let inp = either (error . show) id $ runPure $ writer def{ writerWrapText = WrapAuto} doc
|
||||
in func (unpack $ name <> " reader") reader inp
|
||||
_ -> return () -- no writer for reader
|
||||
|
||||
|
||||
|
|
|
@ -149,7 +149,7 @@ convertWithOpts opts = do
|
|||
let pdfOutput = map toLower (takeExtension outputFile) == ".pdf"
|
||||
|
||||
when (pdfOutput && readerName == "latex") $
|
||||
case (optInputFiles opts) of
|
||||
case optInputFiles opts of
|
||||
Just (inputFile:_) -> report $ UnusualConversion $ T.pack $
|
||||
"to convert a .tex file to PDF, you get better results by using pdflatex "
|
||||
<> "(or lualatex or xelatex) directly, try `pdflatex " <> inputFile
|
||||
|
|
|
@ -189,10 +189,10 @@ doOpt (k',v) = do
|
|||
parseYAML v >>= \x -> return (\o -> o{ optMetadata = optMetadata o <>
|
||||
contextToMeta x })
|
||||
"metadata-files" ->
|
||||
(parseYAML v >>= \x ->
|
||||
parseYAML v >>= \x ->
|
||||
return (\o -> o{ optMetadataFiles =
|
||||
optMetadataFiles o <>
|
||||
map unpack x }))
|
||||
map unpack x })
|
||||
"metadata-file" -> -- allow either a list or a single value
|
||||
(parseYAML v >>= \x -> return (\o -> o{ optMetadataFiles =
|
||||
optMetadataFiles o <>
|
||||
|
|
|
@ -23,4 +23,3 @@ import Text.Pandoc.Lua.Filter (runFilterFile)
|
|||
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
|
||||
import Text.Pandoc.Lua.Init (LuaException (..), runLua)
|
||||
import Text.Pandoc.Lua.Marshaling ()
|
||||
|
||||
|
|
|
@ -29,4 +29,3 @@ instance (TemplateTarget a, Pushable a) => Pushable (Val a) where
|
|||
push (MapVal ctx) = Lua.push ctx
|
||||
push (ListVal xs) = Lua.push xs
|
||||
push (SimpleVal d) = Lua.push $ render Nothing d
|
||||
|
||||
|
|
|
@ -154,4 +154,3 @@ must_be_at_least actual expected optMsg = do
|
|||
Lua.push (showVersion actual)
|
||||
Lua.call 3 1
|
||||
Lua.error
|
||||
|
||||
|
|
|
@ -679,7 +679,7 @@ mathInlineWith op cl = try $ do
|
|||
where
|
||||
inBalancedBraces :: Stream s m Char => Int -> Text -> ParserT s st m Text
|
||||
inBalancedBraces n = fmap T.pack . inBalancedBraces' n . T.unpack
|
||||
|
||||
|
||||
inBalancedBraces' :: Stream s m Char => Int -> String -> ParserT s st m String
|
||||
inBalancedBraces' 0 "" = do
|
||||
c <- anyChar
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{- |
|
||||
Module : Text.Pandoc.Readers.RST
|
||||
|
@ -42,4 +42,3 @@ readCSV _opts s =
|
|||
widths = replicate numcols 0
|
||||
Right [] -> return $ B.doc mempty
|
||||
Left e -> throwError $ PandocParsecError s e
|
||||
|
||||
|
|
|
@ -1106,9 +1106,8 @@ equation e constructor =
|
|||
|
||||
readMath :: (Element -> Bool) -> (Element -> b) -> [b]
|
||||
readMath childPredicate fromElement =
|
||||
( map (fromElement . everywhere (mkT removePrefix))
|
||||
map (fromElement . everywhere (mkT removePrefix))
|
||||
$ filterChildren childPredicate e
|
||||
)
|
||||
|
||||
-- | Get the actual text stored in a CData block. 'showContent'
|
||||
-- returns the text still surrounded by the [[CDATA]] tags.
|
||||
|
|
|
@ -42,7 +42,7 @@ escapedQuote = string "\\\"" $> "\\\""
|
|||
|
||||
inQuotes :: Parser T.Text
|
||||
inQuotes =
|
||||
(try escapedQuote) <|> (anyChar >>= (\c -> return $ T.singleton c))
|
||||
try escapedQuote <|> (anyChar >>= (\c -> return $ T.singleton c))
|
||||
|
||||
quotedString :: Parser T.Text
|
||||
quotedString = do
|
||||
|
@ -50,7 +50,7 @@ quotedString = do
|
|||
T.concat <$> manyTill inQuotes (try (char '"'))
|
||||
|
||||
unquotedString :: Parser T.Text
|
||||
unquotedString = T.pack <$> manyTill anyChar (try $ lookAhead space *> return () <|> eof)
|
||||
unquotedString = T.pack <$> manyTill anyChar (try $ lookAhead space Data.Functor.$> () <|> eof)
|
||||
|
||||
fieldArgument :: Parser T.Text
|
||||
fieldArgument = quotedString <|> unquotedString
|
||||
|
|
|
@ -403,8 +403,8 @@ pDiv = try $ do
|
|||
|
||||
pRawHtmlBlock :: PandocMonad m => TagParser m Blocks
|
||||
pRawHtmlBlock = do
|
||||
raw <- (pHtmlBlock "script" <|> pHtmlBlock "style" <|> pHtmlBlock "textarea"
|
||||
<|> pRawTag)
|
||||
raw <- pHtmlBlock "script" <|> pHtmlBlock "style" <|> pHtmlBlock "textarea"
|
||||
<|> pRawTag
|
||||
exts <- getOption readerExtensions
|
||||
if extensionEnabled Ext_raw_html exts && not (T.null raw)
|
||||
then return $ B.rawBlock "html" raw
|
||||
|
@ -976,7 +976,7 @@ isSpecial '\8221' = True
|
|||
isSpecial _ = False
|
||||
|
||||
pSymbol :: PandocMonad m => InlinesParser m Inlines
|
||||
pSymbol = satisfy isSpecial >>= return . B.str . T.singleton
|
||||
pSymbol = B.str . T.singleton <$> satisfy isSpecial
|
||||
|
||||
isBad :: Char -> Bool
|
||||
isBad c = c >= '\128' && c <= '\159' -- not allowed in HTML
|
||||
|
|
|
@ -21,10 +21,9 @@ import Prelude
|
|||
import Control.Monad
|
||||
import Control.Monad.Except (throwError)
|
||||
import Data.Char (isAlphaNum, isPunctuation, isSpace)
|
||||
import Data.List (sortBy, transpose, elemIndex)
|
||||
import Data.List (transpose, elemIndex, sortOn)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import Data.Ord (comparing)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
@ -247,7 +246,7 @@ yamlMetaBlock = try $ do
|
|||
newMetaF <- yamlBsToMeta parseBlocks
|
||||
$ UTF8.fromTextLazy $ TL.fromStrict rawYaml
|
||||
-- Since `<>` is left-biased, existing values are not touched:
|
||||
updateState $ \st -> st{ stateMeta' = (stateMeta' st) <> newMetaF }
|
||||
updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF }
|
||||
return mempty
|
||||
|
||||
stopLine :: PandocMonad m => MarkdownParser m ()
|
||||
|
@ -1107,7 +1106,7 @@ rawHtmlBlocks = do
|
|||
return (return (B.rawBlock "html" $ stripMarkdownAttribute raw) <>
|
||||
contents <>
|
||||
return (B.rawBlock "html" rawcloser)))
|
||||
<|> (return (return (B.rawBlock "html" raw) <> contents))
|
||||
<|> return (return (B.rawBlock "html" raw) <> contents)
|
||||
updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }
|
||||
return result
|
||||
|
||||
|
@ -1170,7 +1169,7 @@ simpleTableHeader headless = try $ do
|
|||
else rawHeads
|
||||
heads <- fmap sequence
|
||||
$
|
||||
mapM ((parseFromString' (mconcat <$> many plain)).trim) rawHeads'
|
||||
mapM (parseFromString' (mconcat <$> many plain).trim) rawHeads'
|
||||
return (heads, aligns, indices)
|
||||
|
||||
-- Returns an alignment type for a table, based on a list of strings
|
||||
|
@ -1183,7 +1182,7 @@ alignType [] _ = AlignDefault
|
|||
alignType strLst len =
|
||||
let nonempties = filter (not . T.null) $ map trimr strLst
|
||||
(leftSpace, rightSpace) =
|
||||
case sortBy (comparing T.length) nonempties of
|
||||
case sortOn T.length nonempties of
|
||||
(x:_) -> (T.head x `elem` [' ', 't'], T.length x < len)
|
||||
[] -> (False, False)
|
||||
in case (leftSpace, rightSpace) of
|
||||
|
@ -1287,7 +1286,7 @@ multilineTableHeader headless = try $ do
|
|||
then replicate (length dashes) ""
|
||||
else map (T.unlines . map trim) rawHeadsList
|
||||
heads <- fmap sequence $
|
||||
mapM ((parseFromString' (mconcat <$> many plain)).trim) rawHeads
|
||||
mapM (parseFromString' (mconcat <$> many plain).trim) rawHeads
|
||||
return (heads, aligns, indices')
|
||||
|
||||
-- Parse a grid table: starts with row of '-' on top, then header
|
||||
|
|
|
@ -40,8 +40,8 @@ yamlBsToMeta :: PandocMonad m
|
|||
yamlBsToMeta pBlocks bstr = do
|
||||
pos <- getPosition
|
||||
case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of
|
||||
Right ((YAML.Doc (YAML.Mapping _ _ o)):_)
|
||||
-> (fmap Meta) <$> yamlMap pBlocks o
|
||||
Right (YAML.Doc (YAML.Mapping _ _ o):_)
|
||||
-> fmap Meta <$> yamlMap pBlocks o
|
||||
Right [] -> return . return $ mempty
|
||||
Right [YAML.Doc (YAML.Scalar _ YAML.SNull)]
|
||||
-> return . return $ mempty
|
||||
|
@ -84,12 +84,10 @@ toMetaValue pBlocks x =
|
|||
asBlocks p = MetaBlocks . B.toList <$> p
|
||||
|
||||
checkBoolean :: Text -> Maybe Bool
|
||||
checkBoolean t =
|
||||
if t == T.pack "true" || t == T.pack "True" || t == T.pack "TRUE"
|
||||
then Just True
|
||||
else if t == T.pack "false" || t == T.pack "False" || t == T.pack "FALSE"
|
||||
then Just False
|
||||
else Nothing
|
||||
checkBoolean t
|
||||
| t == T.pack "true" || t == T.pack "True" || t == T.pack "TRUE" = Just True
|
||||
| t == T.pack "false" || t == T.pack "False" || t == T.pack "FALSE" = Just False
|
||||
| otherwise = Nothing
|
||||
|
||||
yamlToMetaValue :: PandocMonad m
|
||||
=> ParserT Text ParserState m (F Blocks)
|
||||
|
@ -133,4 +131,3 @@ yamlMap pBlocks o = do
|
|||
return $ do
|
||||
v' <- fv
|
||||
return (k, v')
|
||||
|
||||
|
|
|
@ -183,14 +183,14 @@ a >>?! f = a >>> right f
|
|||
=> FallibleArrow a x f (b,b')
|
||||
-> (b -> b' -> c)
|
||||
-> FallibleArrow a x f c
|
||||
a >>?% f = a >>?^ (uncurry f)
|
||||
a >>?% f = a >>?^ uncurry f
|
||||
|
||||
---
|
||||
(^>>?%) :: (ArrowChoice a)
|
||||
=> (x -> Either f (b,b'))
|
||||
-> (b -> b' -> c)
|
||||
-> FallibleArrow a x f c
|
||||
a ^>>?% f = arr a >>?^ (uncurry f)
|
||||
a ^>>?% f = arr a >>?^ uncurry f
|
||||
|
||||
---
|
||||
(>>?%?) :: (ArrowChoice a)
|
||||
|
|
|
@ -792,7 +792,7 @@ read_frame_title = matchingElement NsSVG "title" (matchChildContent [] read_plai
|
|||
|
||||
image_attributes :: Maybe T.Text -> Maybe T.Text -> Attr
|
||||
image_attributes x y =
|
||||
( "", [], (dim "width" x) ++ (dim "height" y))
|
||||
( "", [], dim "width" x ++ dim "height" y)
|
||||
where
|
||||
dim _ (Just "") = []
|
||||
dim name (Just v) = [(name, v)]
|
||||
|
|
|
@ -163,7 +163,7 @@ swapStack' state stack
|
|||
pushElement :: XML.Element
|
||||
-> XMLConverterState nsID extraState
|
||||
-> XMLConverterState nsID extraState
|
||||
pushElement e state = state { parentElements = e:(parentElements state) }
|
||||
pushElement e state = state { parentElements = e:parentElements state }
|
||||
|
||||
-- | Pop the top element from the call stack, unless it is the last one.
|
||||
popElement :: XMLConverterState nsID extraState
|
||||
|
@ -605,8 +605,8 @@ executeInSub nsID name a = keepingTheValue
|
|||
(findChild nsID name)
|
||||
>>> ignoringState liftFailure
|
||||
>>? switchingTheStack a
|
||||
where liftFailure (_, (Left f)) = Left f
|
||||
liftFailure (x, (Right e)) = Right (x, e)
|
||||
where liftFailure (_, Left f) = Left f
|
||||
liftFailure (x, Right e) = Right (x, e)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Iterating over children
|
||||
|
@ -702,7 +702,7 @@ prepareMatchersC :: (NameSpaceID nsID)
|
|||
=> [(nsID, ElementName, FallibleXMLConverter nsID extraState x x)]
|
||||
-> ContentMatchConverter nsID extraState x
|
||||
--prepareMatchersC = foldSs . (map $ uncurry3 makeMatcherC)
|
||||
prepareMatchersC = reverseComposition . (map $ uncurry3 makeMatcherC)
|
||||
prepareMatchersC = reverseComposition . map (uncurry3 makeMatcherC)
|
||||
|
||||
-- | Takes a list of element-data - converter groups and
|
||||
-- * Finds all content of the current element
|
||||
|
|
|
@ -120,7 +120,7 @@ fontPitchReader = executeInSub NsOffice "font-face-decls" (
|
|||
lookupDefaultingAttr NsStyle "font-pitch"
|
||||
))
|
||||
>>?^ ( M.fromList . foldl accumLegalPitches [] )
|
||||
) `ifFailedDo` (returnV (Right M.empty))
|
||||
) `ifFailedDo` returnV (Right M.empty)
|
||||
where accumLegalPitches ls (Nothing,_) = ls
|
||||
accumLegalPitches ls (Just n,p) = (n,p):ls
|
||||
|
||||
|
|
|
@ -166,10 +166,8 @@ parseRST = do
|
|||
blocks <- B.toList <$> parseBlocks
|
||||
citations <- (sort . M.toList . stateCitations) <$> getState
|
||||
citationItems <- mapM parseCitation citations
|
||||
let refBlock = if null citationItems
|
||||
then []
|
||||
else [Div ("citations",[],[]) $
|
||||
B.toList $ B.definitionList citationItems]
|
||||
let refBlock = [Div ("citations",[],[]) $
|
||||
B.toList $ B.definitionList citationItems | not (null citationItems)]
|
||||
standalone <- getOption readerStandalone
|
||||
state <- getState
|
||||
let meta = stateMeta state
|
||||
|
@ -225,7 +223,7 @@ rawFieldListItem minIndent = try $ do
|
|||
first <- anyLine
|
||||
rest <- option "" $ try $ do lookAhead (count indent (char ' ') >> spaceChar)
|
||||
indentedBlock
|
||||
let raw = (if T.null first then "" else (first <> "\n")) <> rest <> "\n"
|
||||
let raw = (if T.null first then "" else first <> "\n") <> rest <> "\n"
|
||||
return (name, raw)
|
||||
|
||||
fieldListItem :: PandocMonad m => Int -> RSTParser m (Inlines, [Blocks])
|
||||
|
@ -706,7 +704,7 @@ directive' = do
|
|||
tit <- B.para . B.strong <$> parseInlineFromText
|
||||
(trim top <> if T.null subtit
|
||||
then ""
|
||||
else (": " <> subtit))
|
||||
else ": " <> subtit)
|
||||
bod <- parseFromString' parseBlocks body'
|
||||
return $ B.divWith (name,"sidebar":classes,keyvals) $ tit <> bod
|
||||
"topic" ->
|
||||
|
@ -1446,14 +1444,14 @@ roleAfter = try $ do
|
|||
unmarkedInterpretedText :: PandocMonad m => RSTParser m Text
|
||||
unmarkedInterpretedText = try $ do
|
||||
atStart (char '`')
|
||||
contents <- mconcat <$> (many1
|
||||
contents <- mconcat <$> many1
|
||||
( many1 (noneOf "`\\\n")
|
||||
<|> (char '\\' >> ((\c -> ['\\',c]) <$> noneOf "\n"))
|
||||
<|> (string "\n" <* notFollowedBy blankline)
|
||||
<|> try (string "`" <*
|
||||
notFollowedBy (() <$ roleMarker) <*
|
||||
lookAhead (satisfy isAlphaNum))
|
||||
))
|
||||
)
|
||||
char '`'
|
||||
return $ T.pack contents
|
||||
|
||||
|
|
|
@ -55,7 +55,7 @@ type TikiWikiParser = ParserT Text ParserState
|
|||
--
|
||||
|
||||
tryMsg :: Text -> TikiWikiParser m a -> TikiWikiParser m a
|
||||
tryMsg msg p = try p <?> (T.unpack msg)
|
||||
tryMsg msg p = try p <?> T.unpack msg
|
||||
|
||||
skip :: TikiWikiParser m a -> TikiWikiParser m ()
|
||||
skip parser = Control.Monad.void parser
|
||||
|
|
|
@ -147,7 +147,7 @@ header = try $ do
|
|||
contents <- trimInlines . mconcat <$> manyTill inline (try $ spaceChar
|
||||
>> string eqs >> many spaceChar >> newline)
|
||||
attr <- registerHeader (makeId contents,
|
||||
if sp == "" then [] else ["justcenter"], []) contents
|
||||
["justcenter" | not (null sp)], []) contents
|
||||
return $ B.headerWith attr lev contents
|
||||
|
||||
para :: PandocMonad m => VwParser m Blocks
|
||||
|
|
|
@ -69,7 +69,7 @@ convertTags (t@(TagOpen tagname as):ts)
|
|||
enc <- getDataURI (fromAttrib "type" t) y
|
||||
return (x, enc)
|
||||
else return (x,y)
|
||||
convertTags (t@(TagOpen "script" as):TagClose "script":ts) =
|
||||
convertTags (t@(TagOpen "script" as):TagClose "script":ts) =
|
||||
case fromAttrib "src" t of
|
||||
"" -> (t:) <$> convertTags ts
|
||||
src -> do
|
||||
|
|
|
@ -466,7 +466,7 @@ compactify items =
|
|||
let (others, final) = (init items, last items)
|
||||
in case reverse (B.toList final) of
|
||||
(Para a:xs)
|
||||
| null [Para x | Para x <- (xs ++ concatMap B.toList others)]
|
||||
| null [Para x | Para x <- xs ++ concatMap B.toList others]
|
||||
-> others ++ [B.fromList (reverse (Plain a : xs))]
|
||||
_ | null [Para x | Para x <- concatMap B.toList items]
|
||||
-> items
|
||||
|
@ -682,9 +682,9 @@ isTightList = all (\item -> firstIsPlain item || null item)
|
|||
taskListItemFromAscii :: Extensions -> [Block] -> [Block]
|
||||
taskListItemFromAscii = handleTaskListItem fromMd
|
||||
where
|
||||
fromMd (Str "[" : Space : Str "]" : Space : is) = (Str "☐") : Space : is
|
||||
fromMd (Str "[x]" : Space : is) = (Str "☒") : Space : is
|
||||
fromMd (Str "[X]" : Space : is) = (Str "☒") : Space : is
|
||||
fromMd (Str "[" : Space : Str "]" : Space : is) = Str "☐" : Space : is
|
||||
fromMd (Str "[x]" : Space : is) = Str "☒" : Space : is
|
||||
fromMd (Str "[X]" : Space : is) = Str "☒" : Space : is
|
||||
fromMd is = is
|
||||
|
||||
-- | Convert a list item containing text starting with @U+2610 BALLOT BOX@
|
||||
|
@ -787,19 +787,19 @@ splitSentences xs =
|
|||
-- strip out ANSI escape sequences from CodeBlocks (see #5633).
|
||||
filterIpynbOutput :: Maybe Format -> Pandoc -> Pandoc
|
||||
filterIpynbOutput mode = walk go
|
||||
where go (Div (ident, ("output":os), kvs) bs) =
|
||||
where go (Div (ident, "output":os, kvs) bs) =
|
||||
case mode of
|
||||
Nothing -> Div (ident, ("output":os), kvs) []
|
||||
Nothing -> Div (ident, "output":os, kvs) []
|
||||
-- "best" for ipynb includes all formats:
|
||||
Just fmt
|
||||
| fmt == Format "ipynb"
|
||||
-> Div (ident, ("output":os), kvs) bs
|
||||
| otherwise -> Div (ident, ("output":os), kvs) $
|
||||
-> Div (ident, "output":os, kvs) bs
|
||||
| otherwise -> Div (ident, "output":os, kvs) $
|
||||
walk removeANSI $
|
||||
take 1 $ sortOn rank bs
|
||||
where
|
||||
rank (RawBlock (Format "html") _)
|
||||
| fmt == Format "html" = (1 :: Int)
|
||||
| fmt == Format "html" = 1 :: Int
|
||||
| fmt == Format "markdown" = 2
|
||||
| otherwise = 3
|
||||
rank (RawBlock (Format "latex") _)
|
||||
|
|
|
@ -263,7 +263,7 @@ blockToAsciiDoc opts (OrderedList (start, sty, _delim) items) = do
|
|||
Decimal -> ["arabic"]
|
||||
Example -> []
|
||||
_ -> [T.toLower (tshow sty)]
|
||||
let listStart = if start == 1 then [] else ["start=" <> tshow start]
|
||||
let listStart = ["start=" <> tshow start | not (start == 1)]
|
||||
let listoptions = case T.intercalate ", " (listStyle ++ listStart) of
|
||||
"" -> empty
|
||||
x -> brackets (literal x)
|
||||
|
|
|
@ -45,9 +45,7 @@ writeCommonMark opts (Pandoc meta blocks) = do
|
|||
else return mempty
|
||||
|
||||
let (blocks', notes) = runState (walkM processNotes blocks) []
|
||||
notes' = if null notes
|
||||
then []
|
||||
else [OrderedList (1, Decimal, Period) $ reverse notes]
|
||||
notes' = [OrderedList (1, Decimal, Period) $ reverse notes | not (null notes)]
|
||||
main <- blocksToCommonMark opts (blocks' ++ notes')
|
||||
metadata <- metaToContext opts
|
||||
(fmap (literal . T.stripEnd) . blocksToCommonMark opts)
|
||||
|
@ -241,13 +239,11 @@ inlineToNodes opts SoftBreak
|
|||
| otherwise = (node SOFTBREAK [] :)
|
||||
inlineToNodes opts (Emph xs) = (node EMPH (inlinesToNodes opts xs) :)
|
||||
inlineToNodes opts (Strong xs) = (node STRONG (inlinesToNodes opts xs) :)
|
||||
inlineToNodes opts (Strikeout xs) =
|
||||
if isEnabled Ext_strikeout opts
|
||||
then (node (CUSTOM_INLINE "~~" "~~") (inlinesToNodes opts xs) :)
|
||||
else if isEnabled Ext_raw_html opts
|
||||
then ((node (HTML_INLINE (T.pack "<s>")) [] : inlinesToNodes opts xs ++
|
||||
[node (HTML_INLINE (T.pack "</s>")) []]) ++ )
|
||||
else (inlinesToNodes opts xs ++)
|
||||
inlineToNodes opts (Strikeout xs)
|
||||
| isEnabled Ext_strikeout opts = (node (CUSTOM_INLINE "~~" "~~") (inlinesToNodes opts xs) :)
|
||||
| isEnabled Ext_raw_html opts = ((node (HTML_INLINE (T.pack "<s>")) [] : inlinesToNodes opts xs ++
|
||||
[node (HTML_INLINE (T.pack "</s>")) []]) ++ )
|
||||
| otherwise = (inlinesToNodes opts xs ++)
|
||||
inlineToNodes opts (Superscript xs) =
|
||||
if isEnabled Ext_raw_html opts
|
||||
then ((node (HTML_INLINE (T.pack "<sup>")) [] : inlinesToNodes opts xs ++
|
||||
|
|
|
@ -409,9 +409,5 @@ isMathML _ = False
|
|||
idAndRole :: Attr -> [(Text, Text)]
|
||||
idAndRole (id',cls,_) = ident <> role
|
||||
where
|
||||
ident = if T.null id'
|
||||
then []
|
||||
else [("id", id')]
|
||||
role = if null cls
|
||||
then []
|
||||
else [("role", T.unwords cls)]
|
||||
ident = [("id", id') | not (T.null id')]
|
||||
role = [("role", T.unwords cls) | not (null cls)]
|
||||
|
|
|
@ -130,9 +130,7 @@ description meta' = do
|
|||
booktitle :: PandocMonad m => Meta -> FBM m [Content]
|
||||
booktitle meta' = do
|
||||
t <- cMapM toXml . docTitle $ meta'
|
||||
return $ if null t
|
||||
then []
|
||||
else [ el "book-title" t ]
|
||||
return $ [el "book-title" t | not (null t)]
|
||||
|
||||
authors :: Meta -> [Content]
|
||||
authors meta' = cMap author (docAuthors meta')
|
||||
|
@ -156,9 +154,7 @@ docdate :: PandocMonad m => Meta -> FBM m [Content]
|
|||
docdate meta' = do
|
||||
let ss = docDate meta'
|
||||
d <- cMapM toXml ss
|
||||
return $ if null d
|
||||
then []
|
||||
else [el "date" d]
|
||||
return $ [el "date" d | not (null d)]
|
||||
|
||||
-- | Divide the stream of blocks into sections and convert to XML
|
||||
-- representation.
|
||||
|
|
|
@ -663,8 +663,8 @@ blockToHtml opts (Div (ident, "section":dclasses, dkvs)
|
|||
let fragmentClass = case slideVariant of
|
||||
RevealJsSlides -> "fragment"
|
||||
_ -> "incremental"
|
||||
let inDiv zs = (RawBlock (Format "html") ("<div class=\""
|
||||
<> fragmentClass <> "\">")) :
|
||||
let inDiv zs = RawBlock (Format "html") ("<div class=\""
|
||||
<> fragmentClass <> "\">") :
|
||||
(zs ++ [RawBlock (Format "html") "</div>"])
|
||||
let (titleBlocks, innerSecs) =
|
||||
if titleSlide
|
||||
|
@ -723,8 +723,8 @@ blockToHtml opts (Div attr@(ident, classes, kvs') bs) = do
|
|||
html5 <- gets stHtml5
|
||||
slideVariant <- gets stSlideVariant
|
||||
let kvs = [(k,v) | (k,v) <- kvs', k /= "width"] ++
|
||||
[("style", "width:" <> w <> ";")
|
||||
| ("width",w) <- kvs', "column" `elem` classes] ++
|
||||
[("style", "width:" <> w <> ";") | "column" `elem` classes,
|
||||
("width", w) <- kvs'] ++
|
||||
[("role", "doc-bibliography") | ident == "refs" && html5] ++
|
||||
[("role", "doc-biblioentry")
|
||||
| "ref-item" `T.isPrefixOf` ident && html5]
|
||||
|
|
|
@ -156,7 +156,7 @@ writeICML opts (Pandoc meta blocks) = do
|
|||
-- | Auxiliary functions for parStylesToDoc and charStylesToDoc.
|
||||
contains :: Text -> (Text, (Text, Text)) -> [(Text, Text)]
|
||||
contains s rule =
|
||||
[snd rule | (fst rule) `Text.isInfixOf` s]
|
||||
[snd rule | fst rule `Text.isInfixOf` s]
|
||||
|
||||
-- | The monospaced font to use as default.
|
||||
monospacedFont :: Doc Text
|
||||
|
|
|
@ -644,9 +644,7 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do
|
|||
key `notElem` ["exports", "tangle", "results"]
|
||||
-- see #4889
|
||||
] ++
|
||||
(if identifier == ""
|
||||
then []
|
||||
else [ "label=" <> ref ])
|
||||
["label=" <> ref | not (T.null identifier)]
|
||||
|
||||
else []
|
||||
printParams
|
||||
|
@ -1131,7 +1129,7 @@ inlineToLaTeX (Span (id',classes,kvs) ils) = do
|
|||
["LR" | ("dir", "ltr") `elem` kvs] ++
|
||||
(case lang of
|
||||
Just lng -> let (l, o) = toPolyglossia lng
|
||||
ops = if T.null o then "" else ("[" <> o <> "]")
|
||||
ops = if T.null o then "" else "[" <> o <> "]"
|
||||
in ["text" <> l <> ops]
|
||||
Nothing -> [])
|
||||
contents <- inlineListToLaTeX ils
|
||||
|
|
|
@ -88,8 +88,7 @@ notesToMan :: PandocMonad m => WriterOptions -> [[Block]] -> StateT WriterState
|
|||
notesToMan opts notes =
|
||||
if null notes
|
||||
then return empty
|
||||
else zipWithM (noteToMan opts) [1..] notes >>=
|
||||
return . (text ".SH NOTES" $$) . vcat
|
||||
else (text ".SH NOTES" $$) . vcat <$> zipWithM (noteToMan opts) [1..] notes
|
||||
|
||||
-- | Return man representation of a note.
|
||||
noteToMan :: PandocMonad m => WriterOptions -> Int -> [Block] -> StateT WriterState m (Doc Text)
|
||||
|
|
|
@ -53,4 +53,3 @@ convertMath writer mt str =
|
|||
where dt = case mt of
|
||||
DisplayMath -> DisplayBlock
|
||||
InlineMath -> DisplayInline
|
||||
|
||||
|
|
|
@ -16,6 +16,7 @@ MediaWiki: <http://www.mediawiki.org/wiki/MediaWiki>
|
|||
-}
|
||||
module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki, highlightingLangs ) where
|
||||
import Prelude
|
||||
import Control.Applicative
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State.Strict
|
||||
import Data.Maybe (fromMaybe)
|
||||
|
@ -166,7 +167,8 @@ blockToMediaWiki (Table capt aligns widths headers rows') = do
|
|||
return $ "{|\n" <> caption <> tableBody <> "|}\n"
|
||||
|
||||
blockToMediaWiki x@(BulletList items) = do
|
||||
tags <- fmap (|| not (isSimpleList x)) $ asks useTags
|
||||
tags <-
|
||||
(|| not (isSimpleList x)) Control.Applicative.<$> asks useTags
|
||||
if tags
|
||||
then do
|
||||
contents <- local (\ s -> s { useTags = True }) $ mapM listItemToMediaWiki items
|
||||
|
@ -177,7 +179,8 @@ blockToMediaWiki x@(BulletList items) = do
|
|||
return $ vcat contents <> if null lev then "\n" else ""
|
||||
|
||||
blockToMediaWiki x@(OrderedList attribs items) = do
|
||||
tags <- fmap (|| not (isSimpleList x)) $ asks useTags
|
||||
tags <-
|
||||
(|| not (isSimpleList x)) Control.Applicative.<$> asks useTags
|
||||
if tags
|
||||
then do
|
||||
contents <- local (\s -> s { useTags = True }) $ mapM listItemToMediaWiki items
|
||||
|
@ -188,7 +191,8 @@ blockToMediaWiki x@(OrderedList attribs items) = do
|
|||
return $ vcat contents <> if null lev then "\n" else ""
|
||||
|
||||
blockToMediaWiki x@(DefinitionList items) = do
|
||||
tags <- fmap (|| not (isSimpleList x)) $ asks useTags
|
||||
tags <-
|
||||
(|| not (isSimpleList x)) Control.Applicative.<$> asks useTags
|
||||
if tags
|
||||
then do
|
||||
contents <- local (\s -> s { useTags = True }) $ mapM definitionListItemToMediaWiki items
|
||||
|
@ -342,7 +346,7 @@ blockListToMediaWiki :: PandocMonad m
|
|||
=> [Block] -- ^ List of block elements
|
||||
-> MediaWikiWriter m Text
|
||||
blockListToMediaWiki blocks =
|
||||
fmap vcat $ mapM blockToMediaWiki blocks
|
||||
vcat Control.Applicative.<$> mapM blockToMediaWiki blocks
|
||||
|
||||
-- | Convert list of Pandoc inline elements to MediaWiki.
|
||||
inlineListToMediaWiki :: PandocMonad m => [Inline] -> MediaWikiWriter m Text
|
||||
|
@ -355,8 +359,8 @@ inlineListToMediaWiki lst =
|
|||
, isLinkOrImage x =
|
||||
Str t : RawInline (Format "mediawiki") "<nowiki/>" : x : fixup xs
|
||||
fixup (x:xs) = x : fixup xs
|
||||
isLinkOrImage (Link{}) = True
|
||||
isLinkOrImage (Image{}) = True
|
||||
isLinkOrImage Link{} = True
|
||||
isLinkOrImage Image{} = True
|
||||
isLinkOrImage _ = False
|
||||
|
||||
-- | Convert Pandoc inline element to MediaWiki.
|
||||
|
|
|
@ -492,7 +492,7 @@ fixOrEscape b (Str s) = fixOrEscapeStr b s
|
|||
_ -> (sp && (startsWithMarker isDigit s ||
|
||||
startsWithMarker isAsciiLower s ||
|
||||
startsWithMarker isAsciiUpper s))
|
||||
|| stringStartsWithSpace s
|
||||
|| stringStartsWithSpace s
|
||||
fixOrEscape _ Space = True
|
||||
fixOrEscape _ SoftBreak = True
|
||||
fixOrEscape _ _ = False
|
||||
|
|
|
@ -101,7 +101,7 @@ pandocToODT opts doc@(Pandoc meta _) = do
|
|||
$ fromStringLazy $ render Nothing
|
||||
$ text "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
|
||||
$$
|
||||
(inTags True "manifest:manifest"
|
||||
inTags True "manifest:manifest"
|
||||
[("xmlns:manifest","urn:oasis:names:tc:opendocument:xmlns:manifest:1.0")
|
||||
,("manifest:version","1.2")] ( selfClosingTag "manifest:file-entry"
|
||||
[("manifest:media-type","application/vnd.oasis.opendocument.text")
|
||||
|
@ -109,7 +109,6 @@ pandocToODT opts doc@(Pandoc meta _) = do
|
|||
$$ vcat ( map toFileEntry files )
|
||||
$$ vcat ( map toFileEntry formulas )
|
||||
)
|
||||
)
|
||||
let archive' = addEntryToArchive manifestEntry archive
|
||||
-- create meta.xml
|
||||
let userDefinedMetaFields = [k | k <- Map.keys (unMeta meta)
|
||||
|
@ -129,7 +128,7 @@ pandocToODT opts doc@(Pandoc meta _) = do
|
|||
$ fromStringLazy $ render Nothing
|
||||
$ text "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
|
||||
$$
|
||||
(inTags True "office:document-meta"
|
||||
inTags True "office:document-meta"
|
||||
[("xmlns:office","urn:oasis:names:tc:opendocument:xmlns:office:1.0")
|
||||
,("xmlns:xlink","http://www.w3.org/1999/xlink")
|
||||
,("xmlns:dc","http://purl.org/dc/elements/1.1/")
|
||||
|
@ -163,7 +162,6 @@ pandocToODT opts doc@(Pandoc meta _) = do
|
|||
vcat userDefinedMeta
|
||||
)
|
||||
)
|
||||
)
|
||||
-- make sure mimetype is first
|
||||
let mimetypeEntry = toEntry "mimetype" epochtime
|
||||
$ fromStringLazy "application/vnd.oasis.opendocument.text"
|
||||
|
@ -241,7 +239,7 @@ transformPicMath _ (Math t math) = do
|
|||
Right r -> do
|
||||
let conf = useShortEmptyTags (const False) defaultConfigPP
|
||||
let mathml = ppcTopElement conf r
|
||||
epochtime <- floor `fmap` (lift P.getPOSIXTime)
|
||||
epochtime <- floor `fmap` lift P.getPOSIXTime
|
||||
let dirname = "Formula-" ++ show (length entries) ++ "/"
|
||||
let fname = dirname ++ "content.xml"
|
||||
let entry = toEntry fname epochtime (fromStringLazy mathml)
|
||||
|
@ -269,12 +267,12 @@ documentSettings :: Bool -> B.ByteString
|
|||
documentSettings isTextMode = fromStringLazy $ render Nothing
|
||||
$ text "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
|
||||
$$
|
||||
(inTags True "office:document-settings"
|
||||
inTags True "office:document-settings"
|
||||
[("xmlns:office","urn:oasis:names:tc:opendocument:xmlns:office:1.0")
|
||||
,("xmlns:xlink","http://www.w3.org/1999/xlink")
|
||||
,("xmlns:config","urn:oasis:names:tc:opendocument:xmlns:config:1.0")
|
||||
,("xmlns:ooo","http://openoffice.org/2004/office")
|
||||
,("office:version","1.2")] $
|
||||
,("office:version","1.2")] (
|
||||
inTagsSimple "office:settings" $
|
||||
inTags False "config:config-item-set"
|
||||
[("config:name", "ooo:configuration-settings")] $
|
||||
|
|
|
@ -19,7 +19,7 @@ import Prelude
|
|||
import Control.Arrow ((***), (>>>))
|
||||
import Control.Monad.State.Strict hiding (when)
|
||||
import Data.Char (chr)
|
||||
import Data.List (sortBy, foldl')
|
||||
import Data.List (sortOn, sortBy, foldl')
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Ord (comparing)
|
||||
|
@ -163,7 +163,7 @@ inTextStyle d = do
|
|||
[("style:name", styleName)
|
||||
,("style:family", "text")]
|
||||
$ selfClosingTag "style:text-properties"
|
||||
(sortBy (comparing fst) . Map.toList
|
||||
(sortOn fst . Map.toList
|
||||
$ foldl' textStyleAttr mempty (Set.toList at)))
|
||||
return $ inTags False
|
||||
"text:span" [("text:style-name",styleName)] d
|
||||
|
|
|
@ -41,7 +41,7 @@ import Text.Pandoc.MIME
|
|||
import qualified Data.ByteString.Lazy as BL
|
||||
import Text.Pandoc.Writers.OOXML
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, maybeToList, catMaybes, isNothing)
|
||||
import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, maybeToList, catMaybes, isJust)
|
||||
import Text.Pandoc.ImageSize
|
||||
import Control.Applicative ((<|>))
|
||||
import System.FilePath.Glob
|
||||
|
@ -254,7 +254,7 @@ presentationToArchiveP p@(Presentation docProps slides) = do
|
|||
(throwError $
|
||||
PandocSomeError $
|
||||
"The following required files are missing:\n" <>
|
||||
(T.unlines $ map (T.pack . (" " <>)) missingFiles)
|
||||
T.unlines (map (T.pack . (" " <>)) missingFiles)
|
||||
)
|
||||
|
||||
newArch' <- foldM copyFileToArchive emptyArchive filePaths
|
||||
|
@ -291,11 +291,12 @@ presentationToArchiveP p@(Presentation docProps slides) = do
|
|||
|
||||
makeSlideIdMap :: Presentation -> M.Map SlideId Int
|
||||
makeSlideIdMap (Presentation _ slides) =
|
||||
M.fromList $ (map slideId slides) `zip` [1..]
|
||||
M.fromList $ map slideId slides `zip` [1..]
|
||||
|
||||
makeSpeakerNotesMap :: Presentation -> M.Map Int Int
|
||||
makeSpeakerNotesMap (Presentation _ slides) =
|
||||
M.fromList $ (mapMaybe f $ slides `zip` [1..]) `zip` [1..]
|
||||
M.fromList $
|
||||
mapMaybe f (slides `zip` [1..]) `zip` [1..]
|
||||
where f (Slide _ _ notes, n) = if notes == mempty
|
||||
then Nothing
|
||||
else Just n
|
||||
|
@ -350,10 +351,10 @@ curSlideHasSpeakerNotes =
|
|||
getLayout :: PandocMonad m => Layout -> P m Element
|
||||
getLayout layout = do
|
||||
let layoutpath = case layout of
|
||||
(MetadataSlide _ _ _ _) -> "ppt/slideLayouts/slideLayout1.xml"
|
||||
(MetadataSlide{}) -> "ppt/slideLayouts/slideLayout1.xml"
|
||||
(TitleSlide _) -> "ppt/slideLayouts/slideLayout3.xml"
|
||||
(ContentSlide _ _) -> "ppt/slideLayouts/slideLayout2.xml"
|
||||
(TwoColumnSlide _ _ _) -> "ppt/slideLayouts/slideLayout4.xml"
|
||||
(TwoColumnSlide{}) -> "ppt/slideLayouts/slideLayout4.xml"
|
||||
refArchive <- asks envRefArchive
|
||||
distArchive <- asks envDistArchive
|
||||
parseXml refArchive distArchive layoutpath
|
||||
|
@ -409,7 +410,7 @@ getMasterShapeDimensionsById ident master = do
|
|||
let ns = elemToNameSpaces master
|
||||
cSld <- findChild (elemName ns "p" "cSld") master
|
||||
spTree <- findChild (elemName ns "p" "spTree") cSld
|
||||
sp <- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasId ns ident e)) spTree
|
||||
sp <- filterChild (\e -> isElem ns "p" "sp" e && shapeHasId ns ident e) spTree
|
||||
getShapeDimensions ns sp
|
||||
|
||||
getContentShapeSize :: PandocMonad m
|
||||
|
@ -457,7 +458,7 @@ replaceNamedChildren ns prefix name newKids element =
|
|||
where
|
||||
fun :: Bool -> [Content] -> [[Content]]
|
||||
fun _ [] = []
|
||||
fun switch ((Elem e) : conts) | isElem ns prefix name e =
|
||||
fun switch (Elem e : conts) | isElem ns prefix name e =
|
||||
if switch
|
||||
then map Elem newKids : fun False conts
|
||||
else fun False conts
|
||||
|
@ -522,9 +523,7 @@ registerMedia fp caption = do
|
|||
Just Emf -> Just ".emf"
|
||||
Nothing -> Nothing
|
||||
|
||||
let newGlobalId = case M.lookup fp globalIds of
|
||||
Just ident -> ident
|
||||
Nothing -> maxGlobalId + 1
|
||||
let newGlobalId = fromMaybe (maxGlobalId + 1) (M.lookup fp globalIds)
|
||||
|
||||
let newGlobalIds = M.insert fp newGlobalId globalIds
|
||||
|
||||
|
@ -550,10 +549,9 @@ makeMediaEntry :: PandocMonad m => MediaInfo -> P m Entry
|
|||
makeMediaEntry mInfo = do
|
||||
epochtime <- (floor . utcTimeToPOSIXSeconds) <$> asks envUTCTime
|
||||
(imgBytes, _) <- P.fetchItem (T.pack $ mInfoFilePath mInfo)
|
||||
let ext = case mInfoExt mInfo of
|
||||
Just e -> e
|
||||
Nothing -> ""
|
||||
let fp = "ppt/media/image" <> (show $ mInfoGlobalId mInfo) <> T.unpack ext
|
||||
let ext = fromMaybe "" (mInfoExt mInfo)
|
||||
let fp = "ppt/media/image" <>
|
||||
show (mInfoGlobalId mInfo) <> T.unpack ext
|
||||
return $ toEntry fp epochtime $ BL.fromStrict imgBytes
|
||||
|
||||
makeMediaEntries :: PandocMonad m => P m [Entry]
|
||||
|
@ -717,7 +715,8 @@ makePicElements layout picProps mInfo alt = do
|
|||
, cNvPicPr
|
||||
, mknode "p:nvPr" [] ()]
|
||||
let blipFill = mknode "p:blipFill" []
|
||||
[ mknode "a:blip" [("r:embed", "rId" <> (show $ mInfoLocalId mInfo))] ()
|
||||
[ mknode "a:blip" [("r:embed", "rId" <>
|
||||
show (mInfoLocalId mInfo))] ()
|
||||
, mknode "a:stretch" [] $
|
||||
mknode "a:fillRect" [] () ]
|
||||
let xfrm = mknode "a:xfrm" []
|
||||
|
@ -750,9 +749,12 @@ paraElemToElements Break = return [mknode "a:br" [] ()]
|
|||
paraElemToElements (Run rpr s) = do
|
||||
sizeAttrs <- fontSizeAttributes rpr
|
||||
let attrs = sizeAttrs <>
|
||||
(if rPropBold rpr then [("b", "1")] else []) <>
|
||||
(if rPropItalics rpr then [("i", "1")] else []) <>
|
||||
(if rPropUnderline rpr then [("u", "sng")] else []) <>
|
||||
(
|
||||
[("b", "1") | rPropBold rpr]) <>
|
||||
(
|
||||
[("i", "1") | rPropItalics rpr]) <>
|
||||
(
|
||||
[("u", "sng") | rPropUnderline rpr]) <>
|
||||
(case rStrikethrough rpr of
|
||||
Just NoStrike -> [("strike", "noStrike")]
|
||||
Just SingleStrike -> [("strike", "sngStrike")]
|
||||
|
@ -796,9 +798,8 @@ paraElemToElements (Run rpr s) = do
|
|||
_ -> []
|
||||
Nothing -> []
|
||||
codeFont <- monospaceFont
|
||||
let codeContents = if rPropCode rpr
|
||||
then [mknode "a:latin" [("typeface", T.unpack codeFont)] ()]
|
||||
else []
|
||||
let codeContents =
|
||||
[mknode "a:latin" [("typeface", T.unpack codeFont)] () | rPropCode rpr]
|
||||
let propContents = linkProps <> colorContents <> codeContents
|
||||
return [mknode "a:r" [] [ mknode "a:rPr" attrs propContents
|
||||
, mknode "a:t" [] $ T.unpack s
|
||||
|
@ -817,7 +818,7 @@ paraElemToElements (RawOOXMLParaElem str) = return [ x | Elem x <- parseXML str
|
|||
-- step at a time.
|
||||
addMathInfo :: Element -> Element
|
||||
addMathInfo element =
|
||||
let mathspace = Attr { attrKey = (QName "m" Nothing (Just "xmlns"))
|
||||
let mathspace = Attr { attrKey = QName "m" Nothing (Just "xmlns")
|
||||
, attrVal = "http://schemas.openxmlformats.org/officeDocument/2006/math"
|
||||
}
|
||||
in add_attr mathspace element
|
||||
|
@ -920,7 +921,7 @@ graphicFrameToElements layout tbls caption = do
|
|||
`catchError`
|
||||
(\_ -> return ((0, 0), (pageWidth, pageHeight)))
|
||||
|
||||
let cy = if (not $ null caption) then cytmp - captionHeight else cytmp
|
||||
let cy = if not $ null caption then cytmp - captionHeight else cytmp
|
||||
|
||||
elements <- mapM (graphicToElement cx) tbls
|
||||
let graphicFrameElts =
|
||||
|
@ -938,7 +939,7 @@ graphicFrameToElements layout tbls caption = do
|
|||
]
|
||||
] <> elements
|
||||
|
||||
if (not $ null caption)
|
||||
if not $ null caption
|
||||
then do capElt <- createCaption ((x, y), (cx, cytmp)) caption
|
||||
return [graphicFrameElts, capElt]
|
||||
else return [graphicFrameElts]
|
||||
|
@ -1079,9 +1080,7 @@ contentToElement layout hdrShape shapes
|
|||
, Just cSld <- findChild (elemName ns "p" "cSld") layout
|
||||
, Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
|
||||
element <- nonBodyTextToElement layout [PHType "title"] hdrShape
|
||||
let hdrShapeElements = if null hdrShape
|
||||
then []
|
||||
else [element]
|
||||
let hdrShapeElements = [element | not (null hdrShape)]
|
||||
contentElements <- local
|
||||
(\env -> env {envContentType = NormalContent})
|
||||
(shapesToElements layout shapes)
|
||||
|
@ -1094,9 +1093,7 @@ twoColumnToElement layout hdrShape shapesL shapesR
|
|||
, Just cSld <- findChild (elemName ns "p" "cSld") layout
|
||||
, Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
|
||||
element <- nonBodyTextToElement layout [PHType "title"] hdrShape
|
||||
let hdrShapeElements = if null hdrShape
|
||||
then []
|
||||
else [element]
|
||||
let hdrShapeElements = [element | not (null hdrShape)]
|
||||
contentElementsL <- local
|
||||
(\env -> env {envContentType =TwoColumnLeftContent})
|
||||
(shapesToElements layout shapesL)
|
||||
|
@ -1115,9 +1112,7 @@ titleToElement layout titleElems
|
|||
, Just cSld <- findChild (elemName ns "p" "cSld") layout
|
||||
, Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
|
||||
element <- nonBodyTextToElement layout [PHType "title", PHType "ctrTitle"] titleElems
|
||||
let titleShapeElements = if null titleElems
|
||||
then []
|
||||
else [element]
|
||||
let titleShapeElements = [element | not (null titleElems)]
|
||||
return $ buildSpTree ns spTree titleShapeElements
|
||||
titleToElement _ _ = return $ mknode "p:sp" [] ()
|
||||
|
||||
|
@ -1395,12 +1390,10 @@ presentationToRels :: PandocMonad m => Presentation -> P m [Relationship]
|
|||
presentationToRels pres@(Presentation _ slides) = do
|
||||
mySlideRels <- mapM slideToPresRel slides
|
||||
let notesMasterRels =
|
||||
if presHasSpeakerNotes pres
|
||||
then [Relationship { relId = length mySlideRels + 2
|
||||
, relType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster"
|
||||
, relTarget = "notesMasters/notesMaster1.xml"
|
||||
}]
|
||||
else []
|
||||
[Relationship { relId = length mySlideRels + 2
|
||||
, relType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster"
|
||||
, relTarget = "notesMasters/notesMaster1.xml"
|
||||
} | presHasSpeakerNotes pres]
|
||||
insertedRels = mySlideRels <> notesMasterRels
|
||||
rels <- getRels
|
||||
-- we remove the slide rels and the notesmaster (if it's
|
||||
|
@ -1459,7 +1452,8 @@ topLevelRelsEntry :: PandocMonad m => P m Entry
|
|||
topLevelRelsEntry = elemToEntry "_rels/.rels" $ relsToElement topLevelRels
|
||||
|
||||
relToElement :: Relationship -> Element
|
||||
relToElement rel = mknode "Relationship" [ ("Id", "rId" <> (show $ relId rel))
|
||||
relToElement rel = mknode "Relationship" [ ("Id", "rId" <>
|
||||
show (relId rel))
|
||||
, ("Type", T.unpack $ relType rel)
|
||||
, ("Target", relTarget rel) ] ()
|
||||
|
||||
|
@ -1502,7 +1496,8 @@ slideToSpeakerNotesEntry slide = do
|
|||
|
||||
slideToSpeakerNotesRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
|
||||
slideToSpeakerNotesRelElement (Slide _ _ (SpeakerNotes [])) = return Nothing
|
||||
slideToSpeakerNotesRelElement slide@(Slide _ _ _) = do
|
||||
slideToSpeakerNotesRelElement slide@(
|
||||
Slide{}) = do
|
||||
idNum <- slideNum slide
|
||||
return $ Just $
|
||||
mknode "Relationships"
|
||||
|
@ -1559,13 +1554,13 @@ linkRelElements mp = mapM linkRelElement (M.toList mp)
|
|||
|
||||
mediaRelElement :: MediaInfo -> Element
|
||||
mediaRelElement mInfo =
|
||||
let ext = case mInfoExt mInfo of
|
||||
Just e -> e
|
||||
Nothing -> ""
|
||||
let ext = fromMaybe "" (mInfoExt mInfo)
|
||||
in
|
||||
mknode "Relationship" [ ("Id", "rId" <> (show $ mInfoLocalId mInfo))
|
||||
mknode "Relationship" [ ("Id", "rId" <>
|
||||
show (mInfoLocalId mInfo))
|
||||
, ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image")
|
||||
, ("Target", "../media/image" <> (show $ mInfoGlobalId mInfo) <> T.unpack ext)
|
||||
, ("Target", "../media/image" <>
|
||||
show (mInfoGlobalId mInfo) <> T.unpack ext)
|
||||
] ()
|
||||
|
||||
speakerNotesSlideRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
|
||||
|
@ -1586,10 +1581,10 @@ slideToSlideRelElement :: PandocMonad m => Slide -> P m Element
|
|||
slideToSlideRelElement slide = do
|
||||
idNum <- slideNum slide
|
||||
let target = case slide of
|
||||
(Slide _ (MetadataSlide _ _ _ _) _) -> "../slideLayouts/slideLayout1.xml"
|
||||
(Slide _ (MetadataSlide{}) _) -> "../slideLayouts/slideLayout1.xml"
|
||||
(Slide _ (TitleSlide _) _) -> "../slideLayouts/slideLayout3.xml"
|
||||
(Slide _ (ContentSlide _ _) _) -> "../slideLayouts/slideLayout2.xml"
|
||||
(Slide _ (TwoColumnSlide _ _ _) _) -> "../slideLayouts/slideLayout4.xml"
|
||||
(Slide _ (TwoColumnSlide{}) _) -> "../slideLayouts/slideLayout4.xml"
|
||||
|
||||
speakerNotesRels <- maybeToList <$> speakerNotesSlideRelElement slide
|
||||
|
||||
|
@ -1696,15 +1691,15 @@ docPropsElement docProps = do
|
|||
,("xmlns:dcterms","http://purl.org/dc/terms/")
|
||||
,("xmlns:dcmitype","http://purl.org/dc/dcmitype/")
|
||||
,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")]
|
||||
$ (mknode "dc:title" [] $ maybe "" T.unpack $ dcTitle docProps)
|
||||
: (mknode "dc:creator" [] $ maybe "" T.unpack $ dcCreator docProps)
|
||||
: (mknode "cp:keywords" [] $ T.unpack keywords)
|
||||
: (if isNothing (dcSubject docProps) then [] else
|
||||
[mknode "dc:subject" [] $ maybe "" T.unpack $ dcSubject docProps])
|
||||
<> (if isNothing (dcDescription docProps) then [] else
|
||||
[mknode "dc:description" [] $ maybe "" T.unpack $ dcDescription docProps])
|
||||
<> (if isNothing (cpCategory docProps) then [] else
|
||||
[mknode "cp:category" [] $ maybe "" T.unpack $ cpCategory docProps])
|
||||
$
|
||||
mknode "dc:title" [] (maybe "" T.unpack $ dcTitle docProps)
|
||||
:
|
||||
mknode "dc:creator" [] (maybe "" T.unpack $ dcCreator docProps)
|
||||
:
|
||||
mknode "cp:keywords" [] (T.unpack keywords)
|
||||
: ( [mknode "dc:subject" [] $ maybe "" T.unpack $ dcSubject docProps | isJust (dcSubject docProps)])
|
||||
<> ( [mknode "dc:description" [] $ maybe "" T.unpack $ dcDescription docProps | isJust (dcDescription docProps)])
|
||||
<> ( [mknode "cp:category" [] $ maybe "" T.unpack $ cpCategory docProps | isJust (cpCategory docProps)])
|
||||
<> (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x
|
||||
, mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x
|
||||
]) (formatTime defaultTimeLocale "%FT%XZ" utctime)
|
||||
|
@ -1739,7 +1734,8 @@ viewPropsElement = do
|
|||
viewPrElement <- parseXml refArchive distArchive "ppt/viewProps.xml"
|
||||
-- remove "lastView" if it exists:
|
||||
let notLastView :: Text.XML.Light.Attr -> Bool
|
||||
notLastView attr = (qName $ attrKey attr) /= "lastView"
|
||||
notLastView attr =
|
||||
qName (attrKey attr) /= "lastView"
|
||||
return $
|
||||
viewPrElement {elAttribs = filter notLastView (elAttribs viewPrElement)}
|
||||
|
||||
|
@ -1765,8 +1761,9 @@ contentTypesToElement ct =
|
|||
let ns = "http://schemas.openxmlformats.org/package/2006/content-types"
|
||||
in
|
||||
mknode "Types" [("xmlns", ns)] $
|
||||
(map defaultContentTypeToElem $ contentTypesDefaults ct) <>
|
||||
(map overrideContentTypeToElem $ contentTypesOverrides ct)
|
||||
|
||||
map defaultContentTypeToElem (contentTypesDefaults ct) <>
|
||||
map overrideContentTypeToElem (contentTypesOverrides ct)
|
||||
|
||||
data DefaultContentType = DefaultContentType
|
||||
{ defContentTypesExt :: T.Text
|
||||
|
@ -1789,16 +1786,14 @@ contentTypesToEntry :: PandocMonad m => ContentTypes -> P m Entry
|
|||
contentTypesToEntry ct = elemToEntry "[Content_Types].xml" $ contentTypesToElement ct
|
||||
|
||||
pathToOverride :: FilePath -> Maybe OverrideContentType
|
||||
pathToOverride fp = OverrideContentType ("/" <> fp) <$> (getContentType fp)
|
||||
pathToOverride fp = OverrideContentType ("/" <> fp) <$> getContentType fp
|
||||
|
||||
mediaFileContentType :: FilePath -> Maybe DefaultContentType
|
||||
mediaFileContentType fp = case takeExtension fp of
|
||||
'.' : ext -> Just $
|
||||
DefaultContentType { defContentTypesExt = T.pack ext
|
||||
, defContentTypesType =
|
||||
case getMimeType fp of
|
||||
Just mt -> mt
|
||||
Nothing -> "application/octet-stream"
|
||||
fromMaybe "application/octet-stream" (getMimeType fp)
|
||||
}
|
||||
_ -> Nothing
|
||||
|
||||
|
@ -1808,9 +1803,7 @@ mediaContentType mInfo
|
|||
, Just ('.', ext) <- T.uncons t =
|
||||
Just $ DefaultContentType { defContentTypesExt = ext
|
||||
, defContentTypesType =
|
||||
case mInfoMimeType mInfo of
|
||||
Just mt -> mt
|
||||
Nothing -> "application/octet-stream"
|
||||
fromMaybe "application/octet-stream" (mInfoMimeType mInfo)
|
||||
}
|
||||
| otherwise = Nothing
|
||||
|
||||
|
@ -1842,7 +1835,7 @@ presentationToContentTypes p@(Presentation _ slides) = do
|
|||
let slideOverrides = mapMaybe
|
||||
(\fp -> pathToOverride $ "ppt/slides/" <> fp)
|
||||
relativePaths
|
||||
speakerNotesOverrides <- (mapMaybe pathToOverride) <$> getSpeakerNotesFilePaths
|
||||
speakerNotesOverrides <- mapMaybe pathToOverride <$> getSpeakerNotesFilePaths
|
||||
return $ ContentTypes
|
||||
(defaults <> mediaDefaults)
|
||||
(inheritedOverrides <> createdOverrides <> slideOverrides <> speakerNotesOverrides)
|
||||
|
@ -1862,22 +1855,22 @@ getContentType fp
|
|||
| fp == "docProps/core.xml" = Just "application/vnd.openxmlformats-package.core-properties+xml"
|
||||
| fp == "docProps/custom.xml" = Just "application/vnd.openxmlformats-officedocument.custom-properties+xml"
|
||||
| fp == "docProps/app.xml" = Just $ noPresML <> ".extended-properties+xml"
|
||||
| "ppt" : "slideMasters" : f : [] <- splitDirectories fp
|
||||
| ["ppt", "slideMasters", f] <- splitDirectories fp
|
||||
, (_, ".xml") <- splitExtension f =
|
||||
Just $ presML <> ".slideMaster+xml"
|
||||
| "ppt" : "slides" : f : [] <- splitDirectories fp
|
||||
| ["ppt", "slides", f] <- splitDirectories fp
|
||||
, (_, ".xml") <- splitExtension f =
|
||||
Just $ presML <> ".slide+xml"
|
||||
| "ppt" : "notesMasters" : f : [] <- splitDirectories fp
|
||||
| ["ppt", "notesMasters", f] <- splitDirectories fp
|
||||
, (_, ".xml") <- splitExtension f =
|
||||
Just $ presML <> ".notesMaster+xml"
|
||||
| "ppt" : "notesSlides" : f : [] <- splitDirectories fp
|
||||
| ["ppt", "notesSlides", f] <- splitDirectories fp
|
||||
, (_, ".xml") <- splitExtension f =
|
||||
Just $ presML <> ".notesSlide+xml"
|
||||
| "ppt" : "theme" : f : [] <- splitDirectories fp
|
||||
| ["ppt", "theme", f] <- splitDirectories fp
|
||||
, (_, ".xml") <- splitExtension f =
|
||||
Just $ noPresML <> ".theme+xml"
|
||||
| "ppt" : "slideLayouts" : _ : [] <- splitDirectories fp=
|
||||
| ["ppt", "slideLayouts", _] <- splitDirectories fp=
|
||||
Just $ presML <> ".slideLayout+xml"
|
||||
| otherwise = Nothing
|
||||
|
||||
|
@ -1886,9 +1879,7 @@ autoNumAttrs :: ListAttributes -> [(String, String)]
|
|||
autoNumAttrs (startNum, numStyle, numDelim) =
|
||||
numAttr <> typeAttr
|
||||
where
|
||||
numAttr = if startNum == 1
|
||||
then []
|
||||
else [("startAt", show startNum)]
|
||||
numAttr = [("startAt", show startNum) | startNum /= 1]
|
||||
typeAttr = [("type", typeString <> delimString)]
|
||||
typeString = case numStyle of
|
||||
Decimal -> "arabic"
|
||||
|
|
|
@ -580,15 +580,15 @@ isImage (Link _ (Image{} : _) _) = True
|
|||
isImage _ = False
|
||||
|
||||
splitBlocks' :: [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
|
||||
splitBlocks' cur acc [] = return $ acc ++ (if null cur then [] else [cur])
|
||||
splitBlocks' cur acc [] = return $ acc ++ ([cur | not (null cur)])
|
||||
splitBlocks' cur acc (HorizontalRule : blks) =
|
||||
splitBlocks' [] (acc ++ (if null cur then [] else [cur])) blks
|
||||
splitBlocks' [] (acc ++ ([cur | not (null cur)])) blks
|
||||
splitBlocks' cur acc (h@(Header n _ _) : blks) = do
|
||||
slideLevel <- asks envSlideLevel
|
||||
let (nts, blks') = span isNotesDiv blks
|
||||
case compare n slideLevel of
|
||||
LT -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [h : nts]) blks'
|
||||
EQ -> splitBlocks' (h:nts) (acc ++ (if null cur then [] else [cur])) blks'
|
||||
LT -> splitBlocks' [] (acc ++ ([cur | not (null cur)]) ++ [h : nts]) blks'
|
||||
EQ -> splitBlocks' (h:nts) (acc ++ ([cur | not (null cur)])) blks'
|
||||
GT -> splitBlocks' (cur ++ (h:nts)) acc blks'
|
||||
-- `blockToParagraphs` treats Plain and Para the same, so we can save
|
||||
-- some code duplication by treating them the same here.
|
||||
|
@ -604,7 +604,7 @@ splitBlocks' cur acc (Para (il:ils) : blks) | isImage il = do
|
|||
(acc ++ [cur ++ [Para [il]] ++ nts])
|
||||
(if null ils then blks' else Para ils : blks')
|
||||
_ -> splitBlocks' []
|
||||
(acc ++ (if null cur then [] else [cur]) ++ [[Para [il]] ++ nts])
|
||||
(acc ++ ([cur | not (null cur)]) ++ [Para [il] : nts])
|
||||
(if null ils then blks' else Para ils : blks')
|
||||
splitBlocks' cur acc (tbl@Table{} : blks) = do
|
||||
slideLevel <- asks envSlideLevel
|
||||
|
@ -612,14 +612,14 @@ splitBlocks' cur acc (tbl@Table{} : blks) = do
|
|||
case cur of
|
||||
[Header n _ _] | n == slideLevel ->
|
||||
splitBlocks' [] (acc ++ [cur ++ [tbl] ++ nts]) blks'
|
||||
_ -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[tbl] ++ nts]) blks'
|
||||
_ -> splitBlocks' [] (acc ++ ([cur | not (null cur)]) ++ [tbl : nts]) blks'
|
||||
splitBlocks' cur acc (d@(Div (_, classes, _) _): blks) | "columns" `elem` classes = do
|
||||
slideLevel <- asks envSlideLevel
|
||||
let (nts, blks') = span isNotesDiv blks
|
||||
case cur of
|
||||
[Header n _ _] | n == slideLevel ->
|
||||
splitBlocks' [] (acc ++ [cur ++ [d] ++ nts]) blks'
|
||||
_ -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[d] ++ nts]) blks'
|
||||
_ -> splitBlocks' [] (acc ++ ([cur | not (null cur)]) ++ [d : nts]) blks'
|
||||
splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks
|
||||
|
||||
splitBlocks :: [Block] -> Pres [[Block]]
|
||||
|
@ -692,7 +692,7 @@ blockToSpeakerNotes _ = return mempty
|
|||
handleSpeakerNotes :: Block -> Pres ()
|
||||
handleSpeakerNotes blk = do
|
||||
spNotes <- blockToSpeakerNotes blk
|
||||
modify $ \st -> st{stSpeakerNotes = (stSpeakerNotes st) <> spNotes}
|
||||
modify $ \st -> st{stSpeakerNotes = stSpeakerNotes st <> spNotes}
|
||||
|
||||
handleAndFilterSpeakerNotes' :: [Block] -> Pres [Block]
|
||||
handleAndFilterSpeakerNotes' blks = do
|
||||
|
@ -763,7 +763,7 @@ getMetaSlide = do
|
|||
mempty
|
||||
|
||||
addSpeakerNotesToMetaSlide :: Slide -> [Block] -> Pres (Slide, [Block])
|
||||
addSpeakerNotesToMetaSlide (Slide sldId layout@(MetadataSlide _ _ _ _) spkNotes) blks =
|
||||
addSpeakerNotesToMetaSlide (Slide sldId layout@(MetadataSlide{}) spkNotes) blks =
|
||||
do let (ntsBlks, blks') = span isNotesDiv blks
|
||||
spkNotes' <- mconcat <$> mapM blockToSpeakerNotes ntsBlks
|
||||
return (Slide sldId layout (spkNotes <> spkNotes'), blks')
|
||||
|
@ -877,7 +877,7 @@ emptyLayout layout = case layout of
|
|||
all emptyShape shapes2
|
||||
|
||||
emptySlide :: Slide -> Bool
|
||||
emptySlide (Slide _ layout notes) = (notes == mempty) && (emptyLayout layout)
|
||||
emptySlide (Slide _ layout notes) = (notes == mempty) && emptyLayout layout
|
||||
|
||||
blocksToPresentationSlides :: [Block] -> Pres [Slide]
|
||||
blocksToPresentationSlides blks = do
|
||||
|
|
|
@ -103,7 +103,8 @@ pandocToRST (Pandoc meta blocks) = do
|
|||
|
||||
-- | Return RST representation of reference key table.
|
||||
refsToRST :: PandocMonad m => Refs -> RST m (Doc Text)
|
||||
refsToRST refs = mapM keyToRST refs >>= return . vcat
|
||||
refsToRST refs =
|
||||
vcat <$> mapM keyToRST refs
|
||||
|
||||
-- | Return RST representation of a reference key.
|
||||
keyToRST :: PandocMonad m => ([Inline], (Text, Text)) -> RST m (Doc Text)
|
||||
|
@ -117,8 +118,7 @@ keyToRST (label, (src, _)) = do
|
|||
-- | Return RST representation of notes.
|
||||
notesToRST :: PandocMonad m => [[Block]] -> RST m (Doc Text)
|
||||
notesToRST notes =
|
||||
zipWithM noteToRST [1..] notes >>=
|
||||
return . vsep
|
||||
vsep <$> zipWithM noteToRST [1..] notes
|
||||
|
||||
-- | Return RST representation of a note.
|
||||
noteToRST :: PandocMonad m => Int -> [Block] -> RST m (Doc Text)
|
||||
|
@ -131,7 +131,8 @@ noteToRST num note = do
|
|||
pictRefsToRST :: PandocMonad m
|
||||
=> [([Inline], (Attr, Text, Text, Maybe Text))]
|
||||
-> RST m (Doc Text)
|
||||
pictRefsToRST refs = mapM pictToRST refs >>= return . vcat
|
||||
pictRefsToRST refs =
|
||||
vcat <$> mapM pictToRST refs
|
||||
|
||||
-- | Return RST representation of a picture substitution reference.
|
||||
pictToRST :: PandocMonad m
|
||||
|
@ -507,11 +508,11 @@ flatten outer
|
|||
(Span ("",[],[]) _, _) -> keep f i
|
||||
(_, Span ("",[],[]) _) -> keep f i
|
||||
-- inlineToRST handles this case properly so it's safe to keep
|
||||
(Link _ _ _, Image _ _ _) -> keep f i
|
||||
( Link{}, Image{}) -> keep f i
|
||||
-- parent inlines would prevent links from being correctly
|
||||
-- parsed, in this case we prioritise the content over the
|
||||
-- style
|
||||
(_, Link _ _ _) -> emerge f i
|
||||
(_, Link{}) -> emerge f i
|
||||
-- always give priority to strong text over emphasis
|
||||
(Emph _, Strong _) -> emerge f i
|
||||
-- drop all other nested styles
|
||||
|
@ -567,7 +568,8 @@ inlineListToRST = writeInlines . walk transformInlines
|
|||
|
||||
-- | Convert list of Pandoc inline elements to RST.
|
||||
writeInlines :: PandocMonad m => [Inline] -> RST m (Doc Text)
|
||||
writeInlines lst = mapM inlineToRST lst >>= return . hcat
|
||||
writeInlines lst =
|
||||
hcat <$> mapM inlineToRST lst
|
||||
|
||||
-- | Convert Pandoc inline element to RST.
|
||||
inlineToRST :: PandocMonad m => Inline -> RST m (Doc Text)
|
||||
|
|
|
@ -282,7 +282,7 @@ inlineToTEI opts (Link attr txt (src, _))
|
|||
linktext <- inlinesToTEI opts txt
|
||||
return $ linktext <+> char '(' <> emailLink <> char ')'
|
||||
| otherwise =
|
||||
(inTags False "ref" $ ("target", src) : idFromAttr opts attr)
|
||||
inTags False "ref" (("target", src) : idFromAttr opts attr)
|
||||
<$> inlinesToTEI opts txt
|
||||
inlineToTEI opts (Image attr description (src, tit)) = do
|
||||
let titleDoc = if T.null tit
|
||||
|
@ -300,6 +300,4 @@ inlineToTEI opts (Note contents) =
|
|||
|
||||
idFromAttr :: WriterOptions -> Attr -> [(Text, Text)]
|
||||
idFromAttr opts (id',_,_) =
|
||||
if T.null id'
|
||||
then []
|
||||
else [("xml:id", writerIdentifierPrefix opts <> id')]
|
||||
[("xml:id", writerIdentifierPrefix opts <> id') | not (T.null id')]
|
||||
|
|
|
@ -272,9 +272,8 @@ tableAnyRowToTexinfo :: PandocMonad m
|
|||
-> [[Block]]
|
||||
-> TI m (Doc Text)
|
||||
tableAnyRowToTexinfo itemtype aligns cols =
|
||||
zipWithM alignedBlock aligns cols >>=
|
||||
return . (literal itemtype $$) . foldl (\row item -> row $$
|
||||
(if isEmpty row then empty else text " @tab ") <> item) empty
|
||||
(literal itemtype $$) . foldl (\row item -> row $$
|
||||
(if isEmpty row then empty else text " @tab ") <> item) empty <$> zipWithM alignedBlock aligns cols
|
||||
|
||||
alignedBlock :: PandocMonad m
|
||||
=> Alignment
|
||||
|
|
|
@ -71,7 +71,7 @@ genAnchor id' = if Text.null id'
|
|||
|
||||
blockListToXWiki :: PandocMonad m => [Block] -> XWikiReader m Text
|
||||
blockListToXWiki blocks =
|
||||
fmap vcat $ mapM blockToXWiki blocks
|
||||
vcat <$> mapM blockToXWiki blocks
|
||||
|
||||
blockToXWiki :: PandocMonad m => Block -> XWikiReader m Text
|
||||
|
||||
|
@ -79,7 +79,7 @@ blockToXWiki Null = return ""
|
|||
|
||||
blockToXWiki (Div (id', _, _) blocks) = do
|
||||
content <- blockListToXWiki blocks
|
||||
return $ (genAnchor id') <> content
|
||||
return $ genAnchor id' <> content
|
||||
|
||||
blockToXWiki (Plain inlines) =
|
||||
inlineListToXWiki inlines
|
||||
|
@ -100,7 +100,7 @@ blockToXWiki HorizontalRule = return "\n----\n"
|
|||
blockToXWiki (Header level (id', _, _) inlines) = do
|
||||
contents <- inlineListToXWiki inlines
|
||||
let eqs = Text.replicate level "="
|
||||
return $ eqs <> " " <> contents <> " " <> (genAnchor id') <> eqs <> "\n"
|
||||
return $ eqs <> " " <> contents <> " " <> genAnchor id' <> eqs <> "\n"
|
||||
|
||||
-- XWiki doesn't appear to differentiate between inline and block-form code, so we delegate
|
||||
-- We do amend the text to ensure that the code markers are on their own lines, since this is a block
|
||||
|
@ -211,8 +211,8 @@ inlineToXWiki il@(RawInline frmt str)
|
|||
inlineToXWiki (Link (id', _, _) txt (src, _)) = do
|
||||
label <- inlineListToXWiki txt
|
||||
case txt of
|
||||
[Str s] | isURI src && escapeURI s == src -> return $ src <> (genAnchor id')
|
||||
_ -> return $ "[[" <> label <> ">>" <> src <> "]]" <> (genAnchor id')
|
||||
[Str s] | isURI src && escapeURI s == src -> return $ src <> genAnchor id'
|
||||
_ -> return $ "[[" <> label <> ">>" <> src <> "]]" <> genAnchor id'
|
||||
|
||||
inlineToXWiki (Image _ alt (source, tit)) = do
|
||||
alt' <- inlineListToXWiki alt
|
||||
|
@ -225,12 +225,12 @@ inlineToXWiki (Image _ alt (source, tit)) = do
|
|||
|
||||
inlineToXWiki (Note contents) = do
|
||||
contents' <- blockListToXWiki contents
|
||||
return $ "{{footnote}}" <> (Text.strip contents') <> "{{/footnote}}"
|
||||
return $ "{{footnote}}" <> Text.strip contents' <> "{{/footnote}}"
|
||||
|
||||
-- TODO: support attrs other than id (anchor)
|
||||
inlineToXWiki (Span (id', _, _) contents) = do
|
||||
contents' <- inlineListToXWiki contents
|
||||
return $ (genAnchor id') <> contents'
|
||||
return $ genAnchor id' <> contents'
|
||||
|
||||
-- Utility method since (for now) all lists are handled the same way
|
||||
blockToXWikiList :: PandocMonad m => Text -> [[Block]] -> XWikiReader m Text
|
||||
|
@ -244,7 +244,7 @@ listItemToXWiki :: PandocMonad m => [Block] -> XWikiReader m Text
|
|||
listItemToXWiki contents = do
|
||||
marker <- asks listLevel
|
||||
contents' <- blockListToXWiki contents
|
||||
return $ marker <> ". " <> (Text.strip contents')
|
||||
return $ marker <> ". " <> Text.strip contents'
|
||||
|
||||
|
||||
-- | Convert definition list item (label, list of blocks) to MediaWiki.
|
||||
|
@ -256,7 +256,7 @@ definitionListItemToMediaWiki (label, items) = do
|
|||
contents <- mapM blockListToXWiki items
|
||||
marker <- asks listLevel
|
||||
return $ marker <> " " <> labelText <> "\n" <>
|
||||
intercalate "\n" (map (\d -> (Text.init marker) <> ": " <> d) contents)
|
||||
intercalate "\n" (map (\d -> Text.init marker <> ": " <> d) contents)
|
||||
|
||||
-- Escape the escape character, as well as formatting pairs
|
||||
escapeXWikiString :: Text -> Text
|
||||
|
|
|
@ -18,7 +18,6 @@ import Data.Algorithm.Diff
|
|||
import qualified Data.ByteString as BS
|
||||
import qualified Data.Text as T
|
||||
import Data.List (isSuffixOf)
|
||||
import Prelude hiding (readFile)
|
||||
import System.Directory
|
||||
import System.Exit
|
||||
import System.FilePath (joinPath, splitDirectories, takeDirectory, (</>))
|
||||
|
|
|
@ -91,7 +91,7 @@ testForWarningsWithOpts opts name docxFile expected =
|
|||
|
||||
getMedia :: FilePath -> FilePath -> IO (Maybe B.ByteString)
|
||||
getMedia archivePath mediaPath = do
|
||||
zf <- B.readFile archivePath >>= return . toArchive
|
||||
zf <- toArchive <$> B.readFile archivePath
|
||||
return $ findEntryByPath ("word/" ++ mediaPath) zf >>= (Just . fromEntry)
|
||||
|
||||
compareMediaPathIO :: FilePath -> MediaBag -> FilePath -> IO Bool
|
||||
|
|
|
@ -95,14 +95,14 @@ tests = [ testGroup "base tag"
|
|||
]
|
||||
, testGroup "samp"
|
||||
[
|
||||
test html "inline samp block" $
|
||||
"<samp>Answer is 42</samp>" =?>
|
||||
test html "inline samp block" $
|
||||
"<samp>Answer is 42</samp>" =?>
|
||||
plain (codeWith ("",["sample"],[]) "Answer is 42")
|
||||
]
|
||||
, testGroup "var"
|
||||
[
|
||||
test html "inline var block" $
|
||||
"<var>result</var>" =?>
|
||||
test html "inline var block" $
|
||||
"<var>result</var>" =?>
|
||||
plain (codeWith ("",["variable"],[]) "result")
|
||||
]
|
||||
, askOption $ \(QuickCheckTests numtests) ->
|
||||
|
|
|
@ -51,13 +51,13 @@ tests = [
|
|||
=?> header 2 (text "The header 2")
|
||||
, "Macro args" =:
|
||||
".B \"single arg with \"\"Q\"\"\""
|
||||
=?> (para $ strong $ text "single arg with \"Q\"")
|
||||
=?>para (strong $ text "single arg with \"Q\"")
|
||||
, "Argument from next line" =:
|
||||
".B\nsingle arg with \"Q\""
|
||||
=?> (para $ strong $ text "single arg with \"Q\"")
|
||||
=?>para (strong $ text "single arg with \"Q\"")
|
||||
, "comment" =:
|
||||
".\\\"bla\naaa"
|
||||
=?> (para $ str "aaa")
|
||||
=?>para (str "aaa")
|
||||
, "link" =:
|
||||
".BR aa (1)"
|
||||
=?> para (strong (str "aa") <> str "(1)")
|
||||
|
@ -65,7 +65,7 @@ tests = [
|
|||
testGroup "Escapes" [
|
||||
"fonts" =:
|
||||
"aa\\fIbb\\fRcc"
|
||||
=?> (para $ str "aa" <> (emph $ str "bb") <> str "cc")
|
||||
=?>para (str "aa" <> (emph $ str "bb") <> str "cc")
|
||||
, "nested fonts" =:
|
||||
"\\f[BI]hi\\f[I] there\\f[R]"
|
||||
=?> para (emph (strong (text "hi") <> text " there"))
|
||||
|
@ -75,26 +75,26 @@ tests = [
|
|||
text " ok")
|
||||
, "skip" =:
|
||||
"a\\%\\\n\\:b\\0"
|
||||
=?> (para $ str "ab\8199")
|
||||
=?>para (str "ab\8199")
|
||||
, "replace" =:
|
||||
"\\-\\ \\\\\\[lq]\\[rq]\\[em]\\[en]\\*(lq\\*(rq"
|
||||
=?> (para $ text "- \\“”—–“”")
|
||||
=?>para (text "- \\“”—–“”")
|
||||
, "replace2" =:
|
||||
"\\t\\e\\`\\^\\|\\'" =?> (para $ text "\\`\8202\8198`")
|
||||
"\\t\\e\\`\\^\\|\\'" =?>para (text "\\`\8202\8198`")
|
||||
, "comment with \\\"" =:
|
||||
"Foo \\\" bar\n" =?> (para $ text "Foo")
|
||||
"Foo \\\" bar\n" =?>para (text "Foo")
|
||||
, "comment with \\#" =:
|
||||
"Foo\\#\nbar\n" =?> (para $ text "Foobar")
|
||||
"Foo\\#\nbar\n" =?>para (text "Foobar")
|
||||
, "two letter escapes" =:
|
||||
"\\(oA\\(~O" =?> (para $ text "ÅÕ")
|
||||
"\\(oA\\(~O" =?>para (text "ÅÕ")
|
||||
, "bracketed escapes" =:
|
||||
"\\[oA]\\[~O]\\[Do]\\[Ye]\\[product]\\[ul]" =?> (para $ text "ÅÕ$¥∏_")
|
||||
"\\[oA]\\[~O]\\[Do]\\[Ye]\\[product]\\[ul]" =?>para (text "ÅÕ$¥∏_")
|
||||
, "unicode escapes" =:
|
||||
"\\[u2020]" =?> (para $ text "†")
|
||||
"\\[u2020]" =?>para (text "†")
|
||||
, "unicode escapes (combined)" =:
|
||||
"\\[u0075_u0301]" =?> (para $ text "\250")
|
||||
"\\[u0075_u0301]" =?>para (text "\250")
|
||||
, "unknown escape (#5034)" =:
|
||||
"\\9" =?> (para $ text "9")
|
||||
"\\9" =?>para (text "9")
|
||||
],
|
||||
testGroup "Lists" [
|
||||
"bullet" =:
|
||||
|
@ -108,7 +108,7 @@ tests = [
|
|||
=?> orderedListWith (1,UpperAlpha,OneParen) [para $ str "first", para $ str "second"]
|
||||
, "nested" =:
|
||||
".IP \"\\[bu]\"\nfirst\n.RS\n.IP \"\\[bu]\"\n1a\n.IP \"\\[bu]\"\n1b\n.RE"
|
||||
=?> bulletList [(para $ str "first") <> (bulletList [para $ str "1a", para $ str "1b"])]
|
||||
=?> bulletList [para (str "first") <> bulletList [para $ str "1a", para $ str "1b"]]
|
||||
, "change in list style" =:
|
||||
".IP \\[bu]\nfirst\n.IP 1\nsecond"
|
||||
=?> bulletList [para (str "first")] <>
|
||||
|
|
|
@ -199,6 +199,6 @@ tests =
|
|||
, "#+pandoc-emphasis-post:"
|
||||
, "[/noemph/]"
|
||||
] =?>
|
||||
para ("[/noemph/]")
|
||||
para "[/noemph/]"
|
||||
]
|
||||
]
|
||||
|
|
|
@ -311,14 +311,14 @@ tests =
|
|||
, "Ordered List in Bullet List" =:
|
||||
("- Emacs\n" <>
|
||||
" + Org\n") =?>
|
||||
bulletList [ (plain "Emacs") <>
|
||||
(orderedList [ plain "Org"])
|
||||
bulletList [ plain "Emacs" <>
|
||||
orderedList [ plain "Org"]
|
||||
]
|
||||
|
||||
, "Bullet List in Ordered List" =:
|
||||
("+ GNU\n" <>
|
||||
" - Freedom\n") =?>
|
||||
orderedList [ (plain "GNU") <> bulletList [ (plain "Freedom") ] ]
|
||||
orderedList [ plain "GNU" <> bulletList [ plain "Freedom" ] ]
|
||||
|
||||
, "Definition List" =:
|
||||
T.unlines [ ": PLL"
|
||||
|
|
|
@ -74,13 +74,13 @@ tests = [ testGroup "inline code"
|
|||
, testGroup "sample with style"
|
||||
[ "samp should wrap highlighted code" =:
|
||||
codeWith ("",["sample","haskell"],[]) ">>="
|
||||
=?> ("<samp><code class=\"sourceCode haskell\">" ++
|
||||
=?> ("<samp><code class=\"sourceCode haskell\">" ++
|
||||
"<span class=\"op\">>>=</span></code></samp>")
|
||||
]
|
||||
, testGroup "variable with style"
|
||||
[ "var should wrap highlighted code" =:
|
||||
codeWith ("",["haskell","variable"],[]) ">>="
|
||||
=?> ("<var><code class=\"sourceCode haskell\">" ++
|
||||
=?> ("<var><code class=\"sourceCode haskell\">" ++
|
||||
"<span class=\"op\">>>=</span></code></var>")
|
||||
]
|
||||
]
|
||||
|
|
|
@ -93,7 +93,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)."
|
||||
|
@ -110,11 +110,11 @@ noteTests = testGroup "note and reference location"
|
|||
, "[^1]: Down here."
|
||||
, ""
|
||||
, "[^2]: The second note."
|
||||
])
|
||||
]
|
||||
, 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)."
|
||||
|
@ -131,11 +131,11 @@ noteTests = testGroup "note and reference location"
|
|||
, "============="
|
||||
, ""
|
||||
, "Some more text."
|
||||
])
|
||||
]
|
||||
, 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]."
|
||||
|
@ -154,11 +154,11 @@ noteTests = testGroup "note and reference location"
|
|||
, "============="
|
||||
, ""
|
||||
, "Some more text."
|
||||
])
|
||||
]
|
||||
, 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)."
|
||||
|
@ -175,7 +175,7 @@ noteTests = testGroup "note and reference location"
|
|||
, "============="
|
||||
, ""
|
||||
, "Some more text."
|
||||
])
|
||||
]
|
||||
|
||||
]
|
||||
|
||||
|
@ -191,24 +191,24 @@ shortcutLinkRefsTests =
|
|||
=: 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"
|
||||
|
@ -216,8 +216,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"
|
||||
|
@ -225,43 +225,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"
|
||||
|
|
|
@ -175,6 +175,6 @@ tests = [ testGroup "rubrics"
|
|||
, "--------"]
|
||||
]
|
||||
, testTemplate "$subtitle$\n" "subtitle" $
|
||||
(setMeta "subtitle" ("subtitle" :: Inlines) $ doc $ plain "") =?>
|
||||
setMeta "subtitle" ("subtitle" :: Inlines) (doc $ plain "") =?>
|
||||
("subtitle" :: String)
|
||||
]
|
||||
|
|
Loading…
Reference in a new issue