{-# LANGUAGE PatternGuards     #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module      : Text.Pandoc.Writers.FB2
Copyright   : Copyright (C) 2011-2012 Sergey Astanin
                            2012-2020 John MacFarlane
License     : GNU GPL, version 2 or above

Maintainer  : John MacFarlane
Stability   : alpha
Portability : portable

Conversion of 'Pandoc' documents to FB2 (FictionBook2) format.

FictionBook is an XML-based e-book format. For more information see:
<http://www.fictionbook.org/index.php/Eng:XML_Schema_Fictionbook_2.1>

-}
module Text.Pandoc.Writers.FB2 (writeFB2)  where

import Control.Monad (zipWithM)
import Control.Monad.Except (catchError)
import Control.Monad.State.Strict (StateT, evalStateT, get, gets, lift, liftM, modify)
import Data.ByteString.Base64 (encode)
import Data.Char (isAscii, isControl, isSpace)
import Data.Either (lefts, rights)
import Data.List (intercalate)
import Data.Text (Text, pack)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Network.HTTP (urlEncode)
import Text.XML.Light
import qualified Text.XML.Light as X
import qualified Text.XML.Light.Cursor as XC
import qualified Text.XML.Light.Input as XI

import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import qualified Text.Pandoc.Class.PandocMonad as P
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def)
import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers,
                           makeSections, tshow, stringify)
import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable)

-- | Data to be written at the end of the document:
-- (foot)notes, URLs, references, images.
data FbRenderState = FbRenderState
    { FbRenderState -> [(Int, Text, [Content])]
footnotes         :: [ (Int, Text, [Content]) ]  -- ^ #, ID, text
    , FbRenderState -> [(Text, Text)]
imagesToFetch     :: [ (Text, Text) ]  -- ^ filename, URL or path
    , FbRenderState -> Text
parentListMarker  :: Text  -- ^ list marker of the parent ordered list
    , FbRenderState -> WriterOptions
writerOptions     :: WriterOptions
    } deriving (Int -> FbRenderState -> ShowS
[FbRenderState] -> ShowS
FbRenderState -> String
(Int -> FbRenderState -> ShowS)
-> (FbRenderState -> String)
-> ([FbRenderState] -> ShowS)
-> Show FbRenderState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FbRenderState] -> ShowS
$cshowList :: [FbRenderState] -> ShowS
show :: FbRenderState -> String
$cshow :: FbRenderState -> String
showsPrec :: Int -> FbRenderState -> ShowS
$cshowsPrec :: Int -> FbRenderState -> ShowS
Show)

-- | FictionBook building monad.
type FBM m = StateT FbRenderState m

newFB :: FbRenderState
newFB :: FbRenderState
newFB = FbRenderState :: [(Int, Text, [Content])]
-> [(Text, Text)] -> Text -> WriterOptions -> FbRenderState
FbRenderState { footnotes :: [(Int, Text, [Content])]
footnotes = [], imagesToFetch :: [(Text, Text)]
imagesToFetch = []
                      , parentListMarker :: Text
parentListMarker = Text
""
                      , writerOptions :: WriterOptions
writerOptions = WriterOptions
forall a. Default a => a
def }

data ImageMode = NormalImage | InlineImage deriving (ImageMode -> ImageMode -> Bool
(ImageMode -> ImageMode -> Bool)
-> (ImageMode -> ImageMode -> Bool) -> Eq ImageMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageMode -> ImageMode -> Bool
$c/= :: ImageMode -> ImageMode -> Bool
== :: ImageMode -> ImageMode -> Bool
$c== :: ImageMode -> ImageMode -> Bool
Eq)
instance Show ImageMode where
    show :: ImageMode -> String
show ImageMode
NormalImage = String
"imageType"
    show ImageMode
InlineImage = String
"inlineImageType"

-- | Produce an FB2 document from a 'Pandoc' document.
writeFB2 :: PandocMonad m
         => WriterOptions    -- ^ conversion options
         -> Pandoc           -- ^ document to convert
         -> m Text           -- ^ FictionBook2 document (not encoded yet)
writeFB2 :: WriterOptions -> Pandoc -> m Text
writeFB2 WriterOptions
opts Pandoc
doc = (StateT FbRenderState m Text -> FbRenderState -> m Text)
-> FbRenderState -> StateT FbRenderState m Text -> m Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT FbRenderState m Text -> FbRenderState -> m Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT FbRenderState
newFB (StateT FbRenderState m Text -> m Text)
-> StateT FbRenderState m Text -> m Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> StateT FbRenderState m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> FBM m Text
pandocToFB2 WriterOptions
opts Pandoc
doc

pandocToFB2 :: PandocMonad m
            => WriterOptions
            -> Pandoc
            -> FBM m Text
pandocToFB2 :: WriterOptions -> Pandoc -> FBM m Text
pandocToFB2 WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
     (FbRenderState -> FbRenderState) -> StateT FbRenderState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { writerOptions :: WriterOptions
writerOptions = WriterOptions
opts })
     Content
desc <- Meta -> FBM m Content
forall (m :: * -> *). PandocMonad m => Meta -> FBM m Content
description Meta
meta
     [Content]
title <- (Inline -> StateT FbRenderState m [Content])
-> [Inline] -> StateT FbRenderState m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> StateT FbRenderState m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml ([Inline] -> StateT FbRenderState m [Content])
-> (Meta -> [Inline]) -> Meta -> StateT FbRenderState m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> [Inline]
docTitle (Meta -> StateT FbRenderState m [Content])
-> Meta -> StateT FbRenderState m [Content]
forall a b. (a -> b) -> a -> b
$ Meta
meta
     [Content]
secs <- Int -> [Block] -> StateT FbRenderState m [Content]
forall (m :: * -> *).
PandocMonad m =>
Int -> [Block] -> FBM m [Content]
renderSections Int
1 [Block]
blocks
     let body :: Content
body = String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"body" ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ String -> Content -> Content
forall t. Node t => String -> t -> Content
el String
"title" (String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"p" [Content]
title) Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
secs
     [Content]
notes <- StateT FbRenderState m [Content]
forall (m :: * -> *). PandocMonad m => FBM m [Content]
renderFootnotes
     ([Content]
imgs,[Text]
missing) <- StateT FbRenderState m FbRenderState
forall s (m :: * -> *). MonadState s m => m s
get StateT FbRenderState m FbRenderState
-> (FbRenderState -> StateT FbRenderState m ([Content], [Text]))
-> StateT FbRenderState m ([Content], [Text])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (m ([Content], [Text]) -> StateT FbRenderState m ([Content], [Text])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ([Content], [Text])
 -> StateT FbRenderState m ([Content], [Text]))
