hlint FB2 writer
This commit is contained in:
parent
d286363f97
commit
f1fbec938f
1 changed files with 22 additions and 27 deletions
|
@ -21,7 +21,7 @@ module Text.Pandoc.Writers.FB2 (writeFB2) where
|
||||||
import Prelude
|
import Prelude
|
||||||
import Control.Monad (zipWithM)
|
import Control.Monad (zipWithM)
|
||||||
import Control.Monad.Except (catchError)
|
import Control.Monad.Except (catchError)
|
||||||
import Control.Monad.State.Strict (StateT, evalStateT, get, lift, liftM, modify)
|
import Control.Monad.State.Strict (StateT, evalStateT, get, gets, lift, liftM, modify)
|
||||||
import Data.ByteString.Base64 (encode)
|
import Data.ByteString.Base64 (encode)
|
||||||
import qualified Data.ByteString.Char8 as B8
|
import qualified Data.ByteString.Char8 as B8
|
||||||
import Data.Char (isAscii, isControl, isSpace, toLower)
|
import Data.Char (isAscii, isControl, isSpace, toLower)
|
||||||
|
@ -104,7 +104,7 @@ description meta' = do
|
||||||
let as = authors meta'
|
let as = authors meta'
|
||||||
dd <- docdate meta'
|
dd <- docdate meta'
|
||||||
annotation <- case lookupMeta "abstract" meta' of
|
annotation <- case lookupMeta "abstract" meta' of
|
||||||
Just (MetaBlocks bs) -> (list . el "annotation") <$> cMapM blockToXml (map unPlain bs)
|
Just (MetaBlocks bs) -> list . el "annotation" <$> cMapM blockToXml (map unPlain bs)
|
||||||
_ -> pure mempty
|
_ -> pure mempty
|
||||||
let lang = case lookupMeta "lang" meta' of
|
let lang = case lookupMeta "lang" meta' of
|
||||||
Just (MetaInlines [Str s]) -> [el "lang" $ iso639 s]
|
Just (MetaInlines [Str s]) -> [el "lang" $ iso639 s]
|
||||||
|
@ -182,8 +182,8 @@ renderSection lvl (Shared.Sec _ _num (id',_,_) title elements) = do
|
||||||
else list . el "title" <$> formatTitle title
|
else list . el "title" <$> formatTitle title
|
||||||
let sectionContent = if null id'
|
let sectionContent = if null id'
|
||||||
then el "section" (title' ++ content)
|
then el "section" (title' ++ content)
|
||||||
else el "section" ([uattr "id" id'], (title' ++ content))
|
else el "section" ([uattr "id" id'], title' ++ content)
|
||||||
return $ [sectionContent]
|
return [sectionContent]
|
||||||
|
|
||||||
-- | Only <p> and <empty-line> are allowed within <title> in FB2.
|
-- | Only <p> and <empty-line> are allowed within <title> in FB2.
|
||||||
formatTitle :: PandocMonad m => [Inline] -> FBM m [Content]
|
formatTitle :: PandocMonad m => [Inline] -> FBM m [Content]
|
||||||
|
@ -290,6 +290,15 @@ isMimeType s =
|
||||||
footnoteID :: Int -> String
|
footnoteID :: Int -> String
|
||||||
footnoteID i = "n" ++ show i
|
footnoteID i = "n" ++ show i
|
||||||
|
|
||||||
|
mkitem :: PandocMonad m => String -> [Block] -> FBM m [Content]
|
||||||
|
mkitem mrk bs = do
|
||||||
|
pmrk <- gets parentListMarker
|
||||||
|
let nmrk = pmrk ++ mrk ++ " "
|
||||||
|
modify (\s -> s { parentListMarker = nmrk})
|
||||||
|
item <- cMapM blockToXml $ plainToPara $ indentBlocks nmrk bs
|
||||||
|
modify (\s -> s { parentListMarker = pmrk }) -- old parent marker
|
||||||
|
return item
|
||||||
|
|
||||||
-- | Convert a block-level Pandoc's element to FictionBook XML representation.
|
-- | Convert a block-level Pandoc's element to FictionBook XML representation.
|
||||||
blockToXml :: PandocMonad m => Block -> FBM m [Content]
|
blockToXml :: PandocMonad m => Block -> FBM m [Content]
|
||||||
blockToXml (Plain ss) = cMapM toXml ss -- FIXME: can lead to malformed FB2
|
blockToXml (Plain ss) = cMapM toXml ss -- FIXME: can lead to malformed FB2
|
||||||
|
@ -297,40 +306,26 @@ blockToXml (Para [Math DisplayMath formula]) = insertMath NormalImage formula
|
||||||
-- title beginning with fig: indicates that the image is a figure
|
-- title beginning with fig: indicates that the image is a figure
|
||||||
blockToXml (Para [Image atr alt (src,'f':'i':'g':':':tit)]) =
|
blockToXml (Para [Image atr alt (src,'f':'i':'g':':':tit)]) =
|
||||||
insertImage NormalImage (Image atr alt (src,tit))
|
insertImage NormalImage (Image atr alt (src,tit))
|
||||||
blockToXml (Para ss) = (list . el "p") <$> cMapM toXml ss
|
blockToXml (Para ss) = list . el "p" <$> cMapM toXml ss
|
||||||
blockToXml (CodeBlock _ s) = return . spaceBeforeAfter .
|
blockToXml (CodeBlock _ s) = return . spaceBeforeAfter .
|
||||||
map (el "p" . el "code") . lines $ s
|
map (el "p" . el "code") . lines $ s
|
||||||
blockToXml (RawBlock f str) = do
|
blockToXml (RawBlock f str) =
|
||||||
if f == Format "fb2"
|
if f == Format "fb2"
|
||||||
then return $ XI.parseXML str
|
then return $ XI.parseXML str
|
||||||
else return []
|
else return []
|
||||||
blockToXml (Div _ bs) = cMapM blockToXml bs
|
blockToXml (Div _ bs) = cMapM blockToXml bs
|
||||||
blockToXml (BlockQuote bs) = (list . el "cite") <$> cMapM blockToXml bs
|
blockToXml (BlockQuote bs) = list . el "cite" <$> cMapM blockToXml bs
|
||||||
blockToXml (LineBlock lns) =
|
blockToXml (LineBlock lns) =
|
||||||
(list . el "poem") <$> mapM stanza (split null lns)
|
list . el "poem" <$> mapM stanza (split null lns)
|
||||||
where
|
where
|
||||||
v xs = el "v" <$> cMapM toXml xs
|
v xs = el "v" <$> cMapM toXml xs
|
||||||
stanza xs = el "stanza" <$> mapM v xs
|
stanza xs = el "stanza" <$> mapM v xs
|
||||||
blockToXml (OrderedList a bss) = do
|
blockToXml (OrderedList a bss) =
|
||||||
state <- get
|
|
||||||
let pmrk = parentListMarker state
|
|
||||||
let markers = (pmrk ++) <$> orderedListMarkers a
|
|
||||||
let mkitem mrk bs = do
|
|
||||||
modify (\s -> s { parentListMarker = mrk ++ " "})
|
|
||||||
item <- cMapM blockToXml $ plainToPara $ indentBlocks (mrk ++ " ") bs
|
|
||||||
modify (\s -> s { parentListMarker = pmrk }) -- old parent marker
|
|
||||||
return item
|
|
||||||
concat <$> zipWithM mkitem markers bss
|
concat <$> zipWithM mkitem markers bss
|
||||||
blockToXml (BulletList bss) = do
|
where
|
||||||
state <- get
|
markers = orderedListMarkers a
|
||||||
let pmrk = parentListMarker state
|
blockToXml (BulletList bss) =
|
||||||
let mrk = pmrk ++ "•"
|
cMapM (mkitem "•") bss
|
||||||
let mkitem bs = do
|
|
||||||
modify (\s -> s { parentListMarker = mrk ++ " "})
|
|
||||||
item <- cMapM blockToXml $ plainToPara $ indentBlocks (mrk ++ " ") bs
|
|
||||||
modify (\s -> s { parentListMarker = pmrk }) -- old parent marker
|
|
||||||
return item
|
|
||||||
cMapM mkitem bss
|
|
||||||
blockToXml (DefinitionList defs) =
|
blockToXml (DefinitionList defs) =
|
||||||
cMapM mkdef defs
|
cMapM mkdef defs
|
||||||
where
|
where
|
||||||
|
|
Loading…
Reference in a new issue