{-|
Module      : Hakyll.Process
Description : Common compilers and helpers for external executables.
Stability   : experimental
-}
module Hakyll.Process
    (
      newExtension
    , newExtOutFilePath
    , execName
    , execCompiler
    , execCompilerWith
    , unsafeExecCompiler
    , CompilerOut(..)
    , ExecutableArg(..)
    , ExecutableArgs
    , ExecutableName
    , OutFilePath(..)
    ) where

import qualified Data.ByteString.Lazy.Char8 as B
import           GHC.Conc                        (atomically)
import           Hakyll.Core.Item
import           Hakyll.Core.Compiler
import           System.Process.Typed

-- | Expected output from the external compiler.
data CompilerOut   =
  -- | Compiler uses stdout as the output type.
    CStdOut
  -- | Compiler outputs to a specific target file on the filesystem.
  | COutFile OutFilePath

-- | Arguments to provide to the process
data ExecutableArg =
  -- | Abstract representation of the path to the Hakyll item.
    HakFilePath
  -- | Literal argument to provide to the other process.
  | ProcArg String deriving (ReadPrec [ExecutableArg]
ReadPrec ExecutableArg
Int -> ReadS ExecutableArg
ReadS [ExecutableArg]
(Int -> ReadS ExecutableArg)
-> ReadS [ExecutableArg]
-> ReadPrec ExecutableArg
-> ReadPrec [ExecutableArg]
-> Read ExecutableArg
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecutableArg]
$creadListPrec :: ReadPrec [ExecutableArg]
readPrec :: ReadPrec ExecutableArg
$creadPrec :: ReadPrec ExecutableArg
readList :: ReadS [ExecutableArg]
$creadList :: ReadS [ExecutableArg]
readsPrec :: Int -> ReadS ExecutableArg
$creadsPrec :: Int -> ReadS ExecutableArg
Read, Int -> ExecutableArg -> ShowS
[ExecutableArg] -> ShowS
ExecutableArg -> String
(Int -> ExecutableArg -> ShowS)
-> (ExecutableArg -> String)
-> ([ExecutableArg] -> ShowS)
-> Show ExecutableArg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecutableArg] -> ShowS
$cshowList :: [ExecutableArg] -> ShowS
show :: ExecutableArg -> String
$cshow :: ExecutableArg -> String
showsPrec :: Int -> ExecutableArg -> ShowS
$cshowsPrec :: Int -> ExecutableArg -> ShowS
Show)

-- | Specifies the output file path of a process.
data OutFilePath   =
  -- | A specific, known filepath.
    SpecificPath FilePath
  -- | Indicates that the output path is related to the input path.
  | RelativePath (FilePath -> FilePath)

-- | Name of the executable if in the PATH or path to it if not
newtype ExecutableName = ExecutableName  String    deriving (ReadPrec [ExecutableName]
ReadPrec ExecutableName
Int -> ReadS ExecutableName
ReadS [ExecutableName]
(Int -> ReadS ExecutableName)
-> ReadS [ExecutableName]
-> ReadPrec ExecutableName
-> ReadPrec [ExecutableName]
-> Read ExecutableName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecutableName]
$creadListPrec :: ReadPrec [ExecutableName]
readPrec :: ReadPrec ExecutableName
$creadPrec :: ReadPrec ExecutableName
readList :: ReadS [ExecutableName]
$creadList :: ReadS [ExecutableName]
readsPrec :: Int -> ReadS ExecutableName
$creadsPrec :: Int -> ReadS ExecutableName
Read, Int -> ExecutableName -> ShowS
[ExecutableName] -> ShowS
ExecutableName -> String
(Int -> ExecutableName -> ShowS)
-> (ExecutableName -> String)
-> ([ExecutableName] -> ShowS)
-> Show ExecutableName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecutableName] -> ShowS
$cshowList :: [ExecutableName] -> ShowS
show :: ExecutableName -> String
$cshow :: ExecutableName -> String
showsPrec :: Int -> ExecutableName -> ShowS
$cshowsPrec :: Int -> ExecutableName -> ShowS
Show)
-- | Arguments to pass to the executable. Empty if none.
type ExecutableArgs    = [ExecutableArg]

-- | Helper function to indicate that the output file name is the same as the input file name with a new extension
-- Note: like hakyll, assumes that no "." is present in the extension
newExtension ::
     String   -- ^ New file extension, excluding the leading "."
  -> FilePath -- ^ Original FilePath
  -> FilePath
newExtension :: String -> ShowS
newExtension String
ext String
f = (ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
f) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ext

-- | Helper function to indicate that the output file name is the same as the input file name with a new extension
-- Note: like hakyll, assumes that no "." is present in the extension
newExtOutFilePath :: String -> CompilerOut
newExtOutFilePath :: String -> CompilerOut
newExtOutFilePath String
ext = OutFilePath -> CompilerOut
COutFile (OutFilePath -> CompilerOut) -> OutFilePath -> CompilerOut
forall a b. (a -> b) -> a -> b
$ ShowS -> OutFilePath
RelativePath (String -> ShowS
newExtension String
ext)

execName :: String -> ExecutableName
execName :: String -> ExecutableName
execName = String -> ExecutableName
ExecutableName