-> (FbRenderState -> m ([Content], [Text]))
-> FbRenderState
-> StateT FbRenderState m ([Content], [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> m ([Content], [Text])
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> m ([Content], [Text])
fetchImages ([(Text, Text)] -> m ([Content], [Text]))
-> (FbRenderState -> [(Text, Text)])
-> FbRenderState
-> m ([Content], [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FbRenderState -> [(Text, Text)]
imagesToFetch)
     let body' :: Content
body' = [Text] -> Content -> Content
replaceImagesWithAlt [Text]
missing Content
body
     let fb2_xml :: Content
fb2_xml = String -> ([Attr], [Content]) -> Content
forall t. Node t => String -> t -> Content
el String
"FictionBook" ([Attr]
fb2_attrs, [Content
desc, Content
body'] [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
notes [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
imgs)
     Text -> FBM m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> FBM m Text) -> Text -> FBM m Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
xml_head String -> ShowS
forall a. [a] -> [a] -> [a]
++ Content -> String
showContent Content
fb2_xml String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
  where
  xml_head :: String
xml_head = String
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
  fb2_attrs :: [Attr]
fb2_attrs =
      let xmlns :: Text
xmlns = Text
"http://www.gribuser.ru/xml/fictionbook/2.0"
          xlink :: Text
xlink = Text
"http://www.w3.org/1999/xlink"
      in  [ String -> Text -> Attr
uattr String
"xmlns" Text
xmlns
          , (String, String) -> Text -> Attr
attr (String
"xmlns", String
"l") Text
xlink ]

description :: PandocMonad m => Meta -> FBM m Content
description :: Meta -> FBM m Content
description Meta
meta' = do
  let genre :: Content
genre = case Text -> Meta -> Text
lookupMetaString Text
"genre" Meta
meta' of
                Text
"" -> String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"genre" (String
"unrecognised" :: String)
                Text
s  -> String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"genre" (Text -> String
T.unpack Text
s)
  [Content]
bt <- Meta -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Meta -> FBM m [Content]
booktitle Meta
meta'
  let as :: [Content]
as = Meta -> [Content]
authors Meta
meta'
  [Content]
dd <- Meta -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Meta -> FBM m [Content]
docdate Meta
meta'
  [Content]
annotation <- case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"abstract" Meta
meta' of
                  Just (MetaBlocks [Block]
bs) -> Content -> [Content]
forall a. a -> [a]
list (Content -> [Content])
-> ([Content] -> Content) -> [Content] -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"annotation" ([Content] -> [Content]) -> FBM m [Content] -> FBM m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Block -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
unPlain [Block]
bs)
                  Maybe MetaValue
_ -> [Content] -> FBM m [Content]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Content]
forall a. Monoid a => a
mempty
  let lang :: [Content]
lang = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"lang" Meta
meta' of
               Just (MetaInlines [Str Text
s]) -> [String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"lang" (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ Text -> String
iso639 Text
s]
               Just (MetaString Text
s)        -> [String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"lang" (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ Text -> String
iso639 Text
s]
               Maybe MetaValue
_                          -> []
             where iso639 :: Text -> String
iso639 = Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') -- Convert BCP 47 to ISO 639
  let coverimage :: Text -> StateT FbRenderState m [Content]
coverimage Text
url = do
        let img :: Inline
img = Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
nullAttr [Inline]
forall a. Monoid a => a
mempty (Text
url, Text
"")
        [Content]
im <- ImageMode -> Inline -> StateT FbRenderState m [Content]
forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Inline -> FBM m [Content]
insertImage ImageMode
InlineImage Inline
img
        [Content] -> StateT FbRenderState m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"coverpage" [Content]
im]
  [Content]
coverpage <- case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"cover-image" Meta
meta' of
                    Just (MetaInlines [Inline]
ils) -> Text -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> StateT FbRenderState m [Content]
coverimage ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils)
                    Just (MetaString Text
s) -> Text -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> StateT FbRenderState m [Content]
coverimage Text
s
                    Maybe MetaValue
_       -> [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Content -> FBM m Content
forall (m :: * -> *) a. Monad m => a -> m a
return (Content -> FBM m Content) -> Content -> FBM m Content
forall a b. (a -> b) -> a -> b
$ String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"description"
    [ String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"title-info" (Content
genre Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:
                      ([Content]
as [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
bt [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
annotation [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
dd [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
coverpage [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
lang))
    , String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"document-info" [String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"program-used" (String
"pandoc" :: String)]
    ]

booktitle :: PandocMonad m => Meta -> FBM m [Content]
booktitle :: Meta -> FBM m [Content]
booktitle Meta
meta' = do
  [Content]
t <- (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml ([Inline] -> FBM m [Content])
-> (Meta -> [Inline]) -> Meta -> FBM m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> [Inline]
docTitle (Meta -> FBM m [Content]) -> Meta -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ Meta
meta'
  [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content]) -> [Content] -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ [String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"book-title" [Content]
t | Bool -> Bool
not ([Content] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Content]
t)]

authors :: Meta -> [Content]
authors :: Meta -> [Content]
authors Meta
meta' = ([Inline] -> [Content]) -> [[Inline]] -> [Content]
forall a b. (a -> [b]) -> [a] -> [b]
cMap [Inline] -> [Content]
author (Meta -> [[Inline]]
docAuthors Meta
meta')

author :: [Inline] -> [Content]
author :: [Inline] -> [Content]
author [Inline]
ss =
  let ws :: [String]
ws = String -> [String]
words (String -> [String])
-> ([Inline] -> String) -> [Inline] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain ([Inline] -> [String]) -> [Inline] -> [String]
forall a b. (a -> b) -> a -> b
$ [Inline]
ss
      email :: [Content]
email = String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"email" (String -> Content) -> [String] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char
'@' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) [String]
ws)
      ws' :: [String]
ws' = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char
'@' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`) [String]
ws
      names :: [Content]
names = case [String]
ws' of
                [String
nickname] -> [ String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"nickname" String
nickname ]
                [String
fname, String
lname] -> [ String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"first-name" String
fname
                                    , String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"last-name" String
lname ]
                (String
fname:[String]
rest) -> [ String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"first-name" String
fname
                                , String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"middle-name" ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
init ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
rest)
                                , String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"last-name" ([String] -> String
forall a. [a] -> a
last [String]
rest) ]
                [] -> []
  in  Content -> [Content]
forall a. a -> [a]
list (Content -> [Content]) -> Content -> [Content]
forall a b. (a -> b) -> a -> b
$ String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"author" ([Content]
names [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
email)

docdate :: PandocMonad m => Meta -> FBM m [Content]
docdate :: Meta -> FBM m [Content]
docdate Meta
meta' = do
  let ss :: [Inline]
ss = Meta -> [Inline]
docDate Meta
meta'
  [Content]
d <- (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ss
  [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content]) -> [Content] -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ [String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"date" [Content]
d | Bool -> Bool
not ([Content] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Content]
d)]

-- | Divide the stream of blocks into sections and convert to XML
-- representation.
renderSections :: PandocMonad m => Int -> [Block] -> FBM m [Content]
renderSections :: Int -> [Block] -> FBM m [Content]
renderSections Int
level [Block]
blocks = do
    let blocks' :: [Block]
blocks' = Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False Maybe Int
forall a. Maybe a
Nothing [Block]
blocks
    let isSection :: Block -> Bool
isSection (Div (Text
_,Text
"section":[Text]
_,[(Text, Text)]
_) (Header{}:[Block]
_)) = Bool
True
        isSection Block
_ = Bool
False
    let ([Block]
initialBlocks, [Block]
secs) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isSection [Block]
blocks'
    let blocks'' :: [Block]
blocks'' = if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
initialBlocks
        then [Block]
blocks'
        else Attr -> [Block] -> Block
Div (Text
"",[Text
"section"],[])
               (Int -> Attr -> [Inline] -> Block
Header Int
1 Attr
nullAttr [Inline]
forall a. Monoid a => a
mempty Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
initialBlocks) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
secs
    (Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (Int -> Block -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
Int -> Block -> FBM m [Content]
renderSection Int
level) [Block]
blocks''

renderSection :: PandocMonad m =>  Int -> Block -> FBM m [Content]
renderSection :: Int -> Block -> FBM m [Content]
renderSection Int
lvl (Div (Text
id',Text
"section":[Text]
_,[(Text, Text)]
_) (Header Int
_ Attr
_ [Inline]
title : [Block]
xs)) = do
  [Content]
title' <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
title
            then [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            else Content -> [Content]
forall a. a -> [a]
list (Content -> [Content])
-> ([Content] -> Content) -> [Content] -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"title" ([Content] -> [Content]) -> FBM m [Content] -> FBM m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => [Inline] -> FBM m [Content]
formatTitle [Inline]
title
  [Content]
content <- (Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (Int -> Block -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
Int -> Block -> FBM m [Content]
renderSection (Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [Block]
xs
  let sectionContent :: Content
sectionContent = if Text -> Bool
T.null Text
id'
      then String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"section" ([Content]
title' [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
content)
      else String -> ([Attr], [Content]) -> Content
forall t. Node t => String -> t -> Content
el String
"section" ([String -> Text -> Attr
uattr String
"id" Text
id'], [Content]
title' [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
content)
  [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Content
sectionContent]
renderSection Int
_ Block
b = Block -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml Block
b

-- | Only <p> and <empty-line> are allowed within <title> in FB2.
formatTitle :: PandocMonad m => [Inline] -> FBM m [Content]
formatTitle :: [Inline] -> FBM m [Content]
formatTitle [Inline]
inlines =
  ([Inline] -> FBM m [Content]) -> [[Inline]] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (Block -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml (Block -> FBM m [Content])
-> ([Inline] -> Block) -> [Inline] -> FBM m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Para) ([[Inline]] -> FBM m [Content]) -> [[Inline]] -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ (Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [[a]]
split (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
LineBreak) [Inline]
inlines

split :: (a -> Bool) -> [a] -> [[a]]
split :: (a -> Bool) -> [a] -> [[a]]
split a -> Bool
_ [] = []
split a -> Bool
cond [a]
xs = let ([a]
b,[a]
a) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
cond [a]
xs
                in  ([a]
b[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:(a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
split a -> Bool
cond (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
a))

isLineBreak :: Inline -> Bool
isLineBreak :: Inline -> Bool
isLineBreak Inline
LineBreak = Bool
True
isLineBreak Inline
_         = Bool
False

-- | Make another FictionBook body with footnotes.
renderFootnotes :: PandocMonad m => FBM m [Content]
renderFootnotes :: FBM m [Content]
renderFootnotes = do
  [(Int, Text, [Content])]
fns <- FbRenderState -> [(Int, Text, [Content])]
footnotes (FbRenderState -> [(Int, Text, [Content])])
-> StateT FbRenderState m FbRenderState
-> StateT FbRenderState m [(Int, Text, [Content])]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` StateT FbRenderState m FbRenderState
forall s (m :: * -> *). MonadState s m => m s
get
  if [(Int, Text, [Content])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Text, [Content])]
fns
    then [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []  -- no footnotes
    else [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content])
-> (Content -> [Content]) -> Content -> FBM m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Content]
forall a. a -> [a]
list (Content -> FBM m [Content]) -> Content -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$
         String -> ([Attr], [Content]) -> Content
forall t. Node t => String -> t -> Content
el String
"body" ([String -> Text -> Attr
uattr String
"name" Text
"notes"], ((Int, Text, [Content]) -> Content)
-> [(Int, Text, [Content])] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text, [Content]) -> Content
forall a. Show a => (a, Text, [Content]) -> Content
renderFN ([(Int, Text, [Content])] -> [(Int, Text, [Content])]
forall a. [a] -> [a]
reverse [(Int, Text, [Content])]
fns))
  where
    renderFN :: (a, Text, [Content]) -> Content
renderFN (a
n, Text
idstr, [Content]
cs) =
        let fn_texts :: [Content]
fn_texts = String -> Content -> Content
forall t. Node t => String -> t -> Content
el String
"title" (String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"p" (a -> String
forall a. Show a => a -> String
show a
n)) Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
cs
        in  String -> ([Attr], [Content]) -> Content
forall t. Node t => String -> t -> Content
el String
"section" ([String -> Text -> Attr
uattr String
"id" Text
idstr], [Content]
fn_texts)

-- | Fetch images and encode them for the FictionBook XML.
-- Return image data and a list of hrefs of the missing images.
fetchImages :: PandocMonad m => [(Text,Text)] -> m ([Content],[Text])
fetchImages :: [(Text, Text)] -> m ([Content], [Text])
fetchImages [(Text, Text)]
links = do
    [Either Text Content]
imgs <- ((Text, Text) -> m (Either Text Content))
-> [(Text, Text)] -> m [Either Text Content]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Text -> Text -> m (Either Text Content))
-> (Text, Text) -> m (Either Text Content)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> m (Either Text Content)
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> m (Either Text Content)
fetchImage) [(Text, Text)]
links
    ([Content], [Text]) -> m ([Content], [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either Text Content] -> [Content]
forall a b. [Either a b] -> [b]
rights [Either Text Content]
imgs, [Either Text Content] -> [Text]
forall a b. [Either a b] -> [a]
lefts [Either Text Content]
imgs)

-- | Fetch image data from disk or from network and make a <binary> XML section.
-- Return either (Left hrefOfMissingImage) or (Right xmlContent).
fetchImage :: PandocMonad m => Text -> Text -> m (Either Text Content)
fetchImage :: Text -> Text -> m (Either Text Content)
fetchImage Text
href Text
link = do
  Maybe (Text, Text)
mbimg <-
      case (Text -> Bool
isURI Text
link, Text -> Maybe (Text, Text, Bool, Text)
readDataURI Text
link) of
       (Bool
True, Just (Text
mime,Text
_,Bool
True,Text
base64)) ->
           let mime' :: Text
mime' = Text -> Text
T.toLower Text
mime
           in if Text
mime' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"image/png" Bool -> Bool -> Bool
|| Text
mime' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"image/jpeg"
              then Maybe (Text, Text) -> m (Maybe (Text, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
mime',Text
base64))
              else Maybe (Text, Text) -> m (Maybe (Text, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, Text)
forall a. Maybe a
Nothing
       (Bool
True, Just (Text, Text, Bool, Text)
_) -> Maybe (Text, Text) -> m (Maybe (Text, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, Text)
forall a. Maybe a
Nothing  -- not base64-encoded
       (Bool, Maybe (Text, Text, Bool, Text))
_               ->
         m (Maybe (Text, Text))
-> (PandocError -> m (Maybe (Text, Text)))
-> m (Maybe (Text, Text))
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (do (ByteString
bs, Maybe Text
mbmime) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
P.fetchItem Text
link
                        case Maybe Text
mbmime of
                             Maybe Text
Nothing -> do
                               LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotDetermineMimeType Text
link
                               Maybe (Text, Text) -> m (Maybe (Text, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, Text)
forall a. Maybe a
Nothing
                             Just Text
mime -> Maybe (Text, Text) -> m (Maybe (Text, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, Text) -> m (Maybe (Text, Text)))
-> Maybe (Text, Text) -> m (Maybe (Text, Text))
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
mime,
                                                      ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode ByteString
bs))
                    (\PandocError
e ->
                       do LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
link (PandocError -> Text
forall a. Show a => a -> Text
tshow PandocError
e)
                          Maybe (Text, Text) -> m (Maybe (Text, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, Text)
forall a. Maybe a
Nothing)
  case Maybe (Text, Text)
mbimg of
    Just (Text
imgtype, Text
imgdata) ->
        Either Text Content -> m (Either Text Content)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Content -> m (Either Text Content))
-> (Content -> Either Text Content)
-> Content
-> m (Either Text Content)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> Either Text Content
forall a b. b -> Either a b
Right (Content -> m (Either Text Content))
-> Content -> m (Either Text Content)
forall a b. (a -> b) -> a -> b
$ String -> ([Attr], Content) -> Content
forall t. Node t => String -> t -> Content
el String
"binary"
                   ( [String -> Text -> Attr
uattr String
"id" Text
href
                     , String -> Text -> Attr
uattr String
"content-type" Text
imgtype]
                   , Text -> Content
txt Text
imgdata )
    Maybe (Text, Text)
_ -> Either Text Content -> m (Either Text Content)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text Content
forall a b. a -> Either a b
Left (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
href))


-- | Extract mime type and encoded data from the Data URI.
readDataURI :: Text -- ^ URI
            -> Maybe (Text,Text,Bool,Text)
               -- ^ Maybe (mime,charset,isBase64,data)
readDataURI :: Text -> Maybe (Text, Text, Bool, Text)
readDataURI Text
uri =
  case Text -> Text -> Maybe Text
T.stripPrefix Text
"data:" Text
uri of
    Maybe Text
Nothing   -> Maybe (Text, Text, Bool, Text)
forall a. Maybe a
Nothing
    Just Text
rest ->
      let meta :: Text
meta = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') Text
rest  -- without trailing ','
          uridata :: Text
uridata = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
meta Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
rest
          parts :: [Text]
parts = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';') Text
meta
          (Text
mime,Text
cs,Bool
enc)=(Text -> (Text, Text, Bool) -> (Text, Text, Bool))
-> (Text, Text, Bool) -> [Text] -> (Text, Text, Bool)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> (Text, Text, Bool) -> (Text, Text, Bool)
upd (Text
"text/plain",Text
"US-ASCII",Bool
False) [Text]
parts
      in  (Text, Text, Bool, Text) -> Maybe (Text, Text, Bool, Text)
forall a. a -> Maybe a
Just (Text
mime,Text
cs,Bool
enc,Text
uridata)

 where
   upd :: Text -> (Text, Text, Bool) -> (Text, Text, Bool)
upd Text
str m :: (Text, Text, Bool)
m@(Text
mime,Text
cs,Bool
enc)
       | Text -> Bool
isMimeType Text
str                            = (Text
str,Text
cs,Bool
enc)
       | Just Text
str' <- Text -> Text -> Maybe Text
T.stripPrefix Text
"charset=" Text
str = (Text
mime,Text
str',Bool
enc)
       | Text
str Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==  Text
"base64"                          = (Text
mime,Text
cs,Bool
True)
       | Bool
otherwise                                 = (Text, Text, Bool)
m

-- Without parameters like ;charset=...; see RFC 2045, 5.1
isMimeType :: Text -> Bool
isMimeType :: Text -> Bool
isMimeType Text
s =
    case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') Text
s of
      [Text
mtype,Text
msubtype] ->
          (Text -> Text
T.toLower Text
mtype Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
types
           Bool -> Bool -> Bool
|| Text
"x-" Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.toLower Text
mtype)
          Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
valid Text
mtype
          Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
valid Text
msubtype
      [Text]
_ -> Bool
False
 where
   types :: [Text]
types =  [Text
"text",Text
"image",Text
"audio",Text
"video",Text
"application",Text
"message",Text
"multipart"]
   valid :: Char -> Bool
valid Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isControl Char
c) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&&
             Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
