aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers
diff options
context:
space:
mode:
authorYan Pas <yanp.bugz@gmail.com>2018-10-16 01:53:04 +0300
committerYan Pas <yanp.bugz@gmail.com>2018-10-16 01:53:04 +0300
commit1684e918b286fad89425d2d5f45b7d51b5f4ddf8 (patch)
tree5fd3229c419619d3ebd11c93e70f2a2490fe9ad4 /src/Text/Pandoc/Readers
parent2ca50e95b75312b16ca831287e654fb40732afcc (diff)
downloadpandoc-1684e918b286fad89425d2d5f45b7d51b5f4ddf8.tar.gz
font as a set of styles, mono font support
Diffstat (limited to 'src/Text/Pandoc/Readers')
-rw-r--r--src/Text/Pandoc/Readers/Man.hs63
1 files changed, 39 insertions, 24 deletions
diff --git a/src/Text/Pandoc/Readers/Man.hs b/src/Text/Pandoc/Readers/Man.hs
index ea5657b56..280acb9c4 100644
--- a/src/Text/Pandoc/Readers/Man.hs
+++ b/src/Text/Pandoc/Readers/Man.hs
@@ -38,7 +38,9 @@ import Control.Monad (liftM, void)
import Control.Monad.Except (throwError)
import Data.Char (isDigit, isUpper, isLower)
import Data.Default (Default)
+import Data.Functor (($>))
import Data.Map (insert)
+import Data.Set (Set, singleton, fromList, toList)
import Data.Maybe (catMaybes, fromMaybe, isNothing)
import Data.List (intersperse, intercalate)
import qualified Data.Text as T
@@ -57,8 +59,7 @@ import Text.Parsec.Pos (updatePosString)
--
-- Data Types
--
-
-data FontKind = Regular | Italic | Bold | ItalicBold deriving Show
+data FontKind = Bold | Italic | Monospace | Regular deriving (Show, Eq, Ord)
data MacroKind = KTitle
| KCodeBlStart
@@ -68,7 +69,9 @@ data MacroKind = KTitle
| KSubTab
deriving (Show, Eq)
-type RoffStr = (String, FontKind)
+type Font = Set FontKind
+
+type RoffStr = (String, Font)
data ManToken = MStr RoffStr
| MLine [RoffStr]
@@ -80,16 +83,16 @@ data ManToken = MStr RoffStr
| MComment String
deriving Show
-data EscapeThing = EFont FontKind
+data EscapeThing = EFont Font
| EChar Char
| ENothing
deriving Show
-data RoffState = RoffState { fontKind :: FontKind
+data RoffState = RoffState { fontKind :: Font
} deriving Show
instance Default RoffState where
- def = RoffState {fontKind = Regular}
+ def = RoffState {fontKind = singleton Regular}
type ManLexer m = ParserT [Char] RoffState m
type ManParser m = ParserT [ManToken] ParserState m
@@ -197,22 +200,29 @@ escapeLexer = do
escFont :: PandocMonad m => ManLexer m EscapeThing
escFont = do
char 'f'
- font <- choice [ letterFont
- , char '(' >> anyChar >> anyChar >> return Regular
- , try (char '[' >> letterFont >>= \f -> char ']' >> return f)
- , try $ string "[BI]" >> return ItalicBold
- , char '[' >> many letter >> char ']' >> return Regular
- , digit >> return Regular
+ font <- choice [ singleton <$> letterFontKind
+ , char '(' >> anyChar >> anyChar >> return (singleton Regular)
+ , try lettersFont
+ , digit >> return (singleton Regular)
]
modifyState (\r -> r {fontKind = font})
return $ EFont font
where
- letterFont :: PandocMonad m => ManLexer m FontKind
- letterFont = choice [
+ lettersFont :: PandocMonad m => ManLexer m Font
+ lettersFont = do
+ char '['
+ fs <- many letterFontKind
+ many letter
+ char ']'
+ return $ fromList fs
+
+ letterFontKind :: PandocMonad m => ManLexer m FontKind
+ letterFontKind = choice [
char 'B' >> return Bold
, char 'I' >> return Italic
+ , char 'C' >> return Monospace
, (char 'P' <|> char 'R') >> return Regular
]
@@ -223,7 +233,7 @@ escapeLexer = do
logOutput $ SkippedContent ("Unknown escape sequence \\" ++ [c]) pos
return ENothing
-currentFont :: PandocMonad m => ManLexer m FontKind
+currentFont :: PandocMonad m => ManLexer m Font
currentFont = fontKind <$> getState
-- separate function from lexMacro since real man files sometimes do not follow the rules
@@ -253,10 +263,10 @@ lexMacro = do
"RS" -> knownMacro KSubTab
"nf" -> knownMacro KCodeBlStart
"fi" -> knownMacro KCodeBlEnd
- "B" -> MStr (joinedArgs,Bold)
+ "B" -> MStr (joinedArgs, singleton Bold)
"BR" -> MMaybeLink joinedArgs
- x | x `elem` ["BI", "IB"] -> MStr (joinedArgs, ItalicBold)
- x | x `elem` ["I", "IR", "RI"] -> MStr (joinedArgs, Italic)
+ x | x `elem` ["BI", "IB"] -> MStr (joinedArgs, fromList [Italic, Bold])
+ x | x `elem` ["I", "IR", "RI"] -> MStr (joinedArgs, singleton Italic)
"SH" -> MHeader 2 args
"SS" -> MHeader 3 args
x | x `elem` [ "P", "PP", "LP", "sp"] -> MEmptyLine
@@ -314,7 +324,7 @@ lexLine = do
return $ MLine $ catMaybes lnparts
where
- esc :: PandocMonad m => ManLexer m (Maybe (String, FontKind))
+ esc :: PandocMonad m => ManLexer m (Maybe (String, Font))
esc = do
someesc <- escapeLexer
font <- currentFont
@@ -323,7 +333,7 @@ lexLine = do
_ -> Nothing
return rv
- linePart :: PandocMonad m => ManLexer m (Maybe (String, FontKind))
+ linePart :: PandocMonad m => ManLexer m (Maybe (String, Font))
linePart = do
lnpart <- many1 $ noneOf "\n\\"
font <- currentFont
@@ -424,10 +434,15 @@ parseSkippedContent = do
onToken _ = return ()
strToInline :: RoffStr -> Inline
-strToInline (s, Regular) = Str s
-strToInline (s, Italic) = Emph [Str s]
-strToInline (s, Bold) = Strong [Str s]
-strToInline (s, ItalicBold) = Strong [Emph [Str s]]
+strToInline (s, fonts) = inner $ toList fonts where
+ inner :: [FontKind] -> Inline
+ inner [] = Str s
+ inner (Bold:fs) = Strong [inner fs]
+ inner (Italic:fs) = Emph [inner fs]
+
+ -- Monospace goes after Bold and Italic in ordered set
+ inner (Monospace:_) = Code nullAttr s
+ inner (Regular:fs) = inner fs
parsePara :: PandocMonad m => ManParser m Block
parsePara = Para <$> parseInlines