@@ -38,8 +38,8 @@ FictionBook is an XML-based e-book format. For more information see:
3838module Text.Pandoc.Writers.FB2 (writeFB2) where
3939
4040import Control.Monad.Except (catchError)
41−import Control.Monad.State.Strict (StateT, evalStateT, get, lift, modify)
42−import Control.Monad.State.Strict (liftM)
41+import Control.Monad.State.Strict (StateT, evalStateT, get, lift, modify, liftM)
42+import Control.Monad (zipWithM)
4343import Data.ByteString.Base64 (encode)
4444import qualified Data.ByteString.Char8 as B8
4545import Data.Char (isAscii, isControl, isSpace, toLower)
@@ -100,10 +100,10 @@ pandocToFB2 opts (Pandoc meta blocks) = do
100100 secs <- renderSections 1 blocks
101101 let body = el "body" $ fp ++ secs
102102 notes <- renderFootnotes
103− (imgs,missing) <- liftM imagesToFetch get >>= \s -> lift (fetchImages s)
103+ (imgs,missing) <- fmap imagesToFetch get >>= \s -> lift (fetchImages s)
104104 let body' = replaceImagesWithAlt missing body
105105 let fb2_xml = el "FictionBook" (fb2_attrs, [desc, body'] ++ notes ++ imgs)
106− return $ pack $ xml_head ++ (showContent fb2_xml) ++ "\n"
106+ return $ pack $ xml_head ++ showContent fb2_xml ++ "\n"
107107 where
108108 xml_head = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
109109 fb2_attrs =
@@ -115,7 +115,7 @@ pandocToFB2 opts (Pandoc meta blocks) = do
115115frontpage :: PandocMonad m => Meta -> FBM m [Content]
116116frontpage meta' = do
117117 t <- cMapM toXml . docTitle $ meta'
118− return $
118+ return
119119 [ el "title" (el "p" t)
120120 , el "annotation" (map (el "p" . cMap plain)
121121 (docAuthors meta' ++ [docDate meta']))
@@ -131,7 +131,7 @@ description meta' = do
131131 Just (MetaString s) -> [el "lang" $ iso639 s]
132132 _ -> []
133133 where iso639 = takeWhile (/= '-') -- Convert BCP 47 to ISO 639
134− return $ el "description" $
134+ return $ el "description"
135135 [ el "title-info" (bt ++ as ++ dd ++ lang)
136136 , el "document-info" [ el "program-used" "pandoc" ] -- FIXME: +version
137137 ]
@@ -149,16 +149,16 @@ authors meta' = cMap author (docAuthors meta')
149149author :: [Inline] -> [Content]
150150author ss =
151151 let ws = words . cMap plain $ ss
152− email = (el "email") `fmap` (take 1 $ filter ('@' `elem`) ws)
152+ email = el "email" <$> take 1 (filter ('@' `elem`) ws)
153153 ws' = filter ('@' `notElem`) ws
154154 names = case ws' of
155− (nickname:[]) -> [ el "nickname" nickname ]
156− (fname:lname:[]) -> [ el "first-name" fname
155+ [nickname] -> [ el "nickname" nickname ]
156+ [fname, lname] -> [ el "first-name" fname
157157 , el "last-name" lname ]
158158 (fname:rest) -> [ el "first-name" fname
159159 , el "middle-name" (concat . init $ rest)
160160 , el "last-name" (last rest) ]
161− ([]) -> []
161+ [] -> []
162162 in list $ el "author" (names ++ email)
163163
164164docdate :: PandocMonad m => Meta -> FBM m [Content]
@@ -181,7 +181,7 @@ renderSection level (ttl, body) = do
181181 title <- if null ttl
182182 then return []
183183 else return . list . el "title" . formatTitle $ ttl
184− content <- if (hasSubsections body)
184+ content <- if hasSubsections body
185185 then renderSections (level + 1) body
186186 else cMapM blockToXml body
187187 return $ el "section" (title ++ content)
@@ -213,7 +213,7 @@ splitSections level blocks = reverse $ revSplit (reverse blocks)
213213 let (lastsec, before) = break sameLevel rblocks
214214 (header, prevblocks) =
215215 case before of
216− ((Header n _ title):prevblocks') ->
216+ (Header n _ title:prevblocks') ->
217217 if n == level
218218 then (title, prevblocks')
219219 else ([], before)
@@ -232,7 +232,7 @@ renderFootnotes = do
232232 el "body" ([uattr "name" "notes"], map renderFN (reverse fns))
233233 where
234234 renderFN (n, idstr, cs) =
235− let fn_texts = (el "title" (el "p" (show n))) : cs
235+ let fn_texts = el "title" (el "p" (show n)) : cs
236236 in el "section" ([uattr "id" idstr], fn_texts)
237237
238238-- | Fetch images and encode them for the FictionBook XML.
@@ -240,7 +240,7 @@ renderFootnotes = do
240240fetchImages :: PandocMonad m => [(String,String)] -> m ([Content],[String])
241241fetchImages links = do
242242 imgs <- mapM (uncurry fetchImage) links
243− return $ (rights imgs, lefts imgs)
243+ return (rights imgs, lefts imgs)
244244
245245-- | Fetch image data from disk or from network and make a <binary> XML section.
246246-- Return either (Left hrefOfMissingImage) or (Right xmlContent).
@@ -254,7 +254,7 @@ fetchImage href link = do
254254 then return (Just (mime',base64))
255255 else return Nothing
256256 (True, Just _) -> return Nothing -- not base64-encoded
257− _ -> do
257+ _ ->
258258 catchError (do (bs, mbmime) <- P.fetchItem link
259259 case mbmime of
260260 Nothing -> do
@@ -266,7 +266,7 @@ fetchImage href link = do
266266 do report $ CouldNotFetchResource link (show e)
267267 return Nothing)
268268 case mbimg of
269− Just (imgtype, imgdata) -> do
269+ Just (imgtype, imgdata) ->
270270 return . Right $ el "binary"
271271 ( [uattr "id" href
272272 , uattr "content-type" imgtype]
@@ -300,8 +300,8 @@ isMimeType :: String -> Bool
300300isMimeType s =
301301 case split (=='/') s of
302302 [mtype,msubtype] ->
303− ((map toLower mtype) `elem` types
304− || "x-" `isPrefixOf` (map toLower mtype))
303+ (map toLower mtype `elem` types
304+ || "x-" `isPrefixOf` map toLower mtype)
305305 && all valid mtype
306306 && all valid msubtype
307307 _ -> False
@@ -311,10 +311,10 @@ isMimeType s =
311311 c `notElem` "()<>@,;:\\\"/[]?="
312312
313313footnoteID :: Int -> String
314−footnoteID i = "n" ++ (show i)
314+footnoteID i = "n" ++ show i
315315
316316linkID :: Int -> String
317−linkID i = "l" ++ (show i)
317+linkID i = "l" ++ show i
318318
319319-- | Convert a block-level Pandoc's element to FictionBook XML representation.
320320blockToXml :: PandocMonad m => Block -> FBM m [Content]
@@ -323,14 +323,14 @@ blockToXml (Para [Math DisplayMath formula]) = insertMath NormalImage formula
323323-- title beginning with fig: indicates that the image is a figure
324324blockToXml (Para [Image atr alt (src,'f':'i':'g':':':tit)]) =
325325 insertImage NormalImage (Image atr alt (src,tit))
326−blockToXml (Para ss) = liftM (list . el "p") $ cMapM toXml ss
326+blockToXml (Para ss) = (list . el "p") <$> cMapM toXml ss
327327blockToXml (CodeBlock _ s) = return . spaceBeforeAfter .
328328 map (el "p" . el "code") . lines $ s
329329blockToXml b@(RawBlock _ _) = do
330330 report $ BlockNotRendered b
331331 return []
332332blockToXml (Div _ bs) = cMapM blockToXml bs
333−blockToXml (BlockQuote bs) = liftM (list . el "cite") $ cMapM blockToXml bs
333+blockToXml (BlockQuote bs) = (list . el "cite") <$> cMapM blockToXml bs
334334blockToXml (LineBlock lns) = blockToXml $ linesToPara lns
335335blockToXml (OrderedList a bss) = do
336336 state <- get
@@ -341,19 +341,19 @@ blockToXml (OrderedList a bss) = do
341341 itemtext <- cMapM blockToXml . paraToPlain $ bs
342342 modify (\s -> s { parentListMarker = pmrk }) -- old parent marker
343343 return . el "p" $ [ txt mrk, txt " " ] ++ itemtext
344− mapM (uncurry mkitem) (zip markers bss)
344+ zipWithM mkitem markers bss
345345blockToXml (BulletList bss) = do
346346 state <- get
347347 let level = parentBulletLevel state
348348 let pmrk = parentListMarker state
349349 let prefix = replicate (length pmrk) ' '
350350 let bullets = ["\x2022", "\x25e6", "*", "\x2043", "\x2023"]
351− let mrk = prefix ++ bullets !! (level `mod` (length bullets))
351+ let mrk = prefix ++ bullets !! (level `mod` length bullets)
352352 let mkitem bs = do
353− modify (\s -> s { parentBulletLevel = (level+1) })
353+ modify (\s -> s { parentBulletLevel = level+1 })
354354 itemtext <- cMapM blockToXml . paraToPlain $ bs
355355 modify (\s -> s { parentBulletLevel = level }) -- restore bullet level
356− return $ el "p" $ [ txt (mrk ++ " ") ] ++ itemtext
356+ return $ el "p" $ txt (mrk ++ " ") : itemtext
357357 mapM mkitem bss
358358blockToXml (DefinitionList defs) =
359359 cMapM mkdef defs
@@ -370,7 +370,7 @@ blockToXml (DefinitionList defs) =
370370 needsBreak (Para _) = False
371371 needsBreak (Plain ins) = LineBreak `notElem` ins
372372 needsBreak _ = True
373−blockToXml h@(Header _ _ _) = do
373+blockToXml h@Header{} = do
374374 -- should not occur after hierarchicalize, except inside lists/blockquotes
375375 report $ BlockNotRendered h
376376 return []
@@ -381,12 +381,12 @@ blockToXml HorizontalRule = return
381381blockToXml (Table caption aligns _ headers rows) = do
382382 hd <- mkrow "th" headers aligns
383383 bd <- mapM (\r -> mkrow "td" r aligns) rows
384− c <- return . el "emphasis" =<< cMapM toXml caption
384+ c <- el "emphasis" <$> cMapM toXml caption
385385 return [el "table" (hd : bd), el "p" c]
386386 where
387387 mkrow :: PandocMonad m => String -> [TableCell] -> [Alignment] -> FBM m Content
388388 mkrow tag cells aligns' =
389− (el "tr") `liftM` (mapM (mkcell tag) (zip cells aligns'))
389+ el "tr" <$> mapM (mkcell tag) (zip cells aligns')
390390 --
391391 mkcell :: PandocMonad m => String -> (TableCell, Alignment) -> FBM m Content
392392 mkcell tag (cell, align) = do
@@ -405,7 +405,7 @@ blockToXml Null = return []
405405paraToPlain :: [Block] -> [Block]
406406paraToPlain [] = []
407407paraToPlain (Para inlines : rest) =
408− let p = (Plain (inlines ++ [LineBreak]))
408+ let p = Plain (inlines ++ [LineBreak])
409409 in p : paraToPlain rest
410410paraToPlain (p:rest) = p : paraToPlain rest
411411
@@ -418,8 +418,8 @@ indent = indentBlock
418418 spacer :: String
419419 spacer = replicate 4 ' '
420420 --
421− indentBlock (Plain ins) = Plain ((Str spacer):ins)
422− indentBlock (Para ins) = Para ((Str spacer):ins)
421+ indentBlock (Plain ins) = Plain (Str spacer:ins)
422+ indentBlock (Para ins) = Para (Str spacer:ins)
423423 indentBlock (CodeBlock a s) =
424424 let s' = unlines . map (spacer++) . lines $ s
425425 in CodeBlock a s'
@@ -429,7 +429,7 @@ indent = indentBlock
429429 -- indent every (explicit) line
430430 indentLines :: [Inline] -> [Inline]
431431 indentLines ins = let lns = split isLineBreak ins :: [[Inline]]
432− in intercalate [LineBreak] $ map ((Str spacer):) lns
432+ in intercalate [LineBreak] $ map (Str spacer:) lns
433433
434434-- | Convert a Pandoc's Inline element to FictionBook XML representation.
435435toXml :: PandocMonad m => Inline -> FBM m [Content]
@@ -473,7 +473,7 @@ toXml (Link _ text (url,ttl)) = do
473473 ( [ attr ("l","href") ('#':ln_id)
474474 , uattr "type" "note" ]
475475 , ln_ref) ]
476−toXml img@(Image _ _ _) = insertImage InlineImage img
476+toXml img@Image{} = insertImage InlineImage img
477477toXml (Note bs) = do
478478 fns <- footnotes `liftM` get
479479 let n = 1 + length fns
@@ -487,7 +487,7 @@ toXml (Note bs) = do
487487
488488insertMath :: PandocMonad m => ImageMode -> String -> FBM m [Content]
489489insertMath immode formula = do
490− htmlMath <- return . writerHTMLMathMethod . writerOptions =<< get
490+ htmlMath <- fmap (writerHTMLMathMethod . writerOptions) get
491491 case htmlMath of
492492 WebTeX url -> do
493493 let alt = [Code nullAttr formula]
@@ -531,17 +531,17 @@ replaceImagesWithAlt missingHrefs body =
531531 Nothing -> c' -- end of document
532532 --
533533 isImage :: Content -> Bool
534− isImage (Elem e) = (elName e) == (uname "image")
534+ isImage (Elem e) = elName e == uname "image"
535535 isImage _ = False
536536 --
537− isMissing (Elem img@(Element _ _ _ _)) =
537+ isMissing (Elem img@Element{}) =
538538 let imgAttrs = elAttribs img
539539 badAttrs = map (attr ("l","href")) missingHrefs
540540 in any (`elem` imgAttrs) badAttrs
541541 isMissing _ = False
542542 --
543543 replaceNode :: Content -> Content
544− replaceNode n@(Elem img@(Element _ _ _ _)) =
544+ replaceNode n@(Elem img@Element{}) =
545545 let attrs = elAttribs img
546546 alt = getAttrVal attrs (uname "alt")
547547 imtype = getAttrVal attrs (qname "l" "type")
@@ -572,15 +572,15 @@ list = (:[])
572572-- | Convert an 'Inline' to plaintext.
573573plain :: Inline -> String
574574plain (Str s) = s
575−plain (Emph ss) = concat (map plain ss)
576−plain (Span _ ss) = concat (map plain ss)
577−plain (Strong ss) = concat (map plain ss)
578−plain (Strikeout ss) = concat (map plain ss)
579−plain (Superscript ss) = concat (map plain ss)
580−plain (Subscript ss) = concat (map plain ss)
581−plain (SmallCaps ss) = concat (map plain ss)
582−plain (Quoted _ ss) = concat (map plain ss)
583−plain (Cite _ ss) = concat (map plain ss) -- FIXME
575+plain (Emph ss) = concatMap plain ss
576+plain (Span _ ss) = concatMap plain ss
577+plain (Strong ss) = concatMap plain ss
578+plain (Strikeout ss) = concatMap plain ss
579+plain (Superscript ss) = concatMap plain ss
580+plain (Subscript ss) = concatMap plain ss
581+plain (SmallCaps ss) = concatMap plain ss
582+plain (Quoted _ ss) = concatMap plain ss
583+plain (Cite _ ss) = concatMap plain ss -- FIXME
584584plain (Code _ s) = s
585585plain Space = " "
586586plain SoftBreak = " "
@@ -588,7 +588,7 @@ plain LineBreak = "\n"
588588plain (Math _ s) = s
589589plain (RawInline _ _) = ""
590590plain (Link _ text (url,_)) = concat (map plain text ++ [" <", url, ">"])
591−plain (Image _ alt _) = concat (map plain alt)
591+plain (Image _ alt _) = concatMap plain alt
592592plain (Note _) = "" -- FIXME
593593
594594-- | Create an XML element.
@@ -610,11 +610,11 @@ txt s = Text $ CData CDataText s Nothing
610610
611611-- | Create an XML attribute with an unqualified name.
612612uattr :: String -> String -> Text.XML.Light.Attr
613−uattr name val = Attr (uname name) val
613+uattr name = Attr (uname name)
614614
615615-- | Create an XML attribute with a qualified name from given namespace.
616616attr :: (String, String) -> String -> Text.XML.Light.Attr
617−attr (ns, name) val = Attr (qname ns name) val
617+attr (ns, name) = Attr (qname ns name)
618618
619619-- | Unqualified name
620620uname :: String -> QName