"()<>@,;:\\\"/[]?=" :: String)

footnoteID :: Int -> Text
footnoteID :: Int -> Text
footnoteID Int
i = Text
"n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
i

mkitem :: PandocMonad m => Text -> [Block] -> FBM m [Content]
mkitem :: Text -> [Block] -> FBM m [Content]
mkitem Text
mrk [Block]
bs = do
  Text
pmrk <- (FbRenderState -> Text) -> StateT FbRenderState m Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FbRenderState -> Text
parentListMarker
  let nmrk :: Text
nmrk = Text
pmrk Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mrk Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
  (FbRenderState -> FbRenderState) -> StateT FbRenderState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { parentListMarker :: Text
parentListMarker = Text
nmrk})
  [Content]
item <- (Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Block -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml ([Block] -> FBM m [Content]) -> [Block] -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
plainToPara ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Text -> [Block] -> [Block]
indentBlocks Text
nmrk [Block]
bs
  (FbRenderState -> FbRenderState) -> StateT FbRenderState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { parentListMarker :: Text
parentListMarker = Text
pmrk }) -- old parent marker
  [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Content]
item

-- | Convert a block-level Pandoc's element to FictionBook XML representation.
blockToXml :: PandocMonad m => Block -> FBM m [Content]
blockToXml :: Block -> FBM m [Content]
blockToXml (Plain [Inline]
ss) = (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ss  -- FIXME: can lead to malformed FB2
blockToXml (Para [Math MathType
DisplayMath Text
formula]) = ImageMode -> Text -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Text -> FBM m [Content]
insertMath ImageMode
NormalImage Text
formula
-- title beginning with fig: indicates that the image is a figure
blockToXml (Para [Image Attr
atr [Inline]
alt (Text
src,Text
tgt)])
  | Just Text
tit <- Text -> Text -> Maybe Text
T.stripPrefix Text
"fig:" Text
tgt
  = ImageMode -> Inline -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Inline -> FBM m [Content]
insertImage ImageMode
NormalImage (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
atr [Inline]
alt (Text
src,Text
tit))
blockToXml (Para [Inline]
ss) = Content -> [Content]
forall a. a -> [a]
list (Content -> [Content])
-> ([Content] -> Content) -> [Content] -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"p" ([Content] -> [Content]) -> FBM m [Content] -> FBM m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ss
blockToXml (CodeBlock Attr
_ Text
s) = [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content])
-> (Text -> [Content]) -> Text -> FBM m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Content] -> [Content]
spaceBeforeAfter ([Content] -> [Content])
-> (Text -> [Content]) -> Text -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                             (Text -> Content) -> [Text] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Content -> Content
forall t. Node t => String -> t -> Content
el String
"p" (Content -> Content) -> (Text -> Content) -> Text -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"code" (String -> Content) -> (Text -> String) -> Text -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ([Text] -> [Content]) -> (Text -> [Text]) -> Text -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> FBM m [Content]) -> Text -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ Text
s
blockToXml (RawBlock Format
f Text
str) =
  if Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"fb2"
    then [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content]) -> [Content] -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ Text -> [Content]
