git.iko.soy/typeable/pandoc
on master help sign in
FB2 reader: parse notes
c1d9cf7Alexander Krotov
src/Text/Pandoc/Readers/FB2.hs+51−3
compare with master
unifiedsplit
@@ -31,6 +31,7 @@ import Data.Char (isSpace, toUpper)
31import Data.Functor
31import Data.Functor
32import Data.List (dropWhileEnd, intersperse)
32import Data.List (dropWhileEnd, intersperse)
33import Data.List.Split (splitOn)
33import Data.List.Split (splitOn)
34+import qualified Data.Map as M
34import Data.Text (Text)
35import Data.Text (Text)
35import Data.Default
36import Data.Default
36import Data.Maybe
37import Data.Maybe
@@ -48,12 +49,14 @@ type FB2 m = StateT FB2State m
48data FB2State = FB2State{ fb2SectionLevel :: Int
49data FB2State = FB2State{ fb2SectionLevel :: Int
49 , fb2Meta :: Meta
50 , fb2Meta :: Meta
50 , fb2Authors :: [String]
51 , fb2Authors :: [String]
52+ , fb2Notes :: M.Map String Blocks
51 } deriving Show
53 } deriving Show
52
54
53instance Default FB2State where
55instance Default FB2State where
54 def = FB2State{ fb2SectionLevel = 1
56 def = FB2State{ fb2SectionLevel = 1
55 , fb2Meta = mempty
57 , fb2Meta = mempty
56 , fb2Authors = []
58 , fb2Authors = []
59+ , fb2Notes = M.empty
57 }
60 }
58
61
59instance HasMeta FB2State where
62instance HasMeta FB2State where
@@ -107,16 +110,56 @@ parseSubtitle e = headerWith ("", ["unnumbered"], []) <$> gets fb2SectionLevel <
107parseRootElement :: PandocMonad m => Element -> FB2 m Blocks
110parseRootElement :: PandocMonad m => Element -> FB2 m Blocks
108parseRootElement e =
111parseRootElement e =
109 case qName $ elName e of
112 case qName $ elName e of
113+ "FictionBook" -> do
114+ -- Parse notes before parsing the rest of the content.
115+ case filterChild isNotesBody e of
116+ Nothing -> pure ()
117+ Just notesBody -> parseNotesBody notesBody
118+ -- Parse metadata and content
110− "FictionBook" -> mconcat <$> mapM parseFictionBookChild (elChildren e)
119+ mconcat <$> mapM parseFictionBookChild (elChildren e)
111 name -> report (UnexpectedXmlElement name "root") $> mempty
120 name -> report (UnexpectedXmlElement name "root") $> mempty
112
121
122+-- | Parse notes
123+parseNotesBody :: PandocMonad m => Element -> FB2 m ()
124+parseNotesBody e = mempty <$ mapM parseNotesBodyChild (elChildren e)
125+
126+-- | Parse a child of @\<body name="notes">@ element.
127+parseNotesBodyChild :: PandocMonad m => Element -> FB2 m ()
128+parseNotesBodyChild e =
129+ case qName $ elName e of
130+ "section" -> parseNote e
131+ _ -> pure ()
132+
133+isNotesBody :: Element -> Bool
134+isNotesBody e =
135+ qName (elName e) == "body" &&
136+ findAttr (unqual "name") e == Just "notes"
137+
138+parseNote :: PandocMonad m => Element -> FB2 m ()
139+parseNote e =
140+ case findAttr (unqual "id") e of
141+ Nothing -> pure ()
142+ Just sectionId -> do
143+ content <- mconcat <$> mapM parseSectionChild (dropTitle $ elChildren e)
144+ oldNotes <- gets fb2Notes
145+ modify $ \s -> s { fb2Notes = M.insert ("#" ++ sectionId) content oldNotes }
146+ pure ()
147+ where
148+ isTitle x = qName (elName x) == "title"
149+ dropTitle (x:xs) = if isTitle x
150+ then xs -- Drop note section <title> if present
151+ else (x:xs)
152+ dropTitle [] = []
153+
113-- | Parse a child of @\<FictionBook>@ element.
154-- | Parse a child of @\<FictionBook>@ element.
114parseFictionBookChild :: PandocMonad m => Element -> FB2 m Blocks
155parseFictionBookChild :: PandocMonad m => Element -> FB2 m Blocks
115parseFictionBookChild e =
156parseFictionBookChild e =
116 case qName $ elName e of
157 case qName $ elName e of
117 "stylesheet" -> pure mempty -- stylesheet is ignored
158 "stylesheet" -> pure mempty -- stylesheet is ignored
118 "description" -> mempty <$ mapM_ parseDescriptionChild (elChildren e)
159 "description" -> mempty <$ mapM_ parseDescriptionChild (elChildren e)
160+ "body" -> if isNotesBody e
161+ then pure mempty
119− "body" -> mconcat <$> mapM parseBodyChild (elChildren e)
162+ else mconcat <$> mapM parseBodyChild (elChildren e)
120 "binary" -> mempty <$ parseBinaryElement e
163 "binary" -> mempty <$ parseBinaryElement e
121 name -> report (UnexpectedXmlElement name "FictionBook") $> mempty
164 name -> report (UnexpectedXmlElement name "FictionBook") $> mempty
122
165
@@ -333,8 +376,13 @@ parseNamedStyleChild x = parseInline x
333parseLinkType :: PandocMonad m => Element -> FB2 m Inlines
376parseLinkType :: PandocMonad m => Element -> FB2 m Inlines
334parseLinkType e = do
377parseLinkType e = do
335 content <- mconcat <$> mapM parseStyleLinkType (elContent e)
378 content <- mconcat <$> mapM parseStyleLinkType (elContent e)
379+ notes <- gets fb2Notes
336 case findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e of
380 case findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e of
381+ Just href -> case findAttr (QName "type" Nothing Nothing) e of
382+ Just "note" -> case M.lookup href notes of
383+ Nothing -> pure $ link href "" content
384+ Just contents -> pure $ note contents
337− Just href -> pure $ link href "" content
385+ _ -> pure $ link href "" content
338 Nothing -> throwError $ PandocParseError "Couldn't parse FB2 file: link without required href."
386 Nothing -> throwError $ PandocParseError "Couldn't parse FB2 file: link without required href."
339
387
340-- | Parse @styleLinkType@
388-- | Parse @styleLinkType@