{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- | Defines convenience recipes for reading and writing documents with pandoc.
module Achille.Recipe.Pandoc
    ( readPandoc
    , readPandocWith
    , readPandocMetadata
    , readPandocMetadataWith
    , renderPandoc
    , renderPandocWith
    , compilePandoc
    , compilePandocWith
    ) where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Binary      (Binary, encodeFile)
import Data.Functor     (void)
import Data.Text        (Text, pack)
import Data.Text.Encoding (decodeUtf8)
import System.Directory (copyFile, createDirectoryIfMissing, withCurrentDirectory)

import System.FilePath
import Text.Pandoc      hiding (nonCached)
import Data.Aeson.Types (FromJSON)
import Data.Frontmatter (parseYamlFrontmatter, IResult(..))

import qualified Data.Text.IO                     as Text
import qualified System.FilePath.Glob             as Glob
import qualified Data.ByteString                  as ByteString
import qualified Data.ByteString.Lazy             as LazyByteString
import qualified System.FilePath                  as Path
import qualified System.Process                   as Process

import           Achille.Config
import           Achille.Internal hiding (currentDir)
import qualified Achille.Internal as Internal
import           Achille.Recipe
import           Achille.Writable as Writable
import           Achille.Internal.IO (AchilleIO)


-- | Recipe for loading a pandoc document
readPandoc :: MonadIO m
           => Recipe m FilePath Pandoc
readPandoc :: Recipe m FilePath Pandoc
readPandoc = ReaderOptions -> Recipe m FilePath Pandoc
forall (m :: * -> *).
MonadIO m =>
ReaderOptions -> Recipe m FilePath Pandoc
readPandocWith ReaderOptions
forall a. Default a => a
def

-- | Recipe for loading a pandoc document using a given reader config
readPandocWith :: MonadIO m
               => ReaderOptions -> Recipe m FilePath Pandoc
readPandocWith :: ReaderOptions -> Recipe m FilePath Pandoc
readPandocWith ropts :: ReaderOptions
ropts = (Context FilePath -> m Pandoc) -> Recipe m FilePath Pandoc
forall (m :: * -> *) a b.
Functor m =>
(Context a -> m b) -> Recipe m a b
nonCached \Context{..}  ->
    let ext :: FilePath
ext = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop 1 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeExtension FilePath
inputValue
        Just reader :: Reader PandocIO
reader = Text -> [(Text, Reader PandocIO)] -> Maybe (Reader PandocIO)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath -> Text
pack FilePath
ext) [(Text, Reader PandocIO)]
forall (m :: * -> *). PandocMonad m => [(Text, Reader m)]
readers
    in case Reader PandocIO
reader of
        ByteStringReader f :: ReaderOptions -> Cache -> PandocIO Pandoc
f -> IO Pandoc -> m Pandoc
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pandoc -> m Pandoc) -> IO Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ 
            FilePath -> IO Cache
LazyByteString.readFile (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir FilePath -> FilePath -> FilePath
</> FilePath
inputValue)
                IO Cache -> (Cache -> IO Pandoc) -> IO Pandoc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PandocIO Pandoc -> IO Pandoc
forall a. PandocIO a -> IO a
runIOorExplode (PandocIO Pandoc -> IO Pandoc)
-> (Cache -> PandocIO Pandoc) -> Cache -> IO Pandoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderOptions -> Cache -> PandocIO Pandoc
f ReaderOptions
ropts
        TextReader f :: ReaderOptions -> Text -> PandocIO Pandoc
f -> IO Pandoc -> m Pandoc
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pandoc -> m Pandoc) -> IO Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$
            FilePath -> IO Text
Text.readFile (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir FilePath -> FilePath -> FilePath
</> FilePath
inputValue)
                IO Text -> (Text -> IO Pandoc) -> IO Pandoc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PandocIO Pandoc -> IO Pandoc
forall a. PandocIO a -> IO a
runIOorExplode (PandocIO Pandoc -> IO Pandoc)
-> (Text -> PandocIO Pandoc) -> Text -> IO Pandoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderOptions -> Text -> PandocIO Pandoc
f ReaderOptions
ropts

-- | Recipe for loading a pandoc document and a frontmatter header.
readPandocMetadata :: (MonadIO m, MonadFail m, FromJSON a)
                   => Recipe m FilePath (a, Pandoc)
readPandocMetadata :: Recipe m FilePath (a, Pandoc)
readPandocMetadata = ReaderOptions -> Recipe m FilePath (a, Pandoc)
forall (m :: * -> *) a.
(MonadIO m, MonadFail m, FromJSON a) =>
ReaderOptions -> Recipe m FilePath (a, Pandoc)
readPandocMetadataWith ReaderOptions
forall a. Default a => a
def

-- | Recipe for loading a pandoc document using a given reader config
readPandocMetadataWith :: (MonadIO m, MonadFail m, FromJSON a)
                       => ReaderOptions -> Recipe m FilePath (a, Pandoc)
readPandocMetadataWith :: ReaderOptions -> Recipe m FilePath (a, Pandoc)
readPandocMetadataWith ropts :: ReaderOptions
ropts = (Context FilePath -> m (a, Pandoc))
-> Recipe m FilePath (a, Pandoc)
forall (m :: * -> *) a b.
Functor m =>
(Context a -> m b) -> Recipe m a b
nonCached \Context{..} -> do
    let ext :: FilePath
