@@ -41,7 +41,7 @@ import Data.Maybe (isJust, catMaybes)
4141import Data.List (intersperse, intercalate)
4242import qualified Data.Text as T
4343
44−import Text.Pandoc.Class (PandocMonad(..), runPure, runIOorExplode)
44+import Text.Pandoc.Class (PandocMonad(..), runIOorExplode)
4545import Text.Pandoc.Definition
4646import Text.Pandoc.Error (PandocError (PandocParsecError))
4747import Text.Pandoc.Logging (LogMessage(..))
@@ -69,7 +69,7 @@ data ManToken = MStr String FontKind
6969 | MLine [(String, FontKind)]
7070 | MLink String Target
7171 | MEmptyLine
72− | MHeader Integer String
72+ | MHeader Int String
7373 | MMacro MacroKind [String]
7474 | MUnknownMacro String [String]
7575 | MComment String
@@ -80,25 +80,18 @@ data EscapeThing = EFont FontKind
8080 | ENothing
8181 deriving Show
8282
83−data RoffState = RoffState { inCodeBlock :: Bool
84− , fontKind :: FontKind
83+data RoffState = RoffState { fontKind :: FontKind
8584 } deriving Show
8685
8786instance Default RoffState where
88− def = RoffState {inCodeBlock = False, fontKind = Regular}
87+ def = RoffState {fontKind = Regular}
8988
90−data ManState = ManState {pState :: ParserState, rState :: RoffState}
91−
92−type ManParser m = ParserT [Char] ManState m
93−type ManCompiler m = ParserT [ManToken] ManState m
94−
95−instance HasLogMessages ManState where
96− addLogMessage lm mst = mst {pState = addLogMessage lm (pState mst)}
97− getLogMessages mst = getLogMessages $ pState mst
89+type ManParser m = ParserT [Char] RoffState m
90+type ManCompiler m = ParserT [ManToken] ParserState m
9891
9992----
100−testStrr :: [Char] -> Either PandocError Pandoc
101−testStrr s = runPure $ readMan def (T.pack s)
93+-- testStrr :: [Char] -> Either PandocError Pandoc
94+-- testStrr s = runPure $ readMan def (T.pack s)
10295
10396printPandoc :: Pandoc -> [Char]
10497printPandoc (Pandoc m content) =
@@ -106,10 +99,10 @@ printPandoc (Pandoc m content) =
10699 cnt = intercalate "\n" $ map show content
107100 in ttl ++ "\n" ++ cnt
108101
109−strrepr :: Either PandocError Pandoc -> [Char]
110−strrepr obj = case obj of
111− Right x -> printPandoc x
112− Left y -> show y
102+-- strrepr :: Either PandocError Pandoc -> [Char]
103+-- strrepr obj = case obj of
104+-- Right x -> printPandoc x
105+-- Left y -> show y
113106
114107testFile :: FilePath -> IO ()
115108testFile fname = do
@@ -122,10 +115,10 @@ testFile fname = do
122115-- | Read man (troff) from an input string and return a Pandoc document.
123116readMan :: PandocMonad m => ReaderOptions -> T.Text -> m Pandoc
124117readMan opts txt = do
125− let state = ManState { pState = def{ stateOptions = opts }, rState = def}
126− eithertokens <- readWithM parseMan state (T.unpack $ crFilter txt)
118+ eithertokens <- readWithM parseMan def (T.unpack $ crFilter txt)
127119 case eithertokens of
128120 Right tokenz -> do
121+ let state = def {stateOptions = opts} :: ParserState
129122 eitherdoc <- readWithMTokens compileMan state tokenz
130123 case eitherdoc of
131124 Right doc -> return doc
@@ -135,8 +128,8 @@ readMan opts txt = do
135128 where
136129
137130 readWithMTokens :: PandocMonad m
138− => ParserT [ManToken] ManState m a -- ^ parser
139− -> ManState -- ^ initial state
131+ => ParserT [ManToken] ParserState m a -- ^ parser
132+ -> ParserState -- ^ initial state
140133 -> [ManToken] -- ^ input
141134 -> m (Either PandocError a)
142135 readWithMTokens parser state input =
@@ -155,15 +148,16 @@ parseMan = many (parseMacro <|> parseLine <|> parseEmptyLine)
155148
156149compileMan :: PandocMonad m => ManCompiler m Pandoc
157150compileMan = do
158− let compilers = [compileTitle, compilePara, compileSkippedContent]
151+ let compilers = [compileTitle, compilePara, compileSkippedContent
152+ , compileCodeBlock, compileHeader, compileSkipMacro]
159153 blocks <- many $ choice compilers
160− parserst <- pState <$> getState
161− return $ Pandoc (stateMeta parserst) blocks
154+ parserst <- getState
155+ return $ Pandoc (stateMeta parserst) (filter (not . isNull) blocks)
156+
157+ where
162158
163−modifyRoffState :: PandocMonad m => (RoffState -> RoffState) -> ParsecT a ManState m ()
164−modifyRoffState f = do
165− mst <- getState
166− setState mst { rState = f $ rState mst }
159+ isNull Null = True
160+ isNull _ = False
167161
168162parseMacro :: PandocMonad m => ManParser m ManToken
169163parseMacro = do
@@ -253,7 +247,7 @@ escapeParser = do
253247 , string "[]" >> return Regular
254248 , char '[' >> many1 letter >> char ']' >> return Regular
255249 ]
256− modifyRoffState (\r -> r {fontKind = font})
250+ modifyState (\r -> r {fontKind = font})
257251 return $ EFont font
258252
259253parseLine :: PandocMonad m => ManParser m ManToken
@@ -280,7 +274,7 @@ parseLine = do
280274
281275 currentFont :: PandocMonad m => ManParser m FontKind
282276 currentFont = do
283− RoffState {fontKind = fk} <- rState <$> getState
277+ RoffState {fontKind = fk} <- getState
284278 return fk
285279
286280
@@ -328,6 +322,11 @@ mmacro mk = msatisfy isMMacro where
328322 | otherwise = False
329323 isMMacro _ = False
330324
325+mmacroAny :: PandocMonad m => ManCompiler m ManToken
326+mmacroAny = msatisfy isMMacro where
327+ isMMacro (MMacro _ _) = True
328+ isMMacro _ = False
329+
331330munknownMacro :: PandocMonad m => ManCompiler m ManToken
332331munknownMacro = msatisfy isMUnknownMacro where
333332 isMUnknownMacro (MUnknownMacro _ _) = True
@@ -352,11 +351,11 @@ compileTitle = do
352351 modifyState (changeTitle mantitle)
353352 return $ Header 1 nullAttr [Str mantitle]
354353 where
355− changeTitle title mst@ManState{ pState = pst} =
354+ changeTitle title pst =
356355 let meta = stateMeta pst
357356 metaUp = Meta $ insert "title" (MetaString title) (unMeta meta)
358357 in
359− mst { pState = pst {stateMeta = metaUp} }
358+ pst {stateMeta = metaUp}
360359
361360compileSkippedContent :: PandocMonad m => ManCompiler m Block
362361compileSkippedContent = do
@@ -380,7 +379,7 @@ strToInline s ItalicBold = Strong [Emph [Str s]]
380379
381380compilePara :: PandocMonad m => ManCompiler m Block
382381compilePara = do
383− inls <- many1 (strInl <|> lineInl)
382+ inls <- many1 (strInl <|> lineInl <|> comment)
384383 let withspaces = intersperse [Str " "] inls
385384 return $ Para (concat withspaces)
386385
@@ -395,3 +394,31 @@ compilePara = do
395394 lineInl = do
396395 (MLine fragments) <- mline
397396 return $ fmap (\(s,f) -> strToInline s f) fragments
397+
398+ comment :: PandocMonad m => ManCompiler m [Inline]
399+ comment = mcomment >> return []
400+
401+
402+compileCodeBlock :: PandocMonad m => ManCompiler m Block
403+compileCodeBlock = do
404+ mmacro KCodeBlStart
405+ toks <- many (mstr <|> mline <|> mlink <|> memplyLine <|> munknownMacro <|> mcomment)
406+ mmacro KCodeBlEnd
407+ return $ CodeBlock nullAttr (intercalate "\n" . catMaybes $ extractText <$> toks)
408+
409+ where
410+
411+ extractText :: ManToken -> Maybe String
412+ extractText (MStr s _) = Just s
413+ extractText (MLine ss) = Just . intercalate " " $ map fst ss
414+ extractText (MLink s _) = Just s
415+ extractText MEmptyLine = Just "" -- string are intercalated with '\n', this prevents double '\n'
416+ extractText _ = Nothing
417+
418+compileHeader :: PandocMonad m => ManCompiler m Block
419+compileHeader = do
420+ (MHeader lvl s) <- mheader
421+ return $ Header lvl nullAttr [Str s]
422+
423+compileSkipMacro :: PandocMonad m => ManCompiler m Block
424+compileSkipMacro = mmacroAny >> return Null