forall s. XmlSource s => s -> [Content]
XI.parseXML Text
str
    else [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []
blockToXml (Div Attr
_ [Block]
bs) = (Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Block -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml [Block]
bs
blockToXml (BlockQuote [Block]
bs) = Content -> [Content]
forall a. a -> [a]
list (Content -> [Content])
-> ([Content] -> Content) -> [Content] -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"cite" ([Content] -> [Content]) -> FBM m [Content] -> FBM m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Block -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml [Block]
bs
blockToXml (LineBlock [[Inline]]
lns) =
  Content -> [Content]
forall a. a -> [a]
list (Content -> [Content])
-> ([Content] -> Content) -> [Content] -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"poem" ([Content] -> [Content]) -> FBM m [Content] -> FBM m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[Inline]] -> StateT FbRenderState m Content)
-> [[[Inline]]] -> FBM m [Content]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [[Inline]] -> StateT FbRenderState m Content
forall (t :: * -> *) (m :: * -> *).
(Node (t Content), Traversable t, PandocMonad m) =>
t [Inline] -> StateT FbRenderState m Content
stanza (([Inline] -> Bool) -> [[Inline]] -> [[[Inline]]]
forall a. (a -> Bool) -> [a] -> [[a]]
split [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Inline]]
lns)
  where
    v :: [Inline] -> StateT FbRenderState m Content
