{-# LANGUAGE FlexibleContexts #-}

{- | Module for pretty-printing epub guide info

   Used internally by Codec.Epub.Format
-}
module Codec.Epub.Format.Guide
   ( formatGuide
   )
   where

import Control.Monad.Writer.Lazy ( MonadWriter, execWriter )
import Data.Foldable ( toList )
import Text.Printf ( printf )

import Codec.Epub.Format.Util
import Codec.Epub.Data.Guide


tellGuideRef :: MonadWriter (Seq Char) m => GuideRef -> m ()
tellGuideRef :: forall (m :: * -> *). MonadWriter (Seq Char) m => GuideRef -> m ()
tellGuideRef (GuideRef String
grty Maybe String
title String
href) =
   String -> m ()
forall a (m :: * -> *). MonadWriter (Seq a) m => [a] -> m ()
tellSeq (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"   type: %s%s, href: %s\n"
      String
grty (Maybe String -> String
titleToString Maybe String
title) String
href

   where
      titleToString :: Maybe String -> String
titleToString = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String -> String -> String
forall r. PrintfType r => String -> r
printf String
", title: %s")


tellGuide :: MonadWriter (Seq Char) m => [GuideRef] -> m ()
tellGuide :: forall (m :: * -> *).
MonadWriter (Seq Char) m =>
[GuideRef] -> m ()
tellGuide []  = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
tellGuide [GuideRef]
grs = do
   String -> m ()
forall a (m :: * -> *). MonadWriter (Seq a) m => [a] -> m ()
tellSeq String
"guide items:\n"
   (GuideRef -> m ()) -> [GuideRef] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GuideRef -> m ()
forall (m :: * -> *). MonadWriter (Seq Char) m => GuideRef -> m ()
tellGuideRef [GuideRef]
grs


{- | Format an epub Guide structure for pretty printing
-}
formatGuide :: [GuideRef] -> String
formatGuide :: [GuideRef] -> String
formatGuide [GuideRef]
guideRefs = Seq Char -> String
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Char -> String)
-> (Writer (Seq Char) () -> Seq Char)
-> Writer (Seq Char) ()
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer (Seq Char) () -> Seq Char
forall w a. Writer w a -> w
execWriter (Writer (Seq Char) () -> String) -> Writer (Seq Char) () -> String
forall a b. (a -> b) -> a -> b
$ [GuideRef] -> Writer (Seq Char) ()
forall (m :: * -> *).
MonadWriter (Seq Char) m =>
[GuideRef] -> m ()
tellGuide [GuideRef]
guideRefs