------------------------------------------------------------------------------
-- |
-- Module      : QueueSheet.Build
-- Description : queue sheet build functions
-- Copyright   : Copyright (c) 2020-2025 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 :: String
buildDir = String
"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 :: String -> String -> Maybe String -> IO (Either String ())
buildPdf String
queuesPath String
templatePath Maybe String
mOutputPath = ExceptT String IO () -> IO (Either String ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO () -> IO (Either String ()))
-> ExceptT String IO () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ do
    QueueSheet
queueSheet <- IO (Either String QueueSheet) -> ExceptT String IO QueueSheet
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String QueueSheet) -> ExceptT String IO QueueSheet)
-> IO (Either String QueueSheet) -> ExceptT String IO QueueSheet
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String QueueSheet)
loadYaml String
queuesPath
    Template SourcePos
template <- IO (Either String (Template SourcePos))
-> ExceptT String IO (Template SourcePos)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String (Template SourcePos))
 -> ExceptT String IO (Template SourcePos))
-> IO (Either String (Template SourcePos))
-> ExceptT String IO (Template SourcePos)
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String (Template SourcePos))
loadTemplate String
templatePath
    Bool
exists <- IO Bool -> ExceptT String IO Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Bool -> ExceptT String IO Bool)
-> IO Bool -> ExceptT String IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesPathExist String
buildDir
    Bool -> ExceptT String IO () -> ExceptT String IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (ExceptT String IO () -> ExceptT String IO ())
-> (String -> ExceptT String IO ())
-> String
-> ExceptT String IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String IO ()) -> String -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$ String
"directory already exists: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
buildDir
    let outputPath :: String
outputPath = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String -> String
replaceExtension String
queuesPath String
"pdf") Maybe String
mOutputPath
        sourcePath :: String
sourcePath = String -> String
takeFileName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
replaceExtension String
outputPath String
"tex"
    IO (Either String ()) -> ExceptT String IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String ()) -> ExceptT String IO ())
-> (IO () -> IO (Either String ()))
-> IO ()
-> ExceptT String IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either IOError () -> Either String ())
-> IO (Either IOError ()) -> IO (Either String ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IOError -> String) -> Either IOError () -> Either String ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first IOError -> String
forall e. Exception e => e -> String
displayException) (IO (Either IOError ()) -> IO (Either String ()))
-> (IO () -> IO (Either IOError ()))
-> IO ()
-> IO (Either String ())
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 String IO ()) -> IO () -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$ do
      String -> IO ()
createDirectory String
buildDir
      String -> IO () -> IO ()
forall a. String -> IO a -> IO a
withCurrentDirectory String
buildDir (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> Template SourcePos -> QueueSheet -> IO ()
renderTemplate String
sourcePath Template SourcePos
template QueueSheet
queueSheet
        String -> [String] -> IO ()
Proc.callProcess String
"xelatex" [String
"-halt-on-error", String
sourcePath]
      String -> String -> IO ()
renameFile (String
buildDir String -> String -> String
</> String -> String
takeFileName String
outputPath) String
outputPath
      String -> IO ()
removeDirectoryRecursive String
buildDir