d8c51ad · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

states, code block compiling

d8c51adYan Pas8 years ago

src/Text/Pandoc/Readers/Man.hs+62−35

compare with master

unifiedsplit

@@ -41,7 +41,7 @@ import Data.Maybe (isJust, catMaybes)

41import Data.List (intersperse, intercalate)

42import qualified Data.Text as T

44−import Text.Pandoc.Class (PandocMonad(..), runPure, runIOorExplode)

44+import Text.Pandoc.Class (PandocMonad(..), runIOorExplode)

45import Text.Pandoc.Definition

46import Text.Pandoc.Error (PandocError (PandocParsecError))

47import Text.Pandoc.Logging (LogMessage(..))

@@ -69,7 +69,7 @@ data ManToken = MStr String FontKind

69 | MLine [(String, FontKind)]

70 | MLink String Target

71 | MEmptyLine

72− | MHeader Integer String

72+ | MHeader Int String

73 | MMacro MacroKind [String]

74 | MUnknownMacro String [String]

75 | MComment String

@@ -80,25 +80,18 @@ data EscapeThing = EFont FontKind

80 | ENothing

81 deriving Show

83−data RoffState = RoffState { inCodeBlock :: Bool

84− , fontKind :: FontKind

83+data RoffState = RoffState { fontKind :: FontKind

85 } deriving Show

84 } deriving Show

87instance Default RoffState where

86instance Default RoffState where

88− def = RoffState {inCodeBlock = False, fontKind = Regular}

87+ def = RoffState {fontKind = Regular}

90−data ManState = ManState {pState :: ParserState, rState :: RoffState}

91−

92−type ManParser m = ParserT [Char] ManState m

89+type ManParser m = ParserT [Char] RoffState m

93−type ManCompiler m = ParserT [ManToken] ManState m

90+type ManCompiler m = ParserT [ManToken] ParserState m

94−

95−instance HasLogMessages ManState where

96− addLogMessage lm mst = mst {pState = addLogMessage lm (pState mst)}

97− getLogMessages mst = getLogMessages $ pState mst

99----

92----

100−testStrr :: [Char] -> Either PandocError Pandoc

93+-- testStrr :: [Char] -> Either PandocError Pandoc

101−testStrr s = runPure $ readMan def (T.pack s)

94+-- testStrr s = runPure $ readMan def (T.pack s)

102

103printPandoc :: Pandoc -> [Char]

96printPandoc :: Pandoc -> [Char]

104printPandoc (Pandoc m content) =

97printPandoc (Pandoc m content) =

@@ -106,10 +99,10 @@ printPandoc (Pandoc m content) =

106 cnt = intercalate "\n" $ map show content

99 cnt = intercalate "\n" $ map show content

107 in ttl ++ "\n" ++ cnt

100 in ttl ++ "\n" ++ cnt

108

101

109−strrepr :: Either PandocError Pandoc -> [Char]

102+-- strrepr :: Either PandocError Pandoc -> [Char]

110−strrepr obj = case obj of

103+-- strrepr obj = case obj of

111− Right x -> printPandoc x

104+-- Right x -> printPandoc x

112− Left y -> show y

105+-- Left y -> show y

113

106

114testFile :: FilePath -> IO ()

107testFile :: FilePath -> IO ()

115testFile fname = do

108testFile fname = do

@@ -122,10 +115,10 @@ testFile fname = do

122-- | Read man (troff) from an input string and return a Pandoc document.

115-- | Read man (troff) from an input string and return a Pandoc document.

123readMan :: PandocMonad m => ReaderOptions -> T.Text -> m Pandoc

116readMan :: PandocMonad m => ReaderOptions -> T.Text -> m Pandoc

124readMan opts txt = do

117readMan opts txt = do

125− let state = ManState { pState = def{ stateOptions = opts }, rState = def}

126− eithertokens <- readWithM parseMan state (T.unpack $ crFilter txt)

118+ eithertokens <- readWithM parseMan def (T.unpack $ crFilter txt)

127 case eithertokens of

119 case eithertokens of

128 Right tokenz -> do

120 Right tokenz -> do

121+ let state = def {stateOptions = opts} :: ParserState

129 eitherdoc <- readWithMTokens compileMan state tokenz

122 eitherdoc <- readWithMTokens compileMan state tokenz

130 case eitherdoc of

123 case eitherdoc of

131 Right doc -> return doc

124 Right doc -> return doc

@@ -135,8 +128,8 @@ readMan opts txt = do

135 where

128 where

136

129

137 readWithMTokens :: PandocMonad m

130 readWithMTokens :: PandocMonad m

138− => ParserT [ManToken] ManState m a -- ^ parser

131+ => ParserT [ManToken] ParserState m a -- ^ parser

139− -> ManState -- ^ initial state

132+ -> ParserState -- ^ initial state

140 -> [ManToken] -- ^ input

133 -> [ManToken] -- ^ input

141 -> m (Either PandocError a)

134 -> m (Either PandocError a)

142 readWithMTokens parser state input =

135 readWithMTokens parser state input =

@@ -155,15 +148,16 @@ parseMan = many (parseMacro <|> parseLine <|> parseEmptyLine)

155

148

156compileMan :: PandocMonad m => ManCompiler m Pandoc

149compileMan :: PandocMonad m => ManCompiler m Pandoc

157compileMan = do

150compileMan = do

158− let compilers = [compileTitle, compilePara, compileSkippedContent]

151+ let compilers = [compileTitle, compilePara, compileSkippedContent

152+ , compileCodeBlock, compileHeader, compileSkipMacro]

159 blocks <- many $ choice compilers

