module MB.Processing ( applyPreProcessors , applyPostProcessors , getWriterOptions , getRawPostTitle , getPostTitle ) where import Control.Applicative ((<$>), (<*>), pure) import Data.Maybe (catMaybes) import qualified Text.Pandoc as Pandoc import MB.Types applyPreProcessors :: Blog -> Post -> IO Post applyPreProcessors b post = applyPreProcessors_ b post (processors b) applyPostProcessors :: Blog -> FilePath -> Page -> IO () applyPostProcessors b path pg = applyPostProcessors_ b path pg (processors b) applyPreProcessors_ :: Blog -> Post -> [Processor] -> IO Post applyPreProcessors_ _ post [] = return post applyPreProcessors_ b post (p:ps) = do post' <- case preProcessPost p of Nothing -> return post Just f -> f b post applyPreProcessors_ b post' ps applyPostProcessors_ :: Blog -> FilePath -> Page -> [Processor] -> IO () applyPostProcessors_ _ _ _ [] = return () applyPostProcessors_ b pth pg (p:ps) = do case postProcessPost p of Nothing -> return () Just f -> f b pth pg applyPostProcessors_ b pth pg ps getWriterOptions :: Blog -> Pandoc.WriterOptions -> Pandoc.WriterOptions getWriterOptions b = foldl (.) id (catMaybes $ applyWriterOptions <$> processors b) getRawPostTitle :: Blog -> Post -> String getRawPostTitle b p = head (fs ++ [fallback]) $ postTitle p where fallback = concat . (getInlineStr <$>) fs = catMaybes $ rawPostTitle <$> processors b getInlineStr :: Pandoc.Inline -> String getInlineStr (Pandoc.Str s) = s getInlineStr (Pandoc.Math _ s) = s getInlineStr Pandoc.Space = " " getInlineStr i = error $ "Unexpected inline in document title, got " ++ (show i) getPostTitle :: Blog -> Post -> Page -> String getPostTitle b p s = concat $ getInlineStr <$> f (postTitle p) where f = foldl (.) id (reverse $ fs <*> (pure s)) fs :: [Page -> [Pandoc.Inline] -> [Pandoc.Inline]] fs = catMaybes $ buildPostTitle <$> processors b