@@ -1,3 +1,4 @@
1+{-# LANGUAGE FlexibleContexts #-}
12{-
23 Copyright (C) 2018 Yan Pashkovsky <yanp.bugz@gmail.com>
34
@@ -65,6 +66,9 @@ data MacroKind = KTitle
6566 | KTabEnd
6667 deriving (Show, Eq)
6768
69+-- TODO header strings
70+-- TODO remove MStr
71+-- TODO filter skipped content
6872data ManToken = MStr String FontKind
6973 | MLine [(String, FontKind)]
7074 | MMaybeLink String
@@ -159,14 +163,59 @@ parseMan = do
159163 isNull Null = True
160164 isNull _ = False
161165
162−eofline :: PandocMonad m => ManLexer m ()
166+eofline :: Stream s m Char => ParsecT s u m ()
163167eofline = (newline >> return ()) <|> eof
164168
165−-- TODO escape characters in arguments
169+spacetab :: Stream s m Char => ParsecT s u m Char
170+spacetab = char ' ' <|> char '\t'
171+
172+-- TODO handle more cases
173+escapeLexer :: PandocMonad m => ManLexer m EscapeThing
174+escapeLexer = do
175+ char '\\'
176+ choice [escChar, escFont]
177+ where
178+
179+ escChar :: PandocMonad m => ManLexer m EscapeThing
180+ escChar =
181+ let skipSeqs = ["%", "{", "}", "&"]
182+ subsSeqs = [ ("-", '-'), (" ", ' '), ("\\", '\\'), ("[lq]", '“'), ("[rq]", '”')
183+ , ("[em]", '—'), ("[en]", '–') ]
184+ substitute :: PandocMonad m => (String,Char) -> ManLexer m EscapeThing
185+ substitute (from,to) = try $ string from >> return (EChar to)
186+ skip :: PandocMonad m => String -> ManLexer m EscapeThing
187+ skip seq' = try $ string seq' >> return ENothing
188+ in choice $ (substitute <$> subsSeqs) ++
189+ (skip <$> skipSeqs) ++
190+ [ char '(' >> anyChar >> return ENothing
191+ , char '[' >> many alphaNum >> char ']' >> return ENothing
192+ ]
193+
194+ escFont :: PandocMonad m => ManLexer m EscapeThing
195+ escFont = do
196+ char 'f'
197+ font <- choice [ letterFont
198+ , char '(' >> anyChar >> anyChar >> return Regular
199+ , try (char '[' >> letterFont >>= \f -> char ']' >> return f)
200+ , try $ string "[BI]" >> return ItalicBold
201+ , char '[' >> many letter >> char ']' >> return Regular
202+ ]
203+ modifyState (\r -> r {fontKind = font})
204+ return $ EFont font
205+
206+ where
207+
208+ letterFont :: PandocMonad m => ManLexer m FontKind
209+ letterFont = choice [
210+ char 'B' >> return Bold
211+ , char 'I' >> return Italic
212+ , char 'P' >> return Regular
213+ ]
214+
166215lexMacro :: PandocMonad m => ManLexer m ManToken
167216lexMacro = do
168217 char '.' <|> char '\''
169− many space
218+ many spacetab
170219 macroName <- many1 (letter <|> oneOf ['\\', '"'])
171220 args <- lexArgs
172221 let joinedArgs = unwords args
@@ -175,6 +224,7 @@ lexMacro = do
175224 let tok = case macroName of
176225 x | x `elem` ["\\\"", "\\#"] -> MComment joinedArgs
177226 "TH" -> knownMacro KTitle
227+ "IP" -> knownMacro KTab
178228 "TP" -> knownMacro KTab
179229 "RE" -> knownMacro KTabEnd
180230 "nf" -> knownMacro KCodeBlStart
@@ -201,61 +251,28 @@ lexMacro = do
201251
202252 oneArg :: PandocMonad m => ManLexer m String
203253 oneArg = do
204− many1 $ char ' '
205− try quotedArg <|> plainArg
254+ many1 spacetab
255+ quotedArg <|> plainArg
206256
207257 plainArg :: PandocMonad m => ManLexer m String
208− plainArg = many1 $ noneOf " \t\n"
258+ plainArg = fmap catMaybes . many1 $ escChar <|> (Just <$> noneOf " \t\n")
209259
210260 quotedArg :: PandocMonad m => ManLexer m String
211261 quotedArg = do
212262 char '"'
213− val <- many1 quotedChar
263+ val <- catMaybes <$> many quotedChar
214264 char '"'
215265 return val
216266
217− quotedChar :: PandocMonad m => ManLexer m Char
218− quotedChar = noneOf "\"\n" <|> try (string "\"\"" >> return '"')
219−
220−-- TODO handle more cases
221−escapeLexer :: PandocMonad m => ManLexer m EscapeThing
222−escapeLexer = do
223− char '\\'
224− choice [escChar, escFont]
225− where
226−
227− escChar :: PandocMonad m => ManLexer m EscapeThing
228− escChar =
229− let skipChars = ['%', '{', '}', '&']
230− subsChars = [ ("-", '-'), (" ", ' '), ("\\", '\\'), ("[lq]", '“'), ("[rq]", '”')
231− , ("[em]", '—'), ("[en]", '–') ]
232− substitute :: PandocMonad m => (String,Char) -> ManLexer m EscapeThing
233− substitute (from,to) = try $ string from >> return (EChar to)
234− others = [ oneOf skipChars >> return ENothing
235− , char '[' >> many alphaNum >> char ']' >> return ENothing
236− ]
237− in choice $ (substitute <$> subsChars) ++ others
238−
239− escFont :: PandocMonad m => ManLexer m EscapeThing
240− escFont = do
241− char 'f'
242− font <- choice [ letterFont
243− , char '(' >> anyChar >> anyChar >> return Regular
244− , try (char '[' >> letterFont >>= \f -> char ']' >> return f)
245− , try $ string "[BI]" >> return ItalicBold
246− , char '[' >> many letter >> char ']' >> return Regular
247− ]
248− modifyState (\r -> r {fontKind = font})
249− return $ EFont font
250−
251− where
267+ quotedChar :: PandocMonad m => ManLexer m (Maybe Char)
268+ quotedChar = escChar <|> (Just <$> noneOf "\"\n") <|> (Just <$> try (string "\"\"" >> return '"'))
252269
253− letterFont :: PandocMonad m => ManLexer m FontKind
254− letterFont = choice [
255− char 'B' >> return Bold
256− , char 'I' >> return Italic
257− , char 'P' >> return Regular
258− ]
270+ escChar :: PandocMonad m => ManLexer m (Maybe Char)
271+ escChar = do
272+ ec <- escapeLexer
273+ case ec of
274+ (EChar c) -> return $ Just c
275+ _ -> return Nothing
259276
260277lexLine :: PandocMonad m => ManLexer m ManToken
261278lexLine = do
@@ -416,7 +433,7 @@ parsePara = do
416433 linkParser :: Parsec String () [Inline]
417434 linkParser = do
418435 mpage <- many1 (alphaNum <|> char '_')
419− space
436+ spacetab
420437 char '('
421438 mansect <- digit
422439 char ')'