v [Inline]
xs = String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"v" ([Content] -> Content)
-> StateT FbRenderState m [Content]
-> StateT FbRenderState m Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> StateT FbRenderState m [Content])
-> [Inline] -> StateT FbRenderState m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> StateT FbRenderState m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
xs
    stanza :: t [Inline] -> StateT FbRenderState m Content
stanza t [Inline]
xs = String -> t Content -> Content
forall t. Node t => String -> t -> Content
el String
"stanza" (t Content -> Content)
-> StateT FbRenderState m (t Content)
-> StateT FbRenderState m Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Inline] -> StateT FbRenderState m Content)
-> t [Inline] -> StateT FbRenderState m (t Content)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Inline] -> StateT FbRenderState m Content
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT FbRenderState m Content
v t [Inline]
xs
blockToXml (OrderedList ListAttributes
a [[Block]]
bss) =
    [[Content]] -> [Content]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Content]] -> [Content])
-> StateT FbRenderState m [[Content]] -> FBM m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> [Block] -> FBM m [Content])
-> [Text] -> [[Block]] -> StateT FbRenderState m [[Content]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Text -> [Block] -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Block] -> FBM m [Content]
mkitem [Text]
markers [[Block]]
bss
    where
      markers :: [Text]
markers = ListAttributes -> [Text]
orderedListMarkers ListAttributes
a
blockToXml (BulletList [[Block]]
bss) =
    ([Block] -> FBM m [Content]) -> [[Block]] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM (Text -> [Block] -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
Text -> [Block] -> FBM m [Content]
mkitem Text
"•") [[Block]]
bss
blockToXml (DefinitionList [([Inline], [[Block]])]
defs) =
    (([Inline], [[Block]]) -> FBM m [Content])
-> [([Inline], [[Block]])] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM ([Inline], [[Block]]) -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> StateT FbRenderState m [Content]
mkdef [([Inline], [[Block]])]
defs
    where
      mkdef :: ([Inline], [[Block]]) -> StateT FbRenderState m [Content]
mkdef ([Inline]
term, [[Block]]
bss) = do
          [Content]
items <- ([Block] -> StateT FbRenderState m [Content])
-> [[Block]] -> StateT FbRenderState m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM ((Block -> StateT FbRenderState m [Content])
-> [Block] -> StateT FbRenderState m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Block -> StateT FbRenderState m [Content]
forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml ([Block] -> StateT FbRenderState m [Content])
-> ([Block] -> [Block])
-> [Block]
-> StateT FbRenderState m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Block]
plainToPara ([Block] -> [Block]) -> ([Block] -> [Block]) -> [Block] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Block] -> [Block]
indentBlocks (Int -> Text -> Text
T.replicate Int
4 Text
" ")) [[Block]]
bss
          Content
t <- String -> [Inline] -> FBM m Content
forall (m :: * -> *).
PandocMonad m =>
String -> [Inline] -> FBM m Content
wrap String
"strong" [Inline]
term
          [Content] -> StateT FbRenderState m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Content -> Content
forall t. Node t => String -> t -> Content
el String
"p" Content
t Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
items)
blockToXml h :: Block
h@Header{} = do
  -- should not occur after makeSections, except inside lists/blockquotes
  LogMessage -> StateT FbRenderState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FbRenderState m ())
-> LogMessage -> StateT FbRenderState m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
h
  [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []
blockToXml Block
HorizontalRule = [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [ String -> () -> Content
forall t. Node t => String -> t -> Content
el String
"empty-line" () ]
blockToXml (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
    let ([Inline]
caption, [Alignment]
aligns, [Double]
_, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
    [Content]
hd <- if [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers then [Content] -> FBM m [Content]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else (Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[]) (Content -> [Content])
-> StateT FbRenderState m Content -> FBM m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> [[Block]] -> [Alignment] -> StateT FbRenderState m Content
forall (m :: * -> *).
PandocMonad m =>
String -> [[Block]] -> [Alignment] -> FBM m Content
mkrow String
"th" [[Block]]
headers [Alignment]
aligns
    [Content]
bd <- ([[Block]] -> StateT FbRenderState m Content)
-> [[[Block]]] -> FBM m [Content]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\[[Block]]
r -> String
-> [[Block]] -> [Alignment] -> StateT FbRenderState m Content
forall (m :: * -> *).
PandocMonad m =>
String -> [[Block]] -> [Alignment] -> FBM m Content
mkrow String
"td" [[Block]]
r [Alignment]
aligns) [[[Block]]]
rows
    Content
c <- String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"emphasis" ([Content] -> Content)
-> FBM m [Content] -> StateT FbRenderState m Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
caption
    [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"table" ([Content]
hd [Content] -> [Content] -> [Content]
forall a. Semigroup a => a -> a -> a
<> [Content]
bd), String -> Content -> Content
forall t. Node t => String -> t -> Content
el String
"p" Content
c]
    where
      mkrow :: PandocMonad m => String -> [[Block]] -> [Alignment] -> FBM m Content
      mkrow :: String -> [[Block]] -> [Alignment] -> FBM m Content
mkrow String
tag [[Block]]
cells [Alignment]
aligns' =
        String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
"tr" ([Content] -> Content)
-> StateT FbRenderState m [Content] -> FBM m Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Block], Alignment) -> FBM m Content)
-> [([Block], Alignment)] -> StateT FbRenderState m [Content]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> ([Block], Alignment) -> FBM m Content
forall (m :: * -> *).
PandocMonad m =>
String -> ([Block], Alignment) -> FBM m Content
mkcell String
tag) ([[Block]] -> [Alignment] -> [([Block], Alignment)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Block]]
cells [Alignment]
aligns')
      --
      mkcell :: PandocMonad m => String -> ([Block], Alignment) -> FBM m Content
      mkcell :: String -> ([Block], Alignment) -> FBM m Content
mkcell String
tag ([Block]
cell, Alignment
align) = do
        [Content]
cblocks <- (Block -> StateT FbRenderState m [Content])
-> [Block] -> StateT FbRenderState m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Block -> StateT FbRenderState m [Content]
forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml [Block]
cell
        Content -> FBM m Content
forall (m :: * -> *) a. Monad m => a -> m a
return (Content -> FBM m Content) -> Content -> FBM m Content
forall a b. (a -> b) -> a -> b
$ String -> ([Attr], [Content]) -> Content
forall t. Node t => String -> t -> Content
el String
tag ([Alignment -> Attr
align_attr Alignment
align], [Content]
cblocks)
      --
      align_attr :: Alignment -> Attr
align_attr Alignment
a = QName -> String -> Attr
Attr (String -> Maybe String -> Maybe String -> QName
QName String
"align" Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) (Alignment -> String
forall p. IsString p => Alignment -> p
align_str Alignment
a)
      align_str :: Alignment -> p
align_str Alignment
AlignLeft    = p
"left"
      align_str Alignment
AlignCenter  = p
"center"
      align_str Alignment
AlignRight   = p
"right"
      align_str Alignment