153 blocks <- many $ choice compilers

160− parserst <- pState <$> getState

154+ parserst <- getState

161− return $ Pandoc (stateMeta parserst) blocks

155+ return $ Pandoc (stateMeta parserst) (filter (not . isNull) blocks)

156+

157+ where

162

158

163−modifyRoffState :: PandocMonad m => (RoffState -> RoffState) -> ParsecT a ManState m ()

159+ isNull Null = True

164−modifyRoffState f = do

160+ isNull _ = False

165− mst <- getState

166− setState mst { rState = f $ rState mst }

167

161

168parseMacro :: PandocMonad m => ManParser m ManToken

162parseMacro :: PandocMonad m => ManParser m ManToken

169parseMacro = do

163parseMacro = do

@@ -253,7 +247,7 @@ escapeParser = do

253 , string "[]" >> return Regular

247 , string "[]" >> return Regular

254 , char '[' >> many1 letter >> char ']' >> return Regular

248 , char '[' >> many1 letter >> char ']' >> return Regular

255 ]

249 ]

256− modifyRoffState (\r -> r {fontKind = font})

250+ modifyState (\r -> r {fontKind = font})

257 return $ EFont font

251 return $ EFont font

258

252

259parseLine :: PandocMonad m => ManParser m ManToken

253parseLine :: PandocMonad m => ManParser m ManToken

@@ -280,7 +274,7 @@ parseLine = do

280

274

281 currentFont :: PandocMonad m => ManParser m FontKind

275 currentFont :: PandocMonad m => ManParser m FontKind

282 currentFont = do

276 currentFont = do

283− RoffState {fontKind = fk} <- rState <$> getState

277+ RoffState {fontKind = fk} <- getState

284 return fk

278 return fk

285

279

286

280

@@ -328,6 +322,11 @@ mmacro mk = msatisfy isMMacro where

328 | otherwise = False

322 | otherwise = False

329 isMMacro _ = False

323 isMMacro _ = False

330

324

325+mmacroAny :: PandocMonad m => ManCompiler m ManToken

326+mmacroAny = msatisfy isMMacro where

327+ isMMacro (MMacro _ _) = True

328+ isMMacro _ = False

329+

331munknownMacro :: PandocMonad m => ManCompiler m ManToken

330munknownMacro :: PandocMonad m => ManCompiler m ManToken

332munknownMacro = msatisfy isMUnknownMacro where

331munknownMacro = msatisfy isMUnknownMacro where

333 isMUnknownMacro (MUnknownMacro _ _) = True

332 isMUnknownMacro (MUnknownMacro _ _) = True

@@ -352,11 +351,11 @@ compileTitle = do

352 modifyState (changeTitle mantitle)

351 modifyState (changeTitle mantitle)

353 return $ Header 1 nullAttr [Str mantitle]

352 return $ Header 1 nullAttr [Str mantitle]

354 where

353 where

355− changeTitle title mst@ManState{ pState = pst} =

354+ changeTitle title pst =

356 let meta = stateMeta pst

355 let meta = stateMeta pst

357 metaUp = Meta $ insert "title" (MetaString title) (unMeta meta)

356 metaUp = Meta $ insert "title" (MetaString title) (unMeta meta)

358 in

357 in

359− mst { pState = pst {stateMeta = metaUp} }

358+ pst {stateMeta = metaUp}

360

359

361compileSkippedContent :: PandocMonad m => ManCompiler m Block

360compileSkippedContent :: PandocMonad m => ManCompiler m Block

362compileSkippedContent = do

361compileSkippedContent = do

@@ -380,7 +379,7 @@ strToInline s ItalicBold = Strong [Emph [Str s]]

380

379

381compilePara :: PandocMonad m => ManCompiler m Block

380compilePara :: PandocMonad m => ManCompiler m Block

382compilePara = do

381compilePara = do

383− inls <- many1 (strInl <|> lineInl)

382+ inls <- many1 (strInl <|> lineInl <|> comment)

384 let withspaces = intersperse [Str " "] inls

383 let withspaces = intersperse [Str " "] inls

385 return $ Para (concat withspaces)

384 return $ Para (concat withspaces)

386

385

@@ -395,3 +394,31 @@ compilePara = do

395 lineInl = do

394 lineInl = do

396 (MLine fragments) <- mline

395 (MLine fragments) <- mline

397 return $ fmap (\(s,f) -> strToInline s f) fragments

396 return $ fmap (\(s,f) -> strToInline s f) fragments

397+

398+ comment :: PandocMonad m => ManCompiler m [Inline]

399+ comment = mcomment >> return []

400+

401+

402+compileCodeBlock :: PandocMonad m => ManCompiler m Block

403+compileCodeBlock = do

404+ mmacro KCodeBlStart

406+ mmacro KCodeBlEnd

407+ return $ CodeBlock nullAttr (intercalate "\n" . catMaybes $ extractText <$> toks)

408+

409+ where

410+

411+ extractText :: ManToken -> Maybe String

412+ extractText (MStr s _) = Just s

413+ extractText (MLine ss) = Just . intercalate " " $ map fst ss

414+ extractText (MLink s _) = Just s

415+ extractText MEmptyLine = Just "" -- string are intercalated with '\n', this prevents double '\n'

416+ extractText _ = Nothing

417+

418+compileHeader :: PandocMonad m => ManCompiler m Block

419+compileHeader = do

420+ (MHeader lvl s) <- mheader

421+ return $ Header lvl nullAttr [Str s]

422+

423+compileSkipMacro :: PandocMonad m => ManCompiler m Block

424+compileSkipMacro = mmacroAny >> return Null