------------------------------------------------------------------------------
-- |
-- Module      : QueueSheet.Build
-- Description : queue sheet build functions
-- Copyright   : Copyright (c) 2020-2022 Travis Cardwell
-- License     : MIT
------------------------------------------------------------------------------

module QueueSheet.Build
  ( -- * API
    buildPdf
  ) where

-- https://hackage.haskell.org/package/base
import Control.Exception (displayException)
import Control.Monad (when)
import Data.Bifunctor (first)
import Data.Maybe (fromMaybe)
import System.IO.Error (tryIOError)

-- https://hackage.haskell.org/package/directory
import System.Directory
  ( createDirectory, doesPathExist, removeDirectoryRecursive, renameFile
  , withCurrentDirectory
  )

-- https://hackage.haskell.org/package/filepath
import System.FilePath ((</>), replaceExtension, takeFileName)

-- https://hackage.haskell.org/package/process
import qualified System.Process as Proc

-- https://hackage.haskell.org/package/transformers
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT, throwE)

-- (queue-sheet)
import QueueSheet.File (loadYaml)
import QueueSheet.Template (loadTemplate, renderTemplate)

------------------------------------------------------------------------------
-- $Constants

-- | Build directory name
--
-- @since 0.3.0.0
buildDir :: FilePath
buildDir :: FilePath
buildDir = FilePath
"queue-sheet-build"

------------------------------------------------------------------------------
-- $API

-- | Build a PDF
--
-- @since 0.3.0.0
buildPdf
  :: FilePath        -- ^ queues path
  -> FilePath        -- ^ template path
  -> Maybe FilePath  -- ^ output path (default: queues path w/ .pdf extension)
  -> IO (Either String ())
buildPdf :: FilePath -> FilePath -> Maybe FilePath -> IO (Either FilePath ())
buildPdf FilePath
queuesPath FilePath
templatePath Maybe FilePath
mOutputPath = ExceptT FilePath IO () -> IO (Either FilePath ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FilePath IO () -> IO (Either FilePath ()))
-> ExceptT FilePath IO () -> IO (Either FilePath ())
forall a b. (a -> b) -> a -> b
$ do
    QueueSheet
queueSheet <- IO (Either FilePath QueueSheet) -> ExceptT FilePath IO QueueSheet
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either FilePath QueueSheet) -> ExceptT FilePath IO QueueSheet)
-> IO (Either FilePath QueueSheet)
-> ExceptT FilePath IO QueueSheet
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either FilePath QueueSheet)
loadYaml FilePath
queuesPath
    Template SourcePos
template <- IO (Either FilePath (Template SourcePos))
-> ExceptT FilePath IO (Template SourcePos)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either FilePath (Template SourcePos))
 -> ExceptT FilePath IO (Template SourcePos))
-> IO (Either FilePath (Template SourcePos))
-> ExceptT FilePath IO (Template SourcePos)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either FilePath (Template SourcePos))
loadTemplate FilePath
templatePath
    Bool
exists <- IO Bool -> ExceptT FilePath IO Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Bool -> ExceptT FilePath IO Bool)
-> IO Bool -> ExceptT FilePath IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesPathExist FilePath
buildDir
    Bool -> ExceptT FilePath IO () -> ExceptT FilePath IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (ExceptT FilePath IO () -> ExceptT FilePath IO ())
-> (FilePath -> ExceptT FilePath IO ())
-> FilePath
-> ExceptT FilePath IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ExceptT FilePath IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (FilePath -> ExceptT FilePath IO ())
-> FilePath -> ExceptT FilePath IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"directory already exists: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
buildDir
    let outputPath :: FilePath
outputPath = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> FilePath -> FilePath
replaceExtension FilePath
queuesPath FilePath
"pdf") Maybe FilePath
mOutputPath
        sourcePath :: FilePath
sourcePath = FilePath -> FilePath
takeFileName (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
replaceExtension FilePath
outputPath FilePath
"tex"
    IO (Either FilePath ()) -> ExceptT FilePath IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either FilePath ()) -> ExceptT FilePath IO ())
-> (IO () -> IO (Either FilePath ()))
-> IO ()
-> ExceptT FilePath IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either IOError () -> Either FilePath ())
-> IO (Either IOError ()) -> IO (Either FilePath ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IOError -> FilePath) -> Either IOError () -> Either FilePath ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first IOError -> FilePath
forall e. Exception e => e -> FilePath
displayException) (IO (Either IOError ()) -> IO (Either FilePath ()))
-> (IO () -> IO (Either IOError ()))
-> IO ()
-> IO (Either FilePath ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (Either IOError ())
forall a. IO a -> IO (Either IOError a)
tryIOError (IO () -> ExceptT FilePath IO ())
-> IO () -> ExceptT FilePath IO ()
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> IO ()
createDirectory FilePath
buildDir
      FilePath -> IO () -> IO ()
forall a. FilePath -> IO a -> IO a
withCurrentDirectory FilePath
buildDir (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        FilePath -> Template SourcePos -> QueueSheet -> IO ()
renderTemplate FilePath
sourcePath Template SourcePos
template QueueSheet
queueSheet
        FilePath -> [FilePath] -> IO ()
Proc.callProcess FilePath
"xelatex" [FilePath
"-halt-on-error", FilePath
sourcePath]
      FilePath -> FilePath -> IO ()
renameFile (FilePath
buildDir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
outputPath) FilePath
outputPath
      FilePath -> IO ()
removeDirectoryRecursive FilePath
buildDir