git.iko.soy/typeable/pandoc
on master help sign in
Man reader: some support for custom macros.
f395455John MacFarlane
src/Text/Pandoc/Readers/Man.hs+39−17
compare with master
unifiedsplit
@@ -77,14 +77,24 @@ data ManToken = MStr RoffStr
77 | MEndMacro
77 | MEndMacro
78 deriving Show
78 deriving Show
79
79
80−data RoffState = RoffState { fontKind :: Font
80+data RoffState = RoffState { fontKind :: Font
81 } deriving Show
81 } deriving Show
82
82
83instance Default RoffState where
83instance Default RoffState where
84− def = RoffState {fontKind = singleton Regular}
84+ def = RoffState { fontKind = singleton Regular }
85+
86+data ManState = ManState { customMacros :: M.Map String Blocks
87+ , readerOptions :: ReaderOptions
88+ , metadata :: Meta
89+ } deriving Show
90+
91+instance Default ManState where
92+ def = ManState { customMacros = mempty
93+ , readerOptions = def
94+ , metadata = nullMeta }
85
95
86type ManLexer m = ParserT [Char] RoffState m
96type ManLexer m = ParserT [Char] RoffState m
87−type ManParser m = ParserT [ManToken] ParserState m
97+type ManParser m = ParserT [ManToken] ManState m
88
98
89
99
90-- | Read man (troff) from an input string and return a Pandoc document.
100-- | Read man (troff) from an input string and return a Pandoc document.
@@ -94,15 +104,15 @@ readMan opts txt = do
94 case eithertokens of
104 case eithertokens of
95 Left e -> throwError e
105 Left e -> throwError e
96 Right tokenz -> do
106 Right tokenz -> do
97− let state = def {stateOptions = opts} :: ParserState
107+ let state = def {readerOptions = opts} :: ManState
98 eitherdoc <- readWithMTokens parseMan state tokenz
108 eitherdoc <- readWithMTokens parseMan state tokenz
99 either throwError return eitherdoc
109 either throwError return eitherdoc
100
110
101 where
111 where
102
112
103 readWithMTokens :: PandocMonad m
113 readWithMTokens :: PandocMonad m
104− => ParserT [ManToken] ParserState m a -- ^ parser
114+ => ParserT [ManToken] ManState m a -- ^ parser
105− -> ParserState -- ^ initial state
115+ -> ManState -- ^ initial state
106 -> [ManToken] -- ^ input
116 -> [ManToken] -- ^ input
107 -> m (Either PandocError a)
117 -> m (Either PandocError a)
108 readWithMTokens parser state input =
118 readWithMTokens parser state input =
@@ -123,7 +133,7 @@ lexMan = many (lexComment <|> lexMacro <|> lexLine <|> lexEmptyLine)
123parseMan :: PandocMonad m => ManParser m Pandoc
133parseMan :: PandocMonad m => ManParser m Pandoc
124parseMan = do
134parseMan = do
125 bs <- many parseBlock <* eof
135 bs <- many parseBlock <* eof
126− meta <- stateMeta <$> getState
136+ meta <- metadata <$> getState
127 let (Pandoc _ blocks) = doc $ mconcat bs
137 let (Pandoc _ blocks) = doc $ mconcat bs
128 return $ Pandoc meta blocks
138 return $ Pandoc meta blocks
129
139
@@ -137,7 +147,7 @@ parseBlock = choice [ parseList
137 , parseCodeBlock
147 , parseCodeBlock
138 , parseHeader
148 , parseHeader
139 , parseMacroDef
149 , parseMacroDef
140− , parseSkipMacro
150+ , parseUnkownMacro
141 ]
151 ]
142
152
143eofline :: Stream s m Char => ParsecT s u m ()
153eofline :: Stream s m Char => ParsecT s u m ()
@@ -410,7 +420,7 @@ parseTitle = do
410 [x,y] -> setMeta "title" x . setMeta "section" y
420 [x,y] -> setMeta "title" x . setMeta "section" y
411 [x] -> setMeta "title" x
421 [x] -> setMeta "title" x
412 [] -> id
422 [] -> id
413− modifyState $ \st -> st{ stateMeta = adjustMeta $ stateMeta st }
423+ modifyState $ \st -> st{ metadata = adjustMeta $ metadata st }
414 return mempty
424 return mempty
415
425
416parseSkippedContent :: PandocMonad m => ManParser m Blocks
426parseSkippedContent :: PandocMonad m => ManParser m Blocks
@@ -570,9 +580,16 @@ parseDefinitionList = definitionList <$> many1 definitionListItem
570
580
571parseMacroDef :: PandocMonad m => ManParser m Blocks
581parseMacroDef :: PandocMonad m => ManParser m Blocks
572parseMacroDef = do
582parseMacroDef = do
573− MMacro _ _args <- mmacro "de"
583+ MMacro _ args <- mmacro "de"
584+ (macroName, endMacro') <-
585+ case args of
586+ ((x,_):(y,_):_) -> return (x, mmacro y) -- optional second arg
587+ ((x,_):_) -> return (x, endMacro)
588+ [] -> fail "No argument to .de"
574− bs <- manyTill parseBlock endMacro
589+ bs <- mconcat <$> manyTill parseBlock endMacro'
590+ modifyState $ \st ->
591+ st{ customMacros = M.insert macroName bs (customMacros st) }
575− return mempty -- TODO for now just skip it
592+ return mempty
576
593
577 where
594 where
578 endMacro = (msatisfy (\t -> case t of
595 endMacro = (msatisfy (\t -> case t of
@@ -580,11 +597,16 @@ parseMacroDef = do
580 _ -> False))
597 _ -> False))
581
598
582-- In case of weird man file it will be parsed succesfully
599-- In case of weird man file it will be parsed succesfully
583−parseSkipMacro :: PandocMonad m => ManParser m Blocks
600+parseUnkownMacro :: PandocMonad m => ManParser m Blocks
584−parseSkipMacro = do
601+parseUnkownMacro = do
585 pos <- getPosition
602 pos <- getPosition
586 tok <- mmacroAny
603 tok <- mmacroAny
587 case tok of
604 case tok of
605+ MMacro mkind _ -> do
606+ macros <- customMacros <$> getState
607+ case M.lookup mkind macros of
608+ Nothing -> do
588− MMacro mkind _ -> report $ SkippedContent ('.':mkind) pos
609+ report $ SkippedContent ('.':mkind) pos
589− _ -> return () -- shouldn't happen
610+ return mempty
590− return mempty
611+ Just bs -> return bs
612+ _ -> fail "the impossible happened"