-- | Calls the external compiler with no arguments. Returns the output contents as a 'B.ByteString'.
--   If an error occurs this raises an exception.
--   May be useful if you already have build scripts for artifacts in your repository.
execCompiler     :: ExecutableName                   -> CompilerOut -> Compiler (Item B.ByteString)
execCompiler :: ExecutableName -> CompilerOut -> Compiler (Item ByteString)
execCompiler ExecutableName
name CompilerOut
out          = ExecutableName
-> [ExecutableArg] -> CompilerOut -> Compiler (Item ByteString)
execCompilerWith ExecutableName
name [] CompilerOut
out

-- | Calls the external compiler with the provided arguments. Returns the output contents as a 'B.ByteString'.
--   If an error occurs this raises an exception.
execCompilerWith :: ExecutableName -> ExecutableArgs -> CompilerOut -> Compiler (Item B.ByteString)
execCompilerWith :: ExecutableName
-> [ExecutableArg] -> CompilerOut -> Compiler (Item ByteString)
execCompilerWith ExecutableName
name [ExecutableArg]
exArgs CompilerOut
out = do
  String
input   <- Compiler String
getResourceFilePath
  let args :: [String]
args = (ExecutableArg -> String) -> [ExecutableArg] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ExecutableArg -> String
hargToArg String
input) [ExecutableArg]
exArgs
  let outputReader :: ByteString -> IO ByteString
outputReader = String -> CompilerOut -> ByteString -> IO ByteString
cOutToFileContents String
input CompilerOut
out
  ExecutableName
-> [String]
-> (ByteString -> IO ByteString)
-> Compiler (Item ByteString)
unsafeExecCompiler ExecutableName
name [String]
args ByteString -> IO ByteString
outputReader

-- | Primarily for internal use, occasionally useful when already building a compiler imperatively.
-- Allows the caller to opt out of the declarative components of 'execCompiler' and 'execCompilerWith'.
unsafeExecCompiler ::
       ExecutableName                    -- ^ Name or filepath of the executable
    -> [String]                          -- ^ Arguments to pass to the executable
    -> (B.ByteString -> IO B.ByteString) -- ^ Action to read the output of the compiler. Input is the stdout of the process.
    -> Compiler (Item B.ByteString)
unsafeExecCompiler :: ExecutableName
-> [String]
-> (ByteString -> IO ByteString)
-> Compiler (Item ByteString)
unsafeExecCompiler (ExecutableName String
exName) [String]
args ByteString -> IO ByteString
outputReader =
  do
    ByteString
results <- IO ByteString -> Compiler ByteString
forall a. IO a -> Compiler a
unsafeCompiler (IO ByteString -> Compiler ByteString)
-> IO ByteString -> Compiler ByteString
forall a b. (a -> b) -> a -> b
$ IO ByteString
procResults
    -- just using this to get at the item
    Item String
oldBody <- Compiler (Item String)
getResourceString
    Item ByteString -> Compiler (Item ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Item ByteString -> Compiler (Item ByteString))
-> Item ByteString -> Compiler (Item ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Item String -> Item ByteString
forall a b. a -> Item b -> Item a
itemSetBody ByteString
results Item String
oldBody
  where
  procResults :: IO ByteString
procResults = ProcessConfig () (STM ByteString) ()
-> (Process () (STM ByteString) () -> IO ByteString)
-> IO ByteString
forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessWait ProcessConfig () (STM ByteString) ()
procConf Process () (STM ByteString) () -> IO ByteString
forall stdin stderr.
Process stdin (STM ByteString) stderr -> IO ByteString
waitOutput
  procConf :: ProcessConfig () (STM ByteString) ()
procConf = StreamSpec 'STOutput (STM ByteString)
-> ProcessConfig () () () -> ProcessConfig () (STM ByteString) ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput (STM ByteString)
byteStringOutput (ProcessConfig () () () -> ProcessConfig () (STM ByteString) ())
-> ([String] -> ProcessConfig () () ())
-> [String]
-> ProcessConfig () (STM ByteString) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> ProcessConfig () () ()
proc String
exName ([String] -> ProcessConfig () (STM ByteString) ())
-> [String] -> ProcessConfig () (STM ByteString) ()
forall a b. (a -> b) -> a -> b
$ [String]
args
  waitOutput :: Process stdin (STM ByteString) stderr -> IO ByteString
waitOutput Process stdin (STM ByteString) stderr
process = do
    let stmProc :: STM ByteString
stmProc = Process stdin (STM ByteString) stderr -> STM ByteString
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process stdin (STM ByteString) stderr
process
    ByteString
out <- STM ByteString -> IO ByteString
forall a. STM a -> IO a
atomically STM ByteString
stmProc
    Process stdin (STM ByteString) stderr -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
checkExitCode Process stdin (STM ByteString) stderr
process
    ByteString -> IO ByteString
outputReader ByteString
out

--                 input fpath                   stdout contents
cOutToFileContents :: FilePath -> CompilerOut -> B.ByteString -> IO B.ByteString
cOutToFileContents :: String -> CompilerOut -> ByteString -> IO ByteString
cOutToFileContents String
_      CompilerOut
CStdOut ByteString
out                  = ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
out
cOutToFileContents String
_     (COutFile (SpecificPath String
f)) ByteString
_ = String -> IO ByteString
B.readFile  String
f
cOutToFileContents String
input (COutFile (RelativePath ShowS
f)) ByteString
_ = String -> IO ByteString
B.readFile (ShowS
f String
input)

hargToArg :: FilePath -> ExecutableArg -> String
hargToArg :: String -> ExecutableArg -> String
hargToArg String
_ (ProcArg String
s) = String
s
hargToArg String
f ExecutableArg
HakFilePath = String
f