ext         = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop 1 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeExtension FilePath
inputValue
        Just reader :: Reader PandocIO
reader = Text -> [(Text, Reader PandocIO)] -> Maybe (Reader PandocIO)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath -> Text
pack FilePath
ext) [(Text, Reader PandocIO)]
forall (m :: * -> *). PandocMonad m => [(Text, Reader m)]
readers
    ByteString
contents <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
ByteString.readFile (FilePath
inputDir FilePath -> FilePath -> FilePath
</> FilePath
currentDir FilePath -> FilePath -> FilePath
</> FilePath
inputValue)
    (meta :: a
meta, remaining :: ByteString
remaining) <-
            case ByteString -> Result a
forall a. FromJSON a => ByteString -> Result a
parseYamlFrontmatter ByteString
contents of
                Done i :: ByteString
i a :: a
a -> (a, ByteString) -> m (a, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, ByteString
i)
                _        -> FilePath -> m (a, ByteString)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m (a, ByteString)) -> FilePath -> m (a, ByteString)
forall a b. (a -> b) -> a -> b
$ "error while loading meta of " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
inputValue
    (a
meta,) (Pandoc -> (a, Pandoc)) -> m Pandoc -> m (a, Pandoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Reader PandocIO
reader of
        ByteStringReader f :: ReaderOptions -> Cache -> PandocIO Pandoc
f -> IO Pandoc -> m Pandoc
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pandoc -> m Pandoc) -> IO Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$
            PandocIO Pandoc -> IO Pandoc
forall a. PandocIO a -> IO a
runIOorExplode (PandocIO Pandoc -> IO Pandoc) -> PandocIO Pandoc -> IO Pandoc
forall a b. (a -> b) -> a -> b
$ ReaderOptions -> Cache -> PandocIO Pandoc
f ReaderOptions
ropts (ByteString -> Cache
LazyByteString.fromStrict ByteString
remaining)
        TextReader f :: ReaderOptions -> Text -> PandocIO Pandoc
f -> IO Pandoc -> m Pandoc
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pandoc -> m Pandoc) -> IO Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$
            PandocIO Pandoc -> IO Pandoc
forall a. PandocIO a -> IO a
runIOorExplode (PandocIO Pandoc -> IO Pandoc) -> PandocIO Pandoc -> IO Pandoc
forall a b. (a -> b) -> a -> b
$ ReaderOptions -> Text -> PandocIO Pandoc
f ReaderOptions
ropts (ByteString -> Text
decodeUtf8 ByteString
remaining)

-- | Recipe to convert a Pandoc document to HTML.
renderPandoc :: MonadIO m
             => Pandoc -> Recipe m a Text
renderPandoc :: Pandoc -> Recipe m a Text
renderPandoc = WriterOptions -> Pandoc -> Recipe m a Text
forall (m :: * -> *) a.
MonadIO m =>
WriterOptions -> Pandoc -> Recipe m a Text
renderPandocWith WriterOptions
forall a. Default a => a
def 

-- | Recipe to convert a Pandoc document to HTML using specified writer options.
renderPandocWith :: MonadIO m
                 => WriterOptions -> Pandoc -> Recipe m a Text
renderPandocWith :: WriterOptions -> Pandoc -> Recipe m a Text
renderPandocWith wopts :: WriterOptions
wopts = IO Text -> Recipe m a Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> Recipe m a Text)
-> (PandocIO Text -> IO Text) -> PandocIO Text -> Recipe m a Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocIO Text -> IO Text
forall a. PandocIO a -> IO a
runIOorExplode (PandocIO Text -> Recipe m a Text)
-> (Pandoc -> PandocIO Text) -> Pandoc -> Recipe m a Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
wopts

-- | Recipe to load and convert a Pandoc document to HTML.
compilePandoc :: MonadIO m
              => Recipe m FilePath Text
compilePandoc :: Recipe m FilePath Text
compilePandoc = Recipe m FilePath Pandoc
forall (m :: * -> *). MonadIO m => Recipe m FilePath Pandoc
readPandoc Recipe m FilePath Pandoc
-> (Pandoc -> Recipe m FilePath Text) -> Recipe m FilePath Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pandoc -> Recipe m FilePath Text
forall (m :: * -> *) a. MonadIO m => Pandoc -> Recipe m a Text
renderPandoc

-- | Recipe to load and convert a Pandoc document to HTML.
compilePandocWith :: MonadIO m
                  => ReaderOptions -> WriterOptions -> Recipe m FilePath Text
compilePandocWith :: ReaderOptions -> WriterOptions -> Recipe m FilePath Text
compilePandocWith ropts :: ReaderOptions
ropts wopts :: WriterOptions
wopts =
    ReaderOptions -> Recipe m FilePath Pandoc
forall (m :: * -> *).
MonadIO m =>
ReaderOptions -> Recipe m FilePath Pandoc
readPandocWith ReaderOptions
ropts Recipe m FilePath Pandoc
-> (Pandoc -> Recipe m FilePath Text) -> Recipe m FilePath Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> Pandoc -> Recipe m FilePath Text
forall (m :: * -> *) a.
MonadIO m =>
WriterOptions -> Pandoc -> Recipe m a Text
renderPandocWith WriterOptions
wopts