@@ -1,7 +1,4 @@
11{-# LANGUAGE FlexibleContexts #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
4−{-# LANGUAGE StandaloneDeriving #-}
52{-# LANGUAGE GeneralizedNewtypeDeriving #-}
63{-
74 Copyright (C) 2018 Yan Pashkovsky <yanp.bugz@gmail.com>
@@ -51,9 +48,8 @@ where
5148
5249import Prelude
5350import Safe (lastDef)
54−import Control.Monad (void, mzero, mplus, guard)
51+import Control.Monad (void, mzero, mplus)
5552import Control.Monad.Except (throwError)
56−import Control.Monad.State (StateT(..), evalStateT, get, modify, put)
5753import Text.Pandoc.Class
5854 (getResourcePath, readFileFromDirs, PandocMonad(..), report)
5955import Data.Char (isLower, toLower, toUpper, chr,
@@ -121,7 +117,8 @@ data RoffMode = NormalMode
121117 | CopyMode
122118 deriving Show
123119
124−data RoffState = RoffState { prevFont :: FontSpec
120+data RoffState = RoffState { customMacros :: M.Map String RoffTokens
121+ , prevFont :: FontSpec
125122 , currentFont :: FontSpec
126123 , tableTabChar :: Char
127124 , roffMode :: RoffMode
@@ -129,17 +126,7 @@ data RoffState = RoffState { prevFont :: FontSpec
129126 } deriving Show
130127
131128instance Default RoffState where
132− def = RoffState { prevFont = defaultFontSpec
133− , currentFont = defaultFontSpec
134− , tableTabChar = '\t'
135− , roffMode = NormalMode
136− , lastExpression = Nothing
137− }
138−
139−type MacroState = M.Map String RoffTokens
140−
141−initialMacroState :: MacroState
142−initialMacroState = M.fromList
129+ def = RoffState { customMacros = M.fromList
143130 $ map (\(n, s) ->
144131 (n, singleTok
145132 (TextLine [RoffStr s])))
@@ -147,19 +134,14 @@ initialMacroState = M.fromList
147134 , ("lq", "\x201C")
148135 , ("rq", "\x201D")
149136 , ("R", "\x00AE") ]
137+ , prevFont = defaultFontSpec
138+ , currentFont = defaultFontSpec
139+ , tableTabChar = '\t'
140+ , roffMode = NormalMode
141+ , lastExpression = Nothing
142+ }
150143
151−newtype RoffStream = RoffStream{ unRoffStream :: [Char] }
152− deriving (Show)
153−
154−deriving instance Semigroup RoffStream
155−deriving instance Monoid RoffStream
156−
157−instance Monad m => Stream RoffStream (StateT MacroState m) Char
158− where
159− uncons (RoffStream []) = return Nothing
160− uncons (RoffStream (c:cs)) = return (Just (c, RoffStream cs))
161−
162−type RoffLexer m = ParserT RoffStream RoffState (StateT MacroState m)
144+type RoffLexer m = ParserT [Char] RoffState m
163145
164146--
165147-- Lexer: String -> RoffToken
@@ -230,14 +212,14 @@ readUnicodeChar _ = Nothing
230212escapeNormal :: PandocMonad m => RoffLexer m [LinePart]
231213escapeNormal = do
232214 c <- anyChar
233− (case c of
215+ case c of
234216 ' ' -> return [RoffStr " "]
235217 '"' -> mempty <$ skipMany (satisfy (/='\n')) -- line comment
236218 '#' -> mempty <$ manyTill anyChar newline
237219 '%' -> return mempty -- optional hyphenation
238220 '&' -> return mempty -- nonprintable zero-width
239221 ')' -> return mempty -- nonprintable zero-width
240− '*' -> escString <|> escIgnore '*' []
222+ '*' -> escString
241223 ',' -> return mempty -- to fix spacing after roman
242224 '-' -> return [RoffStr "-"]
243225 '.' -> return [RoffStr "`"]
@@ -301,7 +283,7 @@ escapeNormal = do
301283 CopyMode -> char '\\'
302284 NormalMode -> return '\\'
303285 return [RoffStr "\\"]
304− _ -> return [RoffStr [c]]) <|> escIgnore c []
286+ _ -> return [RoffStr [c]]
305287 -- man 7 groff: "If a backslash is followed by a character that
306288 -- does not constitute a defined escape sequence, the backslash
307289 -- is silently ignored and the character maps to itself."
@@ -312,8 +294,7 @@ escIgnore :: PandocMonad m
312294 -> RoffLexer m [LinePart]
313295escIgnore c argparsers = do
314296 pos <- getPosition
315− pos' <- (optional (choice argparsers) >> getPosition)
316− arg <- manyTill anyChar (getPosition >>= guard . (== pos'))
297+ arg <- snd <$> withRaw (choice argparsers) <|> return ""
317298 report $ SkippedContent ('\\':c:arg) pos
318299 return mempty
319300
@@ -515,20 +496,17 @@ lexConditional mname = do
515496 then fmap not . lastExpression <$> getState
516497 else expression
517498 skipMany spacetab
518− macros <- get -- save macro state, so we can reset it
519− st <- getState
499+ st <- getState -- save state, so we can reset it
520500 ifPart <- lexGroup
521501 <|> (char '\\' >> newline >> manToken)
522502 <|> manToken
523503 case mbtest of
524504 Nothing -> do
525− put macros -- reset state, so we don't record macros in skipped section
526− putState st
505+ putState st -- reset state, so we don't record macros in skipped section
527506 report $ SkippedContent ('.':mname) pos
528507 return mempty
529508 Just True -> return ifPart
530509 Just False -> do
531− put macros
532510 putState st
533511 return mempty
534512
@@ -565,14 +543,14 @@ lexIncludeFile args = do
565543 result <- readFileFromDirs dirs fp
566544 case result of
567545 Nothing -> report $ CouldNotLoadIncludeFile fp pos
568− Just s -> getInput >>= setInput . (RoffStream s <>) -- TODO sourcepos!
546+ Just s -> getInput >>= setInput . (s ++)
569547 return mempty
570548 [] -> return mempty
571549
572550resolveMacro :: PandocMonad m
573551 => String -> [Arg] -> SourcePos -> RoffLexer m RoffTokens
574552resolveMacro macroName args pos = do
575− macros <- get
553+ macros <- customMacros <$> getState
576554 case M.lookup macroName macros of
577555 Nothing -> return $ singleTok $ ControlLine macroName args pos
578556 Just ts -> do
@@ -593,7 +571,8 @@ lexStringDef args = do -- string definition
593571 (x:ys) -> do
594572 let ts = singleTok $ TextLine (intercalate [RoffStr " " ] ys)
595573 let stringName = linePartsToString x
596− modify (M.insert stringName ts)
574+ modifyState $ \st ->
575+ st{ customMacros = M.insert stringName ts (customMacros st) }
597576 return mempty
598577
599578lexMacroDef :: PandocMonad m => [Arg] -> RoffLexer m RoffTokens
@@ -612,8 +591,9 @@ lexMacroDef args = do -- macro definition
612591 _ <- lexArgs
613592 return ()
614593 ts <- mconcat <$> manyTill manToken stop
615− modify (M.insert macroName ts)
616− modifyState $ \st -> st{ roffMode = NormalMode }
594+ modifyState $ \st ->
595+ st{ customMacros = M.insert macroName ts (customMacros st)
596+ , roffMode = NormalMode }
617597 return mempty
618598
619599lexArgs :: PandocMonad m => RoffLexer m [Arg]
@@ -655,7 +635,7 @@ lexArgs = do
655635
656636checkDefined :: PandocMonad m => String -> RoffLexer m [LinePart]
657637checkDefined name = do
658− macros <- get
638+ macros <- customMacros <$> getState
659639 case M.lookup name macros of
660640 Just _ -> return [RoffStr "1"]
661641 Nothing -> return [RoffStr "0"]
@@ -749,12 +729,8 @@ linePartsToString = mconcat . map go
749729-- | Tokenize a string as a sequence of roff tokens.
750730lexRoff :: PandocMonad m => SourcePos -> T.Text -> m RoffTokens
751731lexRoff pos txt = do
752− eithertokens <- evalStateT
753− (readWithM
754− (do setPosition pos
755− mconcat <$> many manToken) def
756− (RoffStream (T.unpack txt)))
757− initialMacroState
732+ eithertokens <- readWithM (do setPosition pos
733+ mconcat <$> many manToken) def (T.unpack txt)
758734 case eithertokens of
759735 Left e -> throwError e
760736 Right tokenz -> return tokenz