83902ff · typeable/pandoc

35import Control.Monad.Except (throwError)

36import Data.Default (Default)

37import Data.Map (insert)

38−import Data.Maybe (isJust)

38+import Data.Maybe (isJust, maybeToList)

39import Data.List (intersperse, intercalate)

40import qualified Data.Text as T

41

109 macroName <- many1 (letter <|> oneOf ['\\', '"'])

110 args <- parseArgs

111 let joinedArgs = concat $ intersperse " " args

112+ let toBold = return $ Plain [Strong [Str joinedArgs]]

113+ let toBoldItalic = return $ Plain [Strong [Emph [Str joinedArgs]]]

114+ let toItalic = return $ Plain [Emph [Str joinedArgs]]

112 case macroName of

115 case macroName of

113 "\\\"" -> return Null -- comment

116 "\\\"" -> return Null -- comment

114− "TH" -> macroTitle (if null args then "" else head args)

117+ "TH" -> macroTitle (if null args then "" else head args) -- man-title

118+ "TP" -> return Null -- tab-indented paragraph

119+ "PP" -> return Null -- end of tab-indented paragraphs

115 "nf" -> macroCodeBlock True >> return Null

120 "nf" -> macroCodeBlock True >> return Null

116 "fi" -> macroCodeBlock False >> return Null

121 "fi" -> macroCodeBlock False >> return Null

117− "B" -> return $ Plain [Strong [Str joinedArgs]]

122+ "B" -> toBold

118− "BR" -> return $ Plain [Strong [Str joinedArgs]]

123+ "BR" -> return $ linkToMan joinedArgs

119− "BI" -> return $ Plain [Strong [Emph [Str joinedArgs]]]

124+ "BI" -> toBoldItalic

120− "I" -> return $ Plain [Emph [Str joinedArgs]]

125+ "IB" -> toBoldItalic

126+ "I" -> toItalic

127+ "IR" -> toItalic

128+ "RI" -> toItalic

121 "SH" -> return $ Header 2 nullAttr [Str joinedArgs]

129 "SH" -> return $ Header 2 nullAttr [Str joinedArgs]

122 "sp" -> return $ Plain [LineBreak]

130 "sp" -> return $ Plain [LineBreak]

123− _ -> unkownMacro macroName args

131+ _ -> unkownMacro macroName

124

132

125 where

133 where

126

134

131 then return Null

139 then return Null

132 else return $ Header 1 nullAttr [Str mantitle]

140 else return $ Header 1 nullAttr [Str mantitle]

133 where

141 where

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

142+ changeTitle title mst@ManState{ pState = pst} =

135 let meta = stateMeta pst

143 let meta = stateMeta pst

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

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

137 in

145 in

138 mst { pState = pst {stateMeta = metaUp} }

146 mst { pState = pst {stateMeta = metaUp} }

139

147

140−

141 macroCodeBlock :: PandocMonad m => Bool -> ManParser m ()

148 macroCodeBlock :: PandocMonad m => Bool -> ManParser m ()

142 macroCodeBlock insideCB = modifyRoffState (\rst -> rst{inCodeBlock = insideCB}) >> return ()

149 macroCodeBlock insideCB = modifyRoffState (\rst -> rst{inCodeBlock = insideCB}) >> return ()

150+

151+ linkToMan :: String -> Block

152+ linkToMan txt = case runParser linkParser () "" txt of

153+ Right lnk -> Plain [lnk]

154+ Left _ -> Plain [Emph [Str txt]]

155+ where

156+ linkParser :: Parsec String () Inline

157+ linkParser = do

158+ mpage <- many1 alphaNum

159+ space

160+ char '('

161+ mansect <- digit

162+ char ')'

163+ -- assuming man pages are generated from Linux-like repository

164+ let manurl pagename section = "../"++section++"/"++pagename++"."++section

165+ return $ Link nullAttr [Str txt] (manurl mpage [mansect], mpage)

166+

143

167

144− unkownMacro :: PandocMonad m => String -> [String] -> ManParser m Block

168+ unkownMacro :: PandocMonad m => String -> ManParser m Block

145− unkownMacro mname args = do

169+ unkownMacro mname = do

146 pos <- getPosition

170 pos <- getPosition

147 logMessage $ SkippedContent ("Unknown macro: " ++ mname) pos

171 logMessage $ SkippedContent ("Unknown macro: " ++ mname) pos

148− return $ Plain $ Str <$> args

172+ return Null

149

173

150 parseArgs :: PandocMonad m => ManParser m [String]

174 parseArgs :: PandocMonad m => ManParser m [String]

151 parseArgs = do

175 parseArgs = do

173 quotedChar :: PandocMonad m => ManParser m Char

197 quotedChar :: PandocMonad m => ManParser m Char

174 quotedChar = noneOf "\"\n" <|> try (string "\"\"" >> return '"')

198 quotedChar = noneOf "\"\n" <|> try (string "\"\"" >> return '"')

175

199

176−roffInline :: RoffState -> String -> (Maybe Inline)