AlignDefault = p
"left"
blockToXml Block
Null = [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- Replace plain text with paragraphs and add line break after paragraphs.
-- It is used to convert plain text from tight list items to paragraphs.
plainToPara :: [Block] -> [Block]
plainToPara :: [Block] -> [Block]
plainToPara [] = []
plainToPara (Plain [Inline]
inlines : [Block]
rest) =
    [Inline] -> Block
Para [Inline]
inlines Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
plainToPara [Block]
rest
plainToPara (Para [Inline]
inlines : [Block]
rest) =
    [Inline] -> Block
Para [Inline]
inlines Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
HorizontalRule Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
plainToPara [Block]
rest -- HorizontalRule will be converted to <empty-line />
plainToPara (Block
p:[Block]
rest) = Block
p Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
plainToPara [Block]
rest

-- Replace plain text with paragraphs
unPlain :: Block -> Block
unPlain :: Block -> Block
unPlain (Plain [Inline]
inlines) = [Inline] -> Block
Para [Inline]
inlines
unPlain Block
x = Block
x

-- Simulate increased indentation level. Will not really work
-- for multi-line paragraphs.
indentPrefix :: Text -> Block -> Block
indentPrefix :: Text -> Block -> Block
indentPrefix Text
spacer = Block -> Block
indentBlock
  where
  indentBlock :: Block -> Block
indentBlock (Plain [Inline]
ins) = [Inline] -> Block
Plain (Text -> Inline
Str Text
spacerInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ins)
  indentBlock (Para [Inline]
ins) = [Inline] -> Block
Para (Text -> Inline
Str Text
spacerInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ins)
  indentBlock (CodeBlock Attr
a Text
s) =
    let s' :: Text
s' = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
spacerText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
s
    in  Attr -> Text -> Block
CodeBlock Attr
a Text
s'
  indentBlock (BlockQuote [Block]
bs) = [Block] -> Block
BlockQuote ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
indent [Block]
bs)
  indentBlock (Header Int
l Attr
attr' [Inline]
ins) = Int -> Attr -> [Inline] -> Block
Header Int
l Attr
attr' ([Inline] -> [Inline]
indentLines [Inline]
ins)
  indentBlock Block
everythingElse = Block
everythingElse
  -- indent every (explicit) line
  indentLines :: [Inline] -> [Inline]
  indentLines :: [Inline] -> [Inline]
indentLines [Inline]
ins = let lns :: [[Inline]]
lns = (Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [[a]]
split Inline -> Bool
isLineBreak [Inline]
ins :: [[Inline]]
                    in  [Inline] -> [[Inline]] -> [Inline]
forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] ([[Inline]] -> [Inline]) -> [[Inline]] -> [Inline]
forall a b. (a -> b) -> a -> b
$ ([Inline] -> [Inline]) -> [[Inline]] -> [[Inline]]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Inline
Str Text
spacerInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:) [[Inline]]
lns

indent :: Block -> Block
indent :: Block -> Block
indent = Text -> Block -> Block
indentPrefix Text
spacer
  where
  -- indentation space
  spacer :: Text
  spacer :: Text
spacer = Int -> Text -> Text
T.replicate Int
4 Text
" "

indentBlocks :: Text -> [Block] -> [Block]
indentBlocks :: Text -> [Block] -> [Block]
indentBlocks Text
_ [] = []
indentBlocks Text
prefix (Block
x:[Block]
xs) = Text -> Block -> Block
indentPrefix Text
prefix Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: (Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Block -> Block
indentPrefix (Text -> Block -> Block) -> Text -> Block -> Block
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Text -> Int
T.length Text
prefix) Text
" ") [Block]
xs

