T.P.Readers.Groff: use FontSpec, not list of FontKind.

2 files changed, 36 insertions, 25 deletions

diff --git a/src/Text/Pandoc/Readers/Groff.hs b/src/Text/Pandoc/Readers/Groff.hs
index 94cc96b24..e63272682 100644
--- a/src/Text/Pandoc/Readers/Groff.hs
+++ b/src/Text/Pandoc/Readers/Groff.hs
@@ -32,8 +32,9 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 Tokenizer for groff formats (man, ms).
 -}
 module Text.Pandoc.Readers.Groff
-  ( FontKind(..)
-  , MacroKind
+  ( MacroKind
+  , FontSpec(..)
+  , defaultFontSpec
   , LinePart(..)
   , Arg
   , ManToken(..)
@@ -72,12 +73,18 @@ import qualified Data.Text.Normalize as Normalize
 --
 -- Data Types
 --
-data FontKind = Bold | Italic | Monospace | Regular deriving (Show, Eq, Ord)
+data FontSpec = FontSpec{ fontBold      :: Bool
+                        , fontItalic    :: Bool
+                        , fontMonospace :: Bool
+                        } deriving (Show, Eq, Ord)
+
+defaultFontSpec :: FontSpec
+defaultFontSpec = FontSpec False False False
 
 type MacroKind = String
 
 data LinePart = RoffStr String
-              | Font [FontKind]
+              | Font FontSpec
               | FontSize Int
               | MacroArg Int
               deriving Show
@@ -97,7 +104,8 @@ newtype ManTokens = ManTokens { unManTokens :: Seq.Seq ManToken }
 singleTok :: ManToken -> ManTokens
 singleTok t = ManTokens (Seq.singleton t)
 
-data RoffState = RoffState { customMacros  :: M.Map String ManTokens
+data RoffState = RoffState { customMacros :: M.Map String ManTokens
+                           , lastFont     :: FontSpec
                            } deriving Show
 
 instance Default RoffState where
@@ -109,6 +117,7 @@ instance Default RoffState where
                        , ("lq", "\x201C")
                        , ("rq", "\x201D")
                        , ("R",  "\x00AE") ]
+                  , lastFont = defaultFontSpec
                   }
 
 type ManLexer m = ParserT [Char] RoffState m
@@ -245,29 +254,32 @@ escFontSize = do
 escFont :: PandocMonad m => ManLexer m [LinePart]
 escFont = do
   font <- choice
-        [ char 'S' >> return [Regular]
-        , digit >> return [Regular]
-        , (:[]) <$> letterFontKind
-        , char '(' >> anyChar >> anyChar >> return [Regular]
+        [ char 'S' >> return defaultFontSpec
+        , digit >> return defaultFontSpec
+        , char '(' >> anyChar >> anyChar >> return defaultFontSpec
+        , digit >> return defaultFontSpec
+        , ($ defaultFontSpec) <$> letterFontKind
         , lettersFont
-        , digit >> return [Regular]
         ]
+  modifyState $ \st -> st{ lastFont = font }
   return [Font font]
 
-lettersFont :: PandocMonad m => ManLexer m [FontKind]
+lettersFont :: PandocMonad m => ManLexer m FontSpec
 lettersFont = try $ do
   char '['
   fs <- many letterFontKind
   skipMany letter
   char ']'
-  return fs
+  if null fs
+     then lastFont <$> getState
+     else return $ foldr ($) defaultFontSpec fs
 
-letterFontKind :: PandocMonad m => ManLexer m FontKind
+letterFontKind :: PandocMonad m => ManLexer m (FontSpec -> FontSpec)
 letterFontKind = choice [
-    oneOf ['B','b'] >> return Bold
-  , oneOf ['I','i'] >> return Italic
-  , oneOf ['C','c'] >> return Monospace
-  , oneOf ['P','p','R','r'] >> return Regular
+    oneOf ['B','b'] >> return (\fs -> fs{ fontBold = True })
+  , oneOf ['I','i'] >> return (\fs -> fs { fontItalic = True })
+  , oneOf ['C','c'] >> return (\fs -> fs { fontMonospace = True })
+  , oneOf ['P','p','R','r'] >> return id
   ]
 
 
diff --git a/src/Text/Pandoc/Readers/Man.hs b/src/Text/Pandoc/Readers/Man.hs
index 4fefb0e66..d7e65abec 100644
--- a/src/Text/Pandoc/Readers/Man.hs
+++ b/src/Text/Pandoc/Readers/Man.hs
@@ -174,16 +174,15 @@ parseTitle = do
   return mempty
 
 linePartsToInlines :: [LinePart] -> Inlines
-linePartsToInlines = go []
+linePartsToInlines = go
 
   where
-  go :: [[FontKind]] -> [LinePart] -> Inlines
-  go _ [] = mempty
-  go fs (MacroArg _:xs) = go fs xs -- shouldn't happen
-  go fs (RoffStr s : xs) = text s <> go fs xs
-  go (_:fs) (Font [] : xs) = go fs xs -- return to previous font
-  go fs (Font _newfonts : xs) = go fs xs
-  go fonts (FontSize _fs : xs) = go fonts xs
+  go :: [LinePart] -> Inlines
+  go [] = mempty
+  go (MacroArg _:xs) = go xs -- shouldn't happen
+  go (RoffStr s : xs) = text s <> go xs
+  go (Font _newfonts : xs) = go xs
+  go (FontSize _fs : xs) = go xs
 
 parsePara :: PandocMonad m => ManParser m Blocks
 parsePara = para . trimInlines <$> parseInlines