summaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2017-01-22 23:49:05 +0100
committerJohn MacFarlane <jgm@berkeley.edu>2017-01-25 17:07:43 +0100
commitbc7e846da61bdcd3ce6ef49e9d3e6bf4a0bd1a5d (patch)
treebf64321ccb99aa7f694be8dbf28c928f47d9ecf4 /src/Text
parent4e97efe857aa574d14566ef33e7402840c9ef684 (diff)
More logging-related changes.
Class: * Removed getWarnings, withWarningsToStderr * Added report * Added logOutput to PandocMonad * Make logOutput streaming in PandocIO monad * Properly reverse getLog output Readers: * Replaced use of trace with report DEBUG. TWiki Reader: Put everything inside PandocMonad m. API changes.
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Class.hs45
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs14
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs10
-rw-r--r--src/Text/Pandoc/Readers/MediaWiki.hs9
-rw-r--r--src/Text/Pandoc/Readers/TWiki.hs149
-rw-r--r--src/Text/Pandoc/Readers/Textile.hs11
6 files changed, 115 insertions, 123 deletions
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 1c21c7b7b..79c7316f1 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -42,7 +42,7 @@ module Text.Pandoc.Class ( PandocMonad(..)
, getZonedTime
, warning
, warningWithPos
- , getWarnings
+ , report
, getLog
, setVerbosity
, getMediaBag
@@ -59,7 +59,6 @@ module Text.Pandoc.Class ( PandocMonad(..)
, runIOorExplode
, runPure
, withMediaBag
- , withWarningsToStderr
) where
import Prelude hiding (readFile)
@@ -69,8 +68,8 @@ import Codec.Archive.Zip (Archive, fromArchive, emptyArchive)
import Data.Unique (hashUnique)
import qualified Data.Unique as IO (newUnique)
import qualified Text.Pandoc.Shared as IO ( readDataFile
- , warn
, openURL )
+import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Compat.Time (UTCTime)
import Text.Pandoc.Options (Verbosity(..))
import Text.Pandoc.Parsing (ParserT, SourcePos)
@@ -102,10 +101,12 @@ import Control.Monad.RWS (RWST)
import Data.Word (Word8)
import Data.Default
import System.IO.Error
+import System.IO (stderr)
import qualified Data.Map as M
import Text.Pandoc.Error
import Data.Monoid
import Data.Maybe (catMaybes)
+import Text.Printf (printf)
class (Functor m, Applicative m, Monad m, MonadError PandocError m)
=> PandocMonad m where
@@ -131,13 +132,7 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m)
modifyCommonState :: (CommonState -> CommonState) -> m ()
modifyCommonState f = getCommonState >>= putCommonState . f
- -- Can be overridden when you want log to be written to
- -- stderr in a streaming fashion
- report :: Verbosity -> String -> m ()
- report level msg = do
- verbosity <- getsCommonState stVerbosity
- when (level >= verbosity) $
- modifyCommonState $ \st -> st{ stLog = (level, msg) : stLog st }
+ logOutput :: Verbosity -> String -> m ()
-- Functions defined for all PandocMonad instances
@@ -146,7 +141,7 @@ setVerbosity verbosity =
modifyCommonState $ \st -> st{ stVerbosity = verbosity }
getLog :: PandocMonad m => m [(Verbosity, String)]
-getLog = getsCommonState stLog
+getLog = reverse <$> getsCommonState stLog
warning :: PandocMonad m => String -> m ()
warning msg = report WARNING msg
@@ -157,11 +152,13 @@ warningWithPos :: PandocMonad m
-> ParserT s st m ()
warningWithPos pos msg = lift $ warning $ msg ++ " " ++ show pos
--- TODO get rid of this?
-getWarnings :: PandocMonad m => m [String]
-getWarnings = do
- logs <- getLog
- return [s | (WARNING, s) <- logs]
+report :: PandocMonad m => Verbosity -> String -> m ()
+report level msg = do
+ verbosity <- getsCommonState stVerbosity
+ when (level <= verbosity) $ do
+ logOutput verbosity msg
+ unless (level == DEBUG) $
+ modifyCommonState $ \st -> st{ stLog = (level, msg) : stLog st }
setMediaBag :: PandocMonad m => MediaBag -> m ()
setMediaBag mb = modifyCommonState $
@@ -255,12 +252,6 @@ runIO ma = flip evalStateT def $ runExceptT $ unPandocIO ma
withMediaBag :: PandocMonad m => m a -> m (a, MediaBag)
withMediaBag ma = ((,)) <$> ma <*> getMediaBag
-withWarningsToStderr :: PandocIO a -> PandocIO a
-withWarningsToStderr f = do
- x <- f
- getWarnings >>= mapM_ IO.warn
- return x
-
runIOorExplode :: PandocIO a -> IO a
runIOorExplode ma = runIO ma >>= handleError
@@ -309,7 +300,8 @@ instance PandocMonad PandocIO where
Left _ -> throwError $ PandocFileReadError fp
getCommonState = PandocIO $ lift get
putCommonState x = PandocIO $ lift $ put x
-
+ logOutput level msg =
+ liftIO $ UTF8.hPutStrLn stderr $ printf "%-7s %s" (show level) msg
-- | Specialized version of parseURIReference that disallows
-- single-letter schemes. Reason: these are usually windows absolute
@@ -508,6 +500,8 @@ instance PandocMonad PandocPure where
getCommonState = PandocPure $ lift $ get
putCommonState x = PandocPure $ lift $ put x
+ logOutput _level _msg = return ()
+
instance PandocMonad m => PandocMonad (ParserT s st m) where
lookupEnv = lift . lookupEnv
getCurrentTime = lift getCurrentTime
@@ -522,6 +516,7 @@ instance PandocMonad m => PandocMonad (ParserT s st m) where
getModificationTime = lift . getModificationTime
getCommonState = lift getCommonState
putCommonState = lift . putCommonState
+ logOutput lvl = lift . logOutput lvl
instance PandocMonad m => PandocMonad (ReaderT r m) where
lookupEnv = lift . lookupEnv
@@ -537,6 +532,7 @@ instance PandocMonad m => PandocMonad (ReaderT r m) where
getModificationTime = lift . getModificationTime
getCommonState = lift getCommonState
putCommonState = lift . putCommonState
+ logOutput lvl = lift . logOutput lvl
instance (PandocMonad m, Monoid w) => PandocMonad (WriterT w m) where
lookupEnv = lift . lookupEnv
@@ -552,6 +548,7 @@ instance (PandocMonad m, Monoid w) => PandocMonad (WriterT w m) where
getModificationTime = lift . getModificationTime
getCommonState = lift getCommonState
putCommonState = lift . putCommonState
+ logOutput lvl = lift . report lvl
instance (PandocMonad m, Monoid w) => PandocMonad (RWST r w st m) where
lookupEnv = lift . lookupEnv
@@ -567,6 +564,7 @@ instance (PandocMonad m, Monoid w) => PandocMonad (RWST r w st m) where
getModificationTime = lift . getModificationTime
getCommonState = lift getCommonState
putCommonState = lift . putCommonState
+ logOutput lvl = lift . logOutput lvl
instance PandocMonad m => PandocMonad (StateT st m) where
lookupEnv = lift . lookupEnv
@@ -582,4 +580,5 @@ instance PandocMonad m => PandocMonad (StateT st m) where
getModificationTime = lift . getModificationTime
getCommonState = lift getCommonState
putCommonState = lift . putCommonState
+ logOutput lvl = lift . logOutput lvl
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index d602f7303..0bb837ba9 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -45,7 +45,7 @@ import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Builder (Blocks, Inlines, trimInlines, HasMeta(..))
import Text.Pandoc.Shared ( extractSpaces, renderTags', addMetaField
, escapeURI, safeRead )
-import Text.Pandoc.Options (ReaderOptions(readerParseRaw, readerVerbosity),
+import Text.Pandoc.Options (ReaderOptions(readerParseRaw),
Verbosity(..), Extension (Ext_epub_html_exts,
Ext_native_divs, Ext_native_spans))
import Text.Pandoc.Parsing hiding ((<|>))
@@ -54,12 +54,11 @@ import qualified Data.Map as M
import Data.Maybe ( fromMaybe, isJust)
import Data.List ( intercalate, isInfixOf, isPrefixOf )
import Data.Char ( isDigit )
-import Control.Monad ( guard, when, mzero, void, unless )
+import Control.Monad ( guard, mzero, void, unless )
import Control.Arrow ((***))
import Control.Applicative ( (<|>) )
import Data.Monoid (First (..))
import Text.Printf (printf)
-import Debug.Trace (trace)
import Text.TeXMath (readMathML, writeTeX)
import Data.Default (Default (..), def)
import Control.Monad.Reader (ask, asks, local, ReaderT, runReaderT, lift)
@@ -69,7 +68,7 @@ import Data.Monoid ((<>))
import Text.Parsec.Error
import qualified Data.Set as Set
import Text.Pandoc.Error
-import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Class (PandocMonad, report)
import Control.Monad.Except (throwError)
@@ -96,8 +95,6 @@ readHtml opts inp = do
case result of
Right doc -> return doc
Left err -> throwError $ PandocParseError $ getError err
-
- where
replaceNotes :: PandocMonad m => [Block] -> TagParser m [Block]
replaceNotes = walkM replaceNotes'
@@ -160,7 +157,6 @@ pHead = pInTags "head" $ pTitle <|> pMetaTag <|> pBaseTag <|> (mempty <$ pAnyTag
block :: PandocMonad m => TagParser m Blocks
block = do
- tr <- (== DEBUG) <$> getOption readerVerbosity
pos <- getPosition
res <- choice
[ eSection
@@ -181,8 +177,8 @@ block = do
, pPlain
, pRawHtmlBlock
]
- when tr $ trace (printf "line %d: %s" (sourceLine pos)
- (take 60 $ show $ B.toList res)) (return ())
+ report DEBUG $ printf "line %d: %s"
+ (sourceLine pos) (take 60 $ show $ B.toList res)
return res
namespaces :: PandocMonad m => [(String, TagParser m Inlines)]
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index e0036f708..5052f52bf 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -62,11 +62,10 @@ import Control.Monad
import System.FilePath (takeExtension, addExtension)
import Text.HTML.TagSoup
import Text.Printf (printf)
-import Debug.Trace (trace)
import Data.Monoid ((<>))
import Control.Monad.Trans (lift)
import Control.Monad.Except (throwError, catchError)
-import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Class (PandocMonad, report)
import qualified Text.Pandoc.Class as P
type MarkdownParser m = ParserT [Char] ParserState m
@@ -490,7 +489,6 @@ parseBlocks = mconcat <$> manyTill block eof
block :: PandocMonad m => MarkdownParser m (F Blocks)
block = do
- tr <- (== DEBUG) <$> getOption readerVerbosity
pos <- getPosition
res <- choice [ mempty <$ blanklines
, codeBlockFenced
@@ -517,10 +515,8 @@ block = do
, para
, plain
] <?> "block"
- when tr $ do
- st <- getState
- trace (printf "line %d: %s" (sourceLine pos)
- (take 60 $ show $ B.toList $ runF res st)) (return ())
+ report DEBUG $ printf "line %d: %s" (sourceLine pos)
+ (take 60 $ show $ B.toList $ runF res defaultParserState)
return res
--
diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs
index 38a9e3f4f..b81d0f3e4 100644
--- a/src/Text/Pandoc/Readers/MediaWiki.hs
+++ b/src/Text/Pandoc/Readers/MediaWiki.hs
@@ -56,9 +56,8 @@ import qualified Data.Set as Set
import Data.Char (isDigit, isSpace)
import Data.Maybe (fromMaybe)
import Text.Printf (printf)
-import Debug.Trace (trace)
import Control.Monad.Except (throwError)
-import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Class (PandocMonad, report)
-- | Read mediawiki from an input string and return a Pandoc document.
readMediaWiki :: PandocMonad m
@@ -194,7 +193,6 @@ parseMediaWiki = do
block :: PandocMonad m => MWParser m Blocks
block = do
- tr <- (== DEBUG) <$> getOption readerVerbosity
pos <- getPosition
res <- mempty <$ skipMany1 blankline
<|> table
@@ -208,9 +206,8 @@ block = do
<|> blockTag
<|> (B.rawBlock "mediawiki" <$> template)
<|> para
- when tr $
- trace (printf "line %d: %s" (sourceLine pos)
- (take 60 $ show $ B.toList res)) (return ())
+ report DEBUG $ printf "line %d: %s" (sourceLine pos)
+ (take 60 $ show $ B.toList res)
return res
para :: PandocMonad m => MWParser m Blocks
diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs
index b54eec735..1a827bcd9 100644
--- a/src/Text/Pandoc/Readers/TWiki.hs
+++ b/src/Text/Pandoc/Readers/TWiki.hs
@@ -39,39 +39,38 @@ import Text.Pandoc.Parsing hiding (enclosed, macro, nested)
import Text.Pandoc.Readers.HTML (htmlTag, isCommentTag)
import Control.Monad
import Text.Printf (printf)
-import Debug.Trace (trace)
import Text.Pandoc.XML (fromEntities)
import Data.Maybe (fromMaybe)
import Text.HTML.TagSoup
import Data.Char (isAlphaNum)
import qualified Data.Foldable as F
import Control.Monad.Except (throwError)
-import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Class (PandocMonad, report)
-- | Read twiki from an input string and return a Pandoc document.
readTWiki :: PandocMonad m
=> ReaderOptions
-> String
-> m Pandoc
-readTWiki opts s =
- case (readWith parseTWiki) def{ stateOptions = opts } (s ++ "\n\n") of
+readTWiki opts s = do
+ res <- readWithM parseTWiki def{ stateOptions = opts } (s ++ "\n\n")
+ case res of
Left e -> throwError e
Right d -> return d
-
-type TWParser = Parser [Char] ParserState
+type TWParser = ParserT [Char] ParserState
--
-- utility functions
--
-tryMsg :: String -> TWParser a -> TWParser a
+tryMsg :: String -> TWParser m a -> TWParser m a
tryMsg msg p = try p <?> msg
-skip :: TWParser a -> TWParser ()
+skip :: TWParser m a -> TWParser m ()
skip parser = parser >> return ()
-nested :: TWParser a -> TWParser a
+nested :: PandocMonad m => TWParser m a -> TWParser m a
nested p = do
nestlevel <- stateMaxNestingLevel <$> getState
guard $ nestlevel > 0
@@ -80,7 +79,7 @@ nested p = do
updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }
return res
-htmlElement :: String -> TWParser (Attr, String)
+htmlElement :: PandocMonad m => String -> TWParser m (Attr, String)
htmlElement tag = tryMsg tag $ do
(TagOpen _ attr, _) <- htmlTag (~== TagOpen tag [])
content <- manyTill anyChar (endtag <|> endofinput)
@@ -97,7 +96,8 @@ htmlAttrToPandoc attrs = (ident, classes, keyvals)
classes = maybe [] words $ lookup "class" attrs
keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
-parseHtmlContentWithAttrs :: String -> TWParser a -> TWParser (Attr, [a])
+parseHtmlContentWithAttrs :: PandocMonad m
+ => String -> TWParser m a -> TWParser m (Attr, [a])
parseHtmlContentWithAttrs tag parser = do
(attr, content) <- htmlElement tag
parsedContent <- try $ parseContent content
@@ -106,14 +106,14 @@ parseHtmlContentWithAttrs tag parser = do
parseContent = parseFromString $ nested $ manyTill parser endOfContent
endOfContent = try $ skipMany blankline >> skipSpaces >> eof
-parseHtmlContent :: String -> TWParser a -> TWParser [a]
+parseHtmlContent :: PandocMonad m => String -> TWParser m a -> TWParser m [a]
parseHtmlContent tag p = parseHtmlContentWithAttrs tag p >>= return . snd
--
-- main parser
--
-parseTWiki :: TWParser Pandoc
+parseTWiki :: PandocMonad m => TWParser m Pandoc
parseTWiki = do
bs <- mconcat <$> many block
spaces
@@ -125,20 +125,18 @@ parseTWiki = do
-- block parsers
--
-block :: TWParser B.Blocks
+block :: PandocMonad m => TWParser m B.Blocks
block = do
- tr <- (== DEBUG) <$> getOption readerVerbosity
pos <- getPosition
res <- mempty <$ skipMany1 blankline
<|> blockElements
<|> para
skipMany blankline
- when tr $
- trace (printf "line %d: %s" (sourceLine pos)
- (take 60 $ show $ B.toList res)) (return ())
+ report DEBUG $ printf "line %d: %s" (sourceLine pos)
+ (take 60 $ show $ B.toList res)
return res
-blockElements :: TWParser B.Blocks
+blockElements :: PandocMonad m => TWParser m B.Blocks
blockElements = choice [ separator
, header
, verbatim
@@ -149,10 +147,10 @@ blockElements = choice [ separator
, noautolink
]
-separator :: TWParser B.Blocks
+separator :: PandocMonad m => TWParser m B.Blocks
separator = tryMsg "separator" $ string "---" >> newline >> return B.horizontalRule
-header :: TWParser B.Blocks
+header :: PandocMonad m => TWParser m B.Blocks
header = tryMsg "header" $ do
string "---"
level <- many1 (char '+') >>= return . length
@@ -163,43 +161,45 @@ header = tryMsg "header" $ do
attr <- registerHeader ("", classes, []) content
return $ B.headerWith attr level $ content
-verbatim :: TWParser B.Blocks
+verbatim :: PandocMonad m => TWParser m B.Blocks
verbatim = (htmlElement "verbatim" <|> htmlElement "pre")
>>= return . (uncurry B.codeBlockWith)
-literal :: TWParser B.Blocks
+literal :: PandocMonad m => TWParser m B.Blocks
literal = htmlElement "literal" >>= return . rawBlock
where
format (_, _, kvs) = fromMaybe "html" $ lookup "format" kvs
rawBlock (attrs, content) = B.rawBlock (format attrs) content
-list :: String -> TWParser B.Blocks
+list :: PandocMonad m => String -> TWParser m B.Blocks
list prefix = choice [ bulletList prefix
, orderedList prefix
, definitionList prefix]
-definitionList :: String -> TWParser B.Blocks
+definitionList :: PandocMonad m => String -> TWParser m B.Blocks
definitionList prefix = tryMsg "definitionList" $ do
indent <- lookAhead $ string prefix *> (many1 $ string " ") <* string "$ "
elements <- many $ parseDefinitionListItem (prefix ++ concat indent)
return $ B.definitionList elements
where
- parseDefinitionListItem :: String -> TWParser (B.Inlines, [B.Blocks])
+ parseDefinitionListItem :: PandocMonad m
+ => String -> TWParser m (B.Inlines, [B.Blocks])
parseDefinitionListItem indent = do
string (indent ++ "$ ") >> skipSpaces
term <- many1Till inline $ string ": "
line <- listItemLine indent $ string "$ "
return $ (mconcat term, [line])
-bulletList :: String -> TWParser B.Blocks
+bulletList :: PandocMonad m => String -> TWParser m B.Blocks
bulletList prefix = tryMsg "bulletList" $
parseList prefix (char '*') (char ' ')
-orderedList :: String -> TWParser B.Blocks
+orderedList :: PandocMonad m => String -> TWParser m B.Blocks
orderedList prefix = tryMsg "orderedList" $
parseList prefix (oneOf "1iIaA") (string ". ")
-parseList :: String -> TWParser Char -> TWParser a -> TWParser B.Blocks
+parseList :: PandocMonad m
+ => String -> TWParser m Char -> TWParser m a -> TWParser m B.Blocks
parseList prefix marker delim = do
(indent, style) <- lookAhead $ string prefix *> listStyle <* delim
blocks <- many $ parseListItem (prefix ++ indent) (char style <* delim)
@@ -216,10 +216,12 @@ parseList prefix marker delim = do
style <- marker
return (concat indent, style)
-parseListItem :: Show a => String -> TWParser a -> TWParser B.Blocks
+parseListItem :: (PandocMonad m, Show a)
+ => String -> TWParser m a -> TWParser m B.Blocks
parseListItem prefix marker = string prefix >> marker >> listItemLine prefix marker
-listItemLine :: Show a => String -> TWParser a -> TWParser B.Blocks
+listItemLine :: (PandocMonad m, Show a)
+ => String -> TWParser m a -> TWParser m B.Blocks
listItemLine prefix marker = lineContent >>= parseContent >>= return . mconcat
where
lineContent = do
@@ -236,7 +238,7 @@ listItemLine prefix marker = lineContent >>= parseContent >>= return . mconcat
lastNewline = try $ char '\n' <* eof
newlineBeforeNestedList = try $ char '\n' <* lookAhead nestedList
-table :: TWParser B.Blocks
+table :: PandocMonad m => TWParser m B.Blocks
table = try $ do
tableHead <- optionMaybe $ many1Till tableParseHeader newline >>= return . unzip
rows <- many1 tableParseRow
@@ -248,7 +250,7 @@ table = try $ do
columns rows = replicate (columCount rows) mempty
columCount rows = length $ head rows
-tableParseHeader :: TWParser ((Alignment, Double), B.Blocks)
+tableParseHeader :: PandocMonad m => TWParser m ((Alignment, Double), B.Blocks)
tableParseHeader = try $ do
char '|'
leftSpaces <- many spaceChar >>= return . length
@@ -264,27 +266,27 @@ tableParseHeader = try $ do
| left > right = (AlignRight, 0)
| otherwise = (AlignLeft, 0)
-tableParseRow :: TWParser [B.Blocks]
+tableParseRow :: PandocMonad m => TWParser m [B.Blocks]
tableParseRow = many1Till tableParseColumn newline
-tableParseColumn :: TWParser B.Blocks
+tableParseColumn :: PandocMonad m => TWParser m B.Blocks
tableParseColumn = char '|' *> skipSpaces *>
tableColumnContent (skipSpaces >> char '|')
<* skipSpaces <* optional tableEndOfRow
-tableEndOfRow :: TWParser Char
+tableEndOfRow :: PandocMonad m => TWParser m Char
tableEndOfRow = lookAhead (try $ char '|' >> char '\n') >> char '|'
-tableColumnContent :: TWParser a -> TWParser B.Blocks
+tableColumnContent :: PandocMonad m => TWParser m a -> TWParser m B.Blocks
tableColumnContent end = manyTill content (lookAhead $ try end) >>= return . B.plain . mconcat
where
content = continuation <|> inline
continuation = try $ char '\\' >> newline >> return mempty
-blockQuote :: TWParser B.Blocks
+blockQuote :: PandocMonad m => TWParser m B.Blocks
blockQuote = parseHtmlContent "blockquote" block >>= return . B.blockQuote . mconcat
-noautolink :: TWParser B.Blocks
+noautolink :: PandocMonad m => TWParser m B.Blocks
noautolink = do
(_, content) <- htmlElement "noautolink"
st <- getState
@@ -295,7 +297,7 @@ noautolink = do
where
parseContent = parseFromString $ many $ block
-para :: TWParser B.Blocks
+para :: PandocMonad m => TWParser m B.Blocks
para = many1Till inline endOfParaElement >>= return . result . mconcat
where
endOfParaElement = lookAhead $ endOfInput <|> endOfPara <|> newBlockElement
@@ -311,7 +313,7 @@ para = many1Till inline endOfParaElement >>= return . result . mconcat
-- inline parsers
--
-inline :: TWParser B.Inlines
+inline :: PandocMonad m => TWParser m B.Inlines
inline = choice [ whitespace
, br
, macro
@@ -332,36 +334,39 @@ inline = choice [ whitespace
, symbol
] <?> "inline"
-whitespace :: TWParser B.Inlines
+whitespace :: PandocMonad m => TWParser m B.Inlines
whitespace = (lb <|> regsp) >>= return
where lb = try $ skipMany spaceChar >> linebreak >> return B.space
regsp = try $ skipMany1 spaceChar >> return B.space
-br :: TWParser B.Inlines
+br :: PandocMonad m => TWParser m B.Inlines
br = try $ string "%BR%" >> return B.linebreak
-linebreak :: TWParser B.Inlines
+linebreak :: PandocMonad m => TWParser m B.Inlines
linebreak = newline >> notFollowedBy newline >> (lastNewline <|> innerNewline)
where lastNewline = eof >> return mempty
innerNewline = return B.space
-between :: (Monoid c) => TWParser a -> TWParser b -> (TWParser b -> TWParser c) -> TWParser c
+between :: (Monoid c, PandocMonad m)
+ => TWParser m a -> TWParser m b -> (TWParser m b -> TWParser m c)
+ -> TWParser m c
between start end p =
mconcat <$> try (start >> notFollowedBy whitespace >> many1Till (p end) end)
-enclosed :: (Monoid b) => TWParser a -> (TWParser a -> TWParser b) -> TWParser b
+enclosed :: (Monoid b, PandocMonad m)
+ => TWParser m a -> (TWParser m a -> TWParser m b) -> TWParser m b
enclosed sep p = between sep (try $ sep <* endMarker) p
where
endMarker = lookAhead $ skip endSpace <|> skip (oneOf ".,!?:)|") <|> eof
endSpace = (spaceChar <|> newline) >> return B.space
-macro :: TWParser B.Inlines
+macro :: PandocMonad m => TWParser m B.Inlines
macro = macroWithParameters <|> withoutParameters
where
withoutParameters = enclosed (char '%') (\_ -> macroName) >>= return . emptySpan
emptySpan name = buildSpan name [] mempty
-macroWithParameters :: TWParser B.Inlines
+macroWithParameters :: PandocMonad m => TWParser m B.Inlines
macroWithParameters = try $ do
char '%'
name <- macroName
@@ -376,13 +381,13 @@ buildSpan className kvs = B.spanWith attrs
additionalClasses = maybe [] words $ lookup "class" kvs
kvsWithoutClasses = [(k,v) | (k,v) <- kvs, k /= "class"]
-macroName :: TWParser String
+macroName :: PandocMonad m => TWParser m String
macroName = do
first <- letter
rest <- many $ alphaNum <|> char '_'
return (first:rest)
-attributes :: TWParser (String, [(String, String)])
+attributes :: PandocMonad m => TWParser m (String, [(String, String)])
attributes = char '{' *> spnl *> many (attribute <* spnl) <* char '}' >>=
return . foldr (either mkContent mkKvs) ([], [])
where
@@ -391,7 +396,7 @@ attributes = char '{' *> spnl *> many (attribute <* spnl) <* char '}' >>=
mkContent c (rest, kvs) = (c ++ " " ++ rest, kvs)
mkKvs kv (cont, rest) = (cont, (kv : rest))
-attribute :: TWParser (Either String (String, String))
+attribute :: PandocMonad m => TWParser m (Either String (String, String))
attribute = withKey <|> withoutKey
where
withKey = try $ do
@@ -405,49 +410,51 @@ attribute = withKey <|> withoutKey
| allowSpaces == True = many1 $ noneOf "}"
| otherwise = many1 $ noneOf " }"
-nestedInlines :: Show a => TWParser a -> TWParser B.Inlines
+nestedInlines :: (Show a, PandocMonad m)
+ => TWParser m a -> TWParser m B.Inlines
nestedInlines end = innerSpace <|> nestedInline
where
innerSpace = try $ whitespace <* (notFollowedBy end)
nestedInline = notFollowedBy whitespace >> nested inline
-strong :: TWParser B.Inlines
+strong :: PandocMonad m => TWParser m B.Inlines
strong = try $ enclosed (char '*') nestedInlines >>= return . B.strong
-strongHtml :: TWParser B.Inlines
+strongHtml :: PandocMonad m => TWParser m B.Inlines
strongHtml = (parseHtmlContent "strong" inline <|> parseHtmlContent "b" inline)
>>= return . B.strong . mconcat
-strongAndEmph :: TWParser B.Inlines
+strongAndEmph :: PandocMonad m => TWParser m B.Inlines
strongAndEmph = try $ enclosed (string "__") nestedInlines >>= return . B.emph . B.strong
-emph :: TWParser B.Inlines
+emph :: PandocMonad m => TWParser m B.Inlines
emph = try $ enclosed (char '_') nestedInlines >>= return . B.emph
-emphHtml :: TWParser B.Inlines
+emphHtml :: PandocMonad m => TWParser m B.Inlines
emphHtml = (parseHtmlContent "em" inline <|> parseHtmlContent "i" inline)
>>= return . B.emph . mconcat
-nestedString :: Show a => TWParser a -> TWParser String
+nestedString :: (Show a, PandocMonad m)
+ => TWParser m a -> TWParser m String
nestedString end = innerSpace <|> (count 1 nonspaceChar)
where
innerSpace = try $ many1 spaceChar <* notFollowedBy end
-boldCode :: TWParser B.Inlines
+boldCode :: PandocMonad m => TWParser m B.Inlines
boldCode = try $ enclosed (string "==") nestedString >>= return . B.strong . B.code . fromEntities
-htmlComment :: TWParser B.Inlines
+htmlComment :: PandocMonad m => TWParser m B.Inlines
htmlComment = htmlTag isCommentTag >> return mempty
-code :: TWParser B.Inlines
+code :: PandocMonad m => TWParser m B.Inlines
code = try $ enclosed (char '=') nestedString >>= return . B.code . fromEntities
-codeHtml :: TWParser B.Inlines
+codeHtml :: PandocMonad m => TWParser m B.Inlines
codeHtml = do
(attrs, content) <- parseHtmlContentWithAttrs "code" anyChar
return $ B.codeWith attrs $ fromEntities content
-autoLink :: TWParser B.Inlines
+autoLink :: PandocMonad m => TWParser m B.Inlines
autoLink = try $ do
state <- getState
guard $ stateAllowLinks state
@@ -461,20 +468,20 @@ autoLink = try $ do
| c == '/' = True
| otherwise = isAlphaNum c
-str :: TWParser B.Inlines
+str :: PandocMonad m => TWParser m B.Inlines
str = (many1 alphaNum <|> count 1 characterReference) >>= return . B.str
-nop :: TWParser B.Inlines
+nop :: PandocMonad m => TWParser m B.Inlines
nop = try $ (skip exclamation <|> skip nopTag) >> followContent
where
exclamation = char '!'
nopTag = stringAnyCase "<nop>"
followContent = many1 nonspaceChar >>= return . B.str . fromEntities
-symbol :: TWParser B.Inlines
+symbol :: PandocMonad m => TWParser m B.Inlines
symbol = count 1 nonspaceChar >>= return . B.str
-smart :: TWParser B.Inlines
+smart :: PandocMonad m => TWParser m B.Inlines
smart = do
guardEnabled Ext_smart
doubleQuoted <|> singleQuoted <|>
@@ -483,14 +490,14 @@ smart = do
, ellipses
]
-singleQuoted :: TWParser B.Inlines
+singleQuoted :: PandocMonad m => TWParser m B.Inlines
singleQuoted = try $ do
singleQuoteStart
withQuoteContext InSingleQuote $
many1Till inline singleQuoteEnd >>=
(return . B.singleQuoted . B.trimInlines . mconcat)
-doubleQuoted :: TWParser B.Inlines
+doubleQuoted :: PandocMonad m => TWParser m B.Inlines
doubleQuoted = try $ do
doubleQuoteStart
contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)
@@ -498,7 +505,7 @@ doubleQuoted = try $ do
return (B.doubleQuoted $ B.trimInlines contents))
<|> (return $ (B.str "\8220") B.<> contents)
-link :: TWParser B.Inlines
+link :: PandocMonad m => TWParser m B.Inlines
link = try $ do
st <- getState
guard $ stateAllowLinks st
@@ -507,7 +514,7 @@ link = try $ do
setState $ st{ stateAllowLinks = True }
return $ B.link url title content
-linkText :: TWParser (String, String, B.Inlines)
+linkText :: PandocMonad m => TWParser m (String, String, B.Inlines)
linkText = do
string "[["
url <- many1Till anyChar (char ']')
diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs
index b3a1a208f..804ee39aa 100644
--- a/src/Text/Pandoc/Readers/Textile.hs
+++ b/src/Text/Pandoc/Readers/Textile.hs
@@ -64,11 +64,10 @@ import Text.HTML.TagSoup (fromAttrib, Tag(..))
import Text.HTML.TagSoup.Match
import Data.List ( intercalate, transpose, intersperse )
import Data.Char ( digitToInt, isUpper )
-import Control.Monad ( guard, liftM, when )
+import Control.Monad ( guard, liftM )
import Data.Monoid ((<>))
import Text.Printf
-import Debug.Trace (trace)
-import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Class (PandocMonad, report)
import Control.Monad.Except (throwError)
-- | Parse a Textile text and return a Pandoc document.
@@ -147,10 +146,8 @@ block :: PandocMonad m => ParserT [Char] ParserState m Blocks
block = do
res <- choice blockParsers <?> "block"
pos <- getPosition
- tr <- (== DEBUG) <$> getOption readerVerbosity
- when tr $
- trace (printf "line %d: %s" (sourceLine pos)
- (take 60 $ show $ B.toList res)) (return ())
+ report DEBUG $ printf "line %d: %s" (sourceLine pos)
+ (take 60 $ show $ B.toList res)
return res
commentBlock :: PandocMonad m => ParserT [Char] ParserState m Blocks