-- | Convert a Pandoc's Inline element to FictionBook XML representation.
toXml :: PandocMonad m => Inline -> FBM m [Content]
toXml :: Inline -> FBM m [Content]
toXml (Str Text
s) = [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Content
txt Text
s]
toXml (Span Attr
_ [Inline]
ils) = (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ils
toXml (Emph [Inline]
ss) = Content -> [Content]
forall a. a -> [a]
list (Content -> [Content])
-> StateT FbRenderState m Content -> FBM m [Content]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` String -> [Inline] -> StateT FbRenderState m Content
forall (m :: * -> *).
PandocMonad m =>
String -> [Inline] -> FBM m Content
wrap String
"emphasis" [Inline]
ss
toXml (Underline [Inline]
ss) = Content -> [Content]
forall a. a -> [a]
list (Content -> [Content])
-> StateT FbRenderState m Content -> FBM m [Content]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` String -> [Inline] -> StateT FbRenderState m Content
forall (m :: * -> *).
PandocMonad m =>
String -> [Inline] -> FBM m Content
wrap String
"underline" [Inline]
ss
toXml (Strong [Inline]
ss) = Content -> [Content]
forall a. a -> [a]
list (Content -> [Content])
-> StateT FbRenderState m Content -> FBM m [Content]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` String -> [Inline] -> StateT FbRenderState m Content
forall (m :: * -> *).
PandocMonad m =>
String -> [Inline] -> FBM m Content
wrap String
"strong" [Inline]
ss
toXml (Strikeout [Inline]
ss) = Content -> [Content]
forall a. a -> [a]
list (Content -> [Content])
-> StateT FbRenderState m Content -> FBM m [Content]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` String -> [Inline] -> StateT FbRenderState m Content
forall (m :: * -> *).
PandocMonad m =>
String -> [Inline] -> FBM m Content
wrap String
"strikethrough" [Inline]
ss
toXml (Superscript [Inline]
ss) = Content -> [Content]
forall a. a -> [a]
list (Content -> [Content])
-> StateT FbRenderState m Content -> FBM m [Content]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` String -> [Inline] -> StateT FbRenderState m Content
forall (m :: * -> *).
PandocMonad m =>
String -> [Inline] -> FBM m Content
wrap String
"sup" [Inline]
ss
toXml (Subscript [Inline]
ss) = Content -> [Content]
forall a. a -> [a]
list (Content -> [Content])
-> StateT FbRenderState m Content -> FBM m [Content]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` String -> [Inline] -> StateT FbRenderState m Content
forall (m :: * -> *).
PandocMonad m =>
String -> [Inline] -> FBM m Content
wrap String
"sub" [Inline]
ss
toXml (SmallCaps [Inline]
ss) = (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml ([Inline] -> FBM m [Content]) -> [Inline] -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
forall a. Walkable Inline a => a -> a
capitalize [Inline]
ss
toXml (Quoted QuoteType
SingleQuote [Inline]
ss) = do  -- FIXME: should be language-specific
  [Content]
inner <- (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ss
  [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content]) -> [Content] -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ [Text -> Content
txt Text
"‘"] [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
inner [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Text -> Content
txt Text
"’"]
toXml (Quoted QuoteType
DoubleQuote [Inline]
ss) = do
  [Content]
inner <- (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ss
  [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content]) -> [Content] -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ [Text -> Content
txt Text
"“"] [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
inner [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Text -> Content
txt Text
"”"]
toXml (Cite [Citation]
_ [Inline]
ss) = (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
ss  -- FIXME: support citation styles
toXml (Code Attr
_ Text
s) = [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"code" (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s]
toXml Inline
Space = [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Content
txt Text
" "]
toXml Inline
SoftBreak = [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Content
txt Text
"\n"]
toXml Inline
LineBreak = [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Content
txt Text
"\n"]
toXml (Math MathType
_ Text
formula) = ImageMode -> Text -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Text -> FBM m [Content]
insertMath ImageMode
InlineImage Text
formula
toXml il :: Inline
il@(RawInline Format
_ Text
_) = do
  LogMessage -> StateT FbRenderState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT FbRenderState m ())
-> LogMessage -> StateT FbRenderState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
  [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []  -- raw TeX and raw HTML are suppressed
toXml (Link Attr
_ [Inline]
text (Text
url,Text
_)) = do
  [Content]
ln_text <- (Inline -> FBM m [Content]) -> [Inline] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
text
  [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [ String -> ([Attr], [Content]) -> Content
forall t. Node t => String -> t -> Content
el String
"a" ( [ (String, String) -> Text -> Attr
attr (String
"l",String
"href") Text
url ], [Content]
ln_text) ]
toXml img :: Inline
img@Image{} = ImageMode -> Inline -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Inline -> FBM m [Content]
insertImage ImageMode
InlineImage Inline
img
toXml (Note [Block]
bs) = do
  [(Int, Text, [Content])]
fns <- FbRenderState -> [(Int, Text, [Content])]
footnotes (FbRenderState -> [(Int, Text, [Content])])
-> StateT FbRenderState m FbRenderState
-> StateT FbRenderState m [(Int, Text, [Content])]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` StateT FbRenderState m FbRenderState
forall s (m :: * -> *). MonadState s m => m s
get
  let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(Int, Text, [Content])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Text, [Content])]
fns
  let fn_id :: Text
fn_id = Int -> Text
footnoteID Int
n
  [Content]
fn_desc <- (Block -> FBM m [Content]) -> [Block] -> FBM m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Block -> FBM m [Content]
forall (m :: * -> *). PandocMonad m => Block -> FBM m [Content]
blockToXml [Block]
bs
  (FbRenderState -> FbRenderState) -> StateT FbRenderState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { footnotes :: [(Int, Text, [Content])]
footnotes = (Int
n, Text
fn_id, [Content]
fn_desc) (Int, Text, [Content])
-> [(Int, Text, [Content])] -> [(Int, Text, [Content])]
forall a. a -> [a] -> [a]
: [(Int, Text, [Content])]
fns })
  let fn_ref :: Content
fn_ref = Text -> Content
txt (Text -> Content) -> Text -> Content
forall a b. (a -> b) -> a -> b
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
  [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content])
-> (Content -> [Content]) -> Content -> FBM m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Content]
forall a. a -> [a]
list (Content -> FBM m [Content]) -> Content -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$ String -> ([Attr], Content) -> Content
forall t. Node t => String -> t -> Content
el String
"a" ( [ (String, String) -> Text -> Attr
attr (String
"l",String
"href") (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fn_id)
                           , String -> Text -> Attr
uattr String
"type" Text
"note" ]
                         , Content
fn_ref )

insertMath :: PandocMonad m => ImageMode -> Text -> FBM m [Content]
insertMath :: ImageMode -> Text -> FBM m [Content]
insertMath ImageMode
immode Text
formula = do
  HTMLMathMethod
htmlMath <- (FbRenderState -> HTMLMathMethod)
-> StateT FbRenderState m FbRenderState
-> StateT FbRenderState m HTMLMathMethod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WriterOptions -> HTMLMathMethod
writerHTMLMathMethod (WriterOptions -> HTMLMathMethod)
-> (FbRenderState -> WriterOptions)
-> FbRenderState
-> HTMLMathMethod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FbRenderState -> WriterOptions
writerOptions) StateT FbRenderState m FbRenderState
forall s (m :: * -> *). MonadState s m => m s
get
  case HTMLMathMethod
htmlMath of
    WebTeX Text
url -> do
       let alt :: [Inline]
alt = [Attr -> Text -> Inline
Code Attr
nullAttr Text
formula]
       let imgurl :: Text
imgurl = Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ShowS
urlEncode ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
formula)
       let img :: Inline
img = Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
nullAttr [Inline]
alt (Text
imgurl, Text
"")
       ImageMode -> Inline -> FBM m [Content]
forall (m :: * -> *).
PandocMonad m =>
ImageMode -> Inline -> FBM m [Content]
insertImage ImageMode
immode Inline
img
    HTMLMathMethod
_ -> [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"code" (String -> Content) -> String -> Content
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
formula]

insertImage :: PandocMonad m => ImageMode -> Inline -> FBM m [Content]
insertImage :: ImageMode -> Inline -> FBM m [Content]
insertImage ImageMode
immode (Image Attr
_ [Inline]
alt (Text
url,Text
ttl)) = do
  [(Text, Text)]
images <- FbRenderState -> [(Text, Text)]
imagesToFetch (FbRenderState -> [(Text, Text)])
-> StateT FbRenderState m FbRenderState
-> StateT FbRenderState m [(Text, Text)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` StateT FbRenderState m FbRenderState
forall s (m :: * -> *). MonadState s m => m s
get
  let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(Text, Text)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Text)]
images
  let fname :: Text
fname = Text
"image" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
  (FbRenderState -> FbRenderState) -> StateT FbRenderState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\FbRenderState
s -> FbRenderState
s { imagesToFetch :: [(Text, Text)]
imagesToFetch = (Text
fname, Text
url) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
images })
  let ttlattr :: [Attr]
ttlattr = case (ImageMode
immode, Text -> Bool
T.null Text
ttl) of
                  (ImageMode
NormalImage, Bool
False) -> [ String -> Text -> Attr
uattr String
"title" Text
ttl ]
                  (ImageMode, Bool)
_                    -> []
  [Content] -> FBM m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> FBM m [Content])
-> (Content -> [Content]) -> Content -> FBM m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> [Content]
forall a. a -> [a]
list (Content -> FBM m [Content]) -> Content -> FBM m [Content]
forall a b. (a -> b) -> a -> b
$
         String -> [Attr] -> Content
forall t. Node t => String -> t -> Content
el String
"image" ([Attr] -> Content) -> [Attr] -> Content
forall a b. (a -> b) -> a -> b
$
            [ (String, String) -> Text -> Attr
attr (String
"l",String
"href") (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname)
            , (String, String) -> Text -> Attr
attr (String
"l",String
"type") (ImageMode -> Text
forall a. Show a => a -> Text
tshow ImageMode
immode)
            , String -> Text -> Attr
uattr String
"alt" (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain [Inline]
alt) ]
            [Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++ [Attr]
ttlattr
insertImage ImageMode
_ Inline
_ = String -> FBM m [Content]
forall a. HasCallStack => String -> a
error String
"unexpected inline instead of image"

replaceImagesWithAlt :: [Text] -> Content -> Content
replaceImagesWithAlt :: [Text] -> Content -> Content
replaceImagesWithAlt [Text]
missingHrefs Content
body =
  let cur :: Cursor
cur = Content -> Cursor
XC.fromContent Content
body
      cur' :: Cursor
cur' = Cursor -> Cursor
replaceAll Cursor
cur
  in  Cursor -> Content
XC.toTree (Cursor -> Content) -> (Cursor -> Cursor) -> Cursor -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> Cursor
XC.root (Cursor -> Content) -> Cursor -> Content
forall a b. (a -> b) -> a -> b
$ Cursor
cur'
  where
  --
    replaceAll :: XC.Cursor -> XC.Cursor
    replaceAll :: Cursor -> Cursor
replaceAll Cursor
c =
        let n :: Content
n = Cursor -> Content
XC.current Cursor
c
            c' :: Cursor
c' = if Content -> Bool
isImage Content
n Bool -> Bool -> Bool
&& Content -> Bool
isMissing Content
n
                 then (Content -> Content) -> Cursor -> Cursor
XC.modifyContent Content -> Content
replaceNode Cursor
c
                 else Cursor
c
        in  case Cursor -> Maybe Cursor
XC.nextDF Cursor
c' of
              (Just Cursor
cnext) -> Cursor -> Cursor
replaceAll Cursor
cnext
              Maybe Cursor
Nothing      -> Cursor
c'  -- end of document
  --
    isImage :: Content -> Bool
    isImage :: Content -> Bool
isImage (Elem Element
e) = Element -> QName
elName Element
e QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> QName
uname String
"image"
    isImage Content
_        = Bool
False
  --
    isMissing :: Content -> Bool
isMissing (Elem img :: Element
img@Element{}) =
        let imgAttrs :: [Attr]
imgAttrs = Element -> [Attr]
elAttribs Element
img
            badAttrs :: [Attr]
badAttrs = (Text -> Attr) -> [Text] -> [Attr]
forall a b. (a -> b) -> [a] -> [b]
map ((String, String) -> Text -> Attr
attr (String
"l",String
"href")) [Text]
missingHrefs
        in  (Attr -> Bool) -> [Attr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Attr -> [Attr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Attr]
imgAttrs) [Attr]
badAttrs
    isMissing Content
_ = Bool
False
  --
    replaceNode :: Content -> Content
    replaceNode :: Content -> Content
replaceNode n :: Content
n@(Elem img :: Element
img@Element{}) =
        let attrs :: [Attr]
attrs = Element -> [Attr]
elAttribs Element
img
            alt :: Maybe String
alt = [Attr] -> QName -> Maybe String
getAttrVal [Attr]
attrs (String -> QName
uname String
"alt")
            imtype :: Maybe String
imtype = [Attr] -> QName -> Maybe String
getAttrVal [Attr]
attrs (String -> String -> QName
qname String
"l" String
"type")
        in case (Maybe String
alt, Maybe String
imtype) of
             (Just String
alt', Just String
imtype') ->
                 if String
imtype' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ImageMode -> String
forall a. Show a => a -> String
show ImageMode
NormalImage
                 then String -> String -> Content
forall t. Node t => String -> t -> Content
el String
"p" String
alt'
                 else Text -> Content
txt (Text -> Content) -> Text -> Content
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
alt'
             (Just String
alt', Maybe String
Nothing) -> Text -> Content
txt (Text -> Content) -> Text -> Content
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
alt'  -- no type attribute
             (Maybe String, Maybe String)
_ -> Content
n   -- don't replace if alt text is not found
    replaceNode Content
n = Content
n
  --
    getAttrVal :: [X.Attr] -> QName -> Maybe String
    getAttrVal :: [Attr] -> QName -> Maybe String
getAttrVal [Attr]
attrs QName
name =
        case (Attr -> Bool) -> [Attr] -> [Attr]
forall a. (a -> Bool) -> [a] -> [a]
filter ((QName
name QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
==) (QName -> Bool) -> (Attr -> QName) -> Attr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> QName
attrKey) [Attr]
attrs of
           (Attr
a:[Attr]
_) -> String -> Maybe String
forall a. a -> Maybe a
Just (Attr -> String
attrVal Attr
a)
           [Attr]
_     -> Maybe String
forall a. Maybe a
Nothing


-- | Wrap all inlines with an XML tag (given its unqualified name).
wrap :: PandocMonad m => String -> [Inline] -> FBM m Content
wrap :: String -> [Inline] -> FBM m Content
wrap String
tagname [Inline]
inlines = String -> [Content] -> Content
forall t. Node t => String -> t -> Content
el String
tagname ([Content] -> Content)
-> StateT FbRenderState m [Content] -> FBM m Content
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (Inline -> StateT FbRenderState m [Content])
-> [Inline] -> StateT FbRenderState m [Content]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
cMapM Inline -> StateT FbRenderState m [Content]
forall (m :: * -> *). PandocMonad m => Inline -> FBM m [Content]
toXml [Inline]
inlines

-- " Create a singleton list.
list :: a -> [a]
list :: a -> [a]
list = (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])

-- | Convert an 'Inline' to plaintext.
plain :: Inline -> String
plain :: Inline -> String
plain (Str Text
s)               = Text -> String
T.unpack Text
s
plain (Emph [Inline]
ss)             = (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain [Inline]
ss
plain (Underline [Inline]
ss)        = (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain [Inline]
ss
plain (Span Attr
_ [Inline]
ss)           = (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain [Inline]
ss
plain (Strong [Inline]
ss)           = (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain [Inline]
ss
plain (Strikeout [Inline]
ss)        = (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain [Inline]
ss
plain (Superscript [Inline]
ss)      = (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain [Inline]
ss
plain (Subscript [Inline]
ss)        = (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain [Inline]
ss
plain (SmallCaps [Inline]
ss)        = (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain [Inline]
ss
plain (Quoted QuoteType
_ [Inline]
ss)         = (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain [Inline]
ss
plain (Cite [Citation]
_ [Inline]
ss)           = (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain [Inline]
ss  -- FIXME
plain (Code Attr
_ Text
s)            = Text -> String
T.unpack Text
s
plain Inline
Space                 = String
" "
plain Inline
SoftBreak             = String
" "
plain Inline
LineBreak             = String
"\n"
plain (Math MathType
_ Text
s)            = Text -> String
T.unpack Text
s
plain (RawInline Format
_ Text
_)       = String
""
plain (Link Attr
_ [Inline]
text (Text
url,Text
_)) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Inline -> String) -> [Inline] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> String
plain [Inline]
text [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
" <", Text -> String
T.unpack Text
url, String
">"])
plain (Image Attr
_ [Inline]
alt (Text, Text)
_)       = (Inline -> String) -> [Inline] -> String
forall a b. (a -> [b]) -> [a] -> [b]
cMap Inline -> String
plain [Inline]
alt
plain (Note [Block]
_)              = String
""  -- FIXME

-- | Create an XML element.
el :: (Node t)
   => String   -- ^ unqualified element name
   -> t        -- ^ node contents
   -> Content  -- ^ XML content
el :: String -> t -> Content
el String
name t
cs = Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ String -> t -> Element
forall t. Node t => String -> t -> Element
unode String
name t
cs

-- | Put empty lines around content
spaceBeforeAfter :: [Content] -> [Content]
spaceBeforeAfter :: [Content] -> [Content]
spaceBeforeAfter [Content]
cs =
    let emptyline :: Content
emptyline = String -> () -> Content
forall t. Node t => String -> t -> Content
el String
"empty-line" ()
    in  [Content
emptyline] [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
cs [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content
emptyline]

-- | Create a plain-text XML content.
txt :: Text -> Content
txt :: Text -> Content
txt Text
s = CData -> Content
Text (CData -> Content) -> CData -> Content
forall a b. (a -> b) -> a -> b
$ CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (Text -> String
T.unpack Text
s) Maybe Line
forall a. Maybe a
Nothing

-- | Create an XML attribute with an unqualified name.
uattr :: String -> Text -> Text.XML.Light.Attr
uattr :: String -> Text -> Attr
uattr String
name = QName -> String -> Attr
Attr (String -> QName
uname String
name) (String -> Attr) -> (Text -> String) -> Text -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | Create an XML attribute with a qualified name from given namespace.
attr :: (String, String) -> Text -> Text.XML.Light.Attr
attr :: (String, String) -> Text -> Attr
attr (String
ns, String
name) = QName -> String -> Attr
Attr (String -> String -> QName
qname String
ns String
name) (String -> Attr) -> (Text -> String) -> Text -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | Unqualified name
uname :: String -> QName
uname :: String -> QName
uname String
name = String -> Maybe String -> Maybe String -> QName
QName String
name Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing

-- | Qualified name
qname :: String -> String -> QName
qname :: String -> String -> QName
qname String
ns String
name = String -> Maybe String -> Maybe String -> QName
QName String
name Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
ns)

-- | Abbreviation for 'concatMap'.
cMap :: (a -> [b]) -> [a] -> [b]
cMap :: (a -> [b]) -> [a] -> [b]
cMap = (a -> [b]) -> [a] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap

-- | Monadic equivalent of 'concatMap'.
cMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
cMapM :: (a -> m [b]) -> [a] -> m [b]
cMapM a -> m [b]
f [a]
xs = [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[b]] -> [b]) -> m [[b]] -> m [b]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (a -> m [b]) -> [a] -> m [[b]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m [b]
f [a]
xs