{-# LANGUAGE FlexibleInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Text.BlogLiterately.Run
-- Copyright   :  (c) 2012-2013 Brent Yorgey
-- License     :  GPL (see LICENSE)
-- Maintainer  :  Brent Yorgey <byorgey@gmail.com>
--
-- Functions for creating @BlogLiterately@ executables.  By default,
-- installing this library results in the installation of a standard
-- executable, called @BlogLiterately@, which corresponds to
-- 'blogLiterately' from this module.  However, you can create your
-- own custom executables with extra custom functionality using
-- 'blogLiteratelyWith' or 'blogLiteratelyCustom'.  For example:
--
-- > module Main where
-- > import Text.BlogLiterately
-- >
-- > myCustomXF1 = pureTransform ...
-- > myCustomXF2 = Transform ...
-- > main = blogLiteratelyWith [myCustomXF1, myCustomXF2]
--
-- See "Text.BlogLiterately.Transform" for examples of transforms,
-- additional transforms which are not enabled by default, and help in
-- creating your own.
--
-----------------------------------------------------------------------------

module Text.BlogLiterately.Run
    (
      blogLiterately
    , blogLiteratelyWith
    , blogLiteratelyCustom

    ) where

import           System.Console.CmdArgs        (cmdArgs)

import           Text.BlogLiterately.Options   (blOpts, file')
import           Text.BlogLiterately.Post      (postIt)
import           Text.BlogLiterately.Transform (Transform, standardTransforms,
                                                xformDoc)

-- | The default BlogLiterately application.
blogLiterately :: IO ()
blogLiterately :: IO ()
blogLiterately = [Transform] -> IO ()
blogLiteratelyCustom [Transform]
standardTransforms

-- | Like 'blogLiterately', but with the ability to specify additional
-- 'Transform's which will be applied /after/ the standard ones.
blogLiteratelyWith :: [Transform] -> IO ()
blogLiteratelyWith :: [Transform] -> IO ()
blogLiteratelyWith = [Transform] -> IO ()
blogLiteratelyCustom forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Transform]
standardTransforms forall a. [a] -> [a] -> [a]
++)

-- | Like 'blogLiterately', but with the ability to /replace/ the
--   standard 'Transform's.  Use this to implement custom interleaving
--   orders of the standard transforms and your own, to exclude some
--   or all of the standard transforms, etc.
blogLiteratelyCustom :: [Transform] -> IO ()
blogLiteratelyCustom :: [Transform] -> IO ()
blogLiteratelyCustom [Transform]
ts = do
  BlogLiterately
bl  <- forall a. Data a => a -> IO a
cmdArgs BlogLiterately
blOpts
  String
doc <- String -> IO String
readFile (BlogLiterately -> String
file' BlogLiterately
bl)
  Either PandocError (BlogLiterately, String)
res <- BlogLiterately
-> [Transform]
-> String
-> IO (Either PandocError (BlogLiterately, String))
xformDoc BlogLiterately
bl [Transform]
ts String
doc
  case Either PandocError (BlogLiterately, String)
res of
    Left PandocError
err -> String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Pandoc error: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PandocError
err
    Right (BlogLiterately
bl',String
doc') -> BlogLiterately -> String -> IO ()
postIt BlogLiterately
bl' String
doc'