200+roffInline :: RoffState -> String -> [Inline]

177roffInline rst str

201roffInline rst str

178− | null str = Nothing

202+ | null str = []

179− | inCodeBlock rst = Just $ Code nullAttr str

203+ | inCodeBlock rst = [Code nullAttr str, LineBreak]

180− | otherwise = Just $ case fontKind rst of

204+ | otherwise = case fontKind rst of

181− Regular -> Str str

205+ Regular -> [Str str]

182− Italic -> Emph [Str str]

206+ Italic -> [Emph [Str str]]

183− _ -> Strong [Str str]

207+ Bold -> [Strong [Str str]]

208+ ItalicBold -> [Emph [Strong [Str str]]]

184

209

185parseLine :: PandocMonad m => ManParser m Block

210parseLine :: PandocMonad m => ManParser m Block

186parseLine = do

211parseLine = do

187 parts <- parseLineParts

212 parts <- parseLineParts

188 newline

213 newline

189 return $ if null parts

214 return $ if null parts

190− then Plain [LineBreak]

215+ then Null

191 else Plain parts

216 else Plain parts

192 where

217 where

193 parseLineParts :: PandocMonad m => ManParser m [Inline]

218 parseLineParts :: PandocMonad m => ManParser m [Inline]

194 parseLineParts = do

219 parseLineParts = do

195 lnpart <- many $ noneOf "\n\\"

220 lnpart <- many $ noneOf "\n\\"

196 ManState {rState = roffSt} <- getState

221 ManState {rState = roffSt} <- getState

197− let inl = roffInline roffSt lnpart

222+ let inls = roffInline roffSt lnpart

198 others <- backSlash <|> return []

223 others <- backSlash <|> return []

199− return $ case inl of

200− Just x -> x:others

201− Nothing -> others

224+ return $ inls ++ others

202

225

203 backSlash :: PandocMonad m => ManParser m [Inline]

226 backSlash :: PandocMonad m => ManParser m [Inline]

204 backSlash = do

227 backSlash = do

205 char '\\'

228 char '\\'

206 esc <- choice [ char 'f' >> fEscape

229 esc <- choice [ char 'f' >> fEscape

207 , char '-' >> return (Just '-')

230 , char '-' >> return (Just '-')

231+ , char '%' >> return Nothing

208 , Just <$> noneOf "\n"

232 , Just <$> noneOf "\n"

209 ]

233 ]

210 ManState {rState = roffSt} <- getState

234 ManState {rState = roffSt} <- getState

211 case esc of

235 case esc of

212− Just c -> case roffInline roffSt [c] of

236+ Just c -> let inls = roffInline roffSt [c]

213− Just inl -> do

214− oth <- parseLineParts

215− return $ inl : oth

237+ in parseLineParts >>= (\oth -> return $ inls ++ oth)

216− Nothing -> parseLineParts

217 Nothing -> parseLineParts

238 Nothing -> parseLineParts

218 where

239 where

219

240

220 fEscape :: PandocMonad m => ManParser m (Maybe Char)

241 fEscape :: PandocMonad m => ManParser m (Maybe Char)

221 fEscape = choice [ char 'B' >> modifyRoffState (\rst -> rst {fontKind = Bold})

242 fEscape = choice [ char 'B' >> modifyRoffState (\rst -> rst {fontKind = Bold})

222 , char 'I' >> modifyRoffState (\rst -> rst {fontKind = Italic})

243 , char 'I' >> modifyRoffState (\rst -> rst {fontKind = Italic})

223− , char 'P' >> modifyRoffState (\rst -> rst {fontKind = Regular})

244+ , (char 'P' <|> anyChar) >> modifyRoffState (\rst -> rst {fontKind = Regular})

224 ]

245 ]

225 >> return Nothing

246 >> return Nothing

226−

247+

227−

248+createParas :: [Block] -> [Block]

249+createParas bs = inner bs [] where

250+ inner :: [Block] -> [Inline] -> [Block]

251+ inner [] inls = maybeToList $ inlinesToPara inls

252+ inner (Plain einls : oth) inls = inner oth (inls ++ einls)

253+ inner (block : oth) inls = case inlinesToPara inls of

254+ Just par -> par : block : inner oth []

255+ Nothing -> block : inner oth []

256+

257+ inlinesToPara :: [Inline] -> Maybe Block

258+ inlinesToPara [] = Nothing

259+ inlinesToPara inls = Just $ Para (intersperse (Str " ") inls)

260+

228

261

229parseMan :: PandocMonad m => ManParser m Pandoc

262parseMan :: PandocMonad m => ManParser m Pandoc

230parseMan = do

263parseMan = do

231− blocks <- many (parseMacro <|> parseLine)

264+ blocks <- createParas <$> many (parseMacro <|> parseLine)

232 parserst <- pState <$> getState

265 parserst <- pState <$> getState

233 return $ Pandoc (stateMeta parserst) blocks

266 return $ Pandoc (stateMeta parserst) blocks