diff options
| author | Alexander Krotov <ilabdsf@gmail.com> | 2019-05-15 13:30:14 +0300 | 
|---|---|---|
| committer | Alexander Krotov <ilabdsf@gmail.com> | 2019-05-15 13:30:14 +0300 | 
| commit | f1fbec938f0df271845ca00eec17d95a896136f8 (patch) | |
| tree | 792fb43385be0cb2036c57d73f5f14dd043724f4 /src/Text/Pandoc | |
| parent | d286363f972d62c51b0473a207eadfece2ce9a8d (diff) | |
| download | pandoc-f1fbec938f0df271845ca00eec17d95a896136f8.tar.gz | |
hlint FB2 writer
Diffstat (limited to 'src/Text/Pandoc')
| -rw-r--r-- | src/Text/Pandoc/Writers/FB2.hs | 49 | 
1 files changed, 22 insertions, 27 deletions
| diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 9852922ae..950240df5 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -21,7 +21,7 @@ module Text.Pandoc.Writers.FB2 (writeFB2)  where  import Prelude  import Control.Monad (zipWithM)  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 qualified Data.ByteString.Char8 as B8  import Data.Char (isAscii, isControl, isSpace, toLower) @@ -104,7 +104,7 @@ description meta' = do    let as = authors meta'    dd <- docdate meta'    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    let lang = case lookupMeta "lang" meta' of                 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    let sectionContent = if null id'        then el "section" (title' ++ content) -      else el "section" ([uattr "id" id'], (title' ++ content)) -  return $ [sectionContent] +      else el "section" ([uattr "id" id'], title' ++ content) +  return [sectionContent]  -- | Only <p> and <empty-line> are allowed within <title> in FB2.  formatTitle :: PandocMonad m => [Inline] -> FBM m [Content] @@ -290,6 +290,15 @@ isMimeType s =  footnoteID :: Int -> String  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.  blockToXml :: PandocMonad m => Block -> FBM m [Content]  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  blockToXml (Para [Image atr alt (src,'f':'i':'g':':':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 .                               map (el "p" . el "code") . lines $ s -blockToXml (RawBlock f str) = do +blockToXml (RawBlock f str) =    if f == Format "fb2"      then return $ XI.parseXML str      else return []  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) = -  (list . el "poem") <$> mapM stanza (split null lns) +  list . el "poem" <$> mapM stanza (split null lns)    where      v xs = el "v" <$> cMapM toXml xs      stanza xs = el "stanza" <$> mapM v xs -blockToXml (OrderedList a bss) = do -    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 +blockToXml (OrderedList a bss) =      concat <$> zipWithM mkitem markers bss -blockToXml (BulletList bss) = do -    state <- get -    let pmrk = parentListMarker state -    let mrk = pmrk ++ "•" -    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 +    where +      markers = orderedListMarkers a +blockToXml (BulletList bss) = +    cMapM (mkitem "•") bss  blockToXml (DefinitionList defs) =      cMapM mkdef defs      where | 
