{-# LANGUAGE CPP #-}

--------------------------------------------------------------------------------
-- | A Compiler that supports unix filters.
module Hakyll.Core.UnixFilter
    ( unixFilter
    , unixFilterLBS
    ) where


--------------------------------------------------------------------------------
import           Control.Concurrent      (forkIO)
import           Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
import           Control.DeepSeq         (deepseq)
import           Control.Monad           (forM_)
import           Data.ByteString.Lazy    (ByteString)
import qualified Data.ByteString.Lazy    as LB
import           Data.IORef              (newIORef, readIORef, writeIORef)
import           System.Exit             (ExitCode (..))
import           System.IO               (Handle, hClose, hFlush, hGetContents,
                                          hPutStr, hSetEncoding, localeEncoding)
import           System.Process

--------------------------------------------------------------------------------
import           Hakyll.Core.Compiler


--------------------------------------------------------------------------------
-- | Use a unix filter as compiler. For example, we could use the 'rev' program
-- as a compiler.
--
-- > rev :: Compiler (Item String)
-- > rev = getResourceString >>= withItemBody (unixFilter "rev" [])
--
-- A more realistic example: one can use this to call, for example, the sass
-- compiler on CSS files. More information about sass can be found here:
--
-- <http://sass-lang.com/>
--
-- The code is fairly straightforward, given that we use @.scss@ for sass:
--
-- > match "style.scss" $ do
-- >     route   $ setExtension "css"
-- >     compile $ getResourceString >>=
-- >         withItemBody (unixFilter "sass" ["-s", "--scss"]) >>=
-- >         return . fmap compressCss
unixFilter :: String           -- ^ Program name
           -> [String]         -- ^ Program args
           -> String           -- ^ Program input
           -> Compiler String  -- ^ Program output
unixFilter = unixFilterWith writer reader
  where
    writer handle input = do
        hSetEncoding handle localeEncoding
        hPutStr handle input
    reader handle = do
        hSetEncoding handle localeEncoding
        out <- hGetContents handle
        deepseq out (return out)


--------------------------------------------------------------------------------
-- | Variant of 'unixFilter' that should be used for binary files
--
-- > match "music.wav" $ do
-- >     route   $ setExtension "ogg"
-- >     compile $ getResourceLBS >>= withItemBody (unixFilterLBS "oggenc" ["-"])
unixFilterLBS :: String               -- ^ Program name
              -> [String]             -- ^ Program args
              -> ByteString           -- ^ Program input
              -> Compiler ByteString  -- ^ Program output
unixFilterLBS = unixFilterWith LB.hPutStr $ \handle -> do
    out <- LB.hGetContents handle
    LB.length out `seq` return out


--------------------------------------------------------------------------------
-- | Overloaded compiler
unixFilterWith :: Monoid o
               => (Handle -> i -> IO ())  -- ^ Writer
               -> (Handle -> IO o)        -- ^ Reader
               -> String                  -- ^ Program name
               -> [String]                -- ^ Program args
               -> i                       -- ^ Program input
               -> Compiler o              -- ^ Program output
unixFilterWith writer reader programName args input = do
    debugCompiler ("Executing external program " ++ programName)
    (output, err, exitCode) <- unsafeCompiler $
        unixFilterIO writer reader programName args input
    forM_ (lines err) debugCompiler
    case exitCode of
        ExitSuccess   -> return output
        ExitFailure e -> fail $
            "Hakyll.Core.UnixFilter.unixFilterWith: " ++
            unwords (programName : args) ++ " gave exit code " ++ show e ++
            ". (Error: " ++ err ++ ")"


--------------------------------------------------------------------------------
-- | Internally used function
unixFilterIO :: Monoid o
             => (Handle -> i -> IO ())
             -> (Handle -> IO o)
             -> String
             -> [String]
             -> i
             -> IO (o, String, ExitCode)
unixFilterIO writer reader programName args input = do
    -- The problem on Windows is that `proc` is unable to execute
    -- batch stubs (eg. anything created using 'gem install ...') even if its in
    -- `$PATH`. A solution to this issue is to execute the batch file explicitly
    -- using `cmd /c batchfile` but there is no rational way to know where said
    -- batchfile is on the system. Hence, we detect windows using the
    -- CPP and instead of using `proc` to create the process, use `shell`
    -- which will be able to execute everything `proc` can
    -- as well as batch files.
#ifdef mingw32_HOST_OS
    let pr = shell $ unwords (programName : args)
#else
    let pr = proc programName args
#endif

    (Just inh, Just outh, Just errh, pid) <-
        createProcess pr
                { std_in  = CreatePipe
                , std_out = CreatePipe
                , std_err = CreatePipe
                }

    -- Create boxes
    lock   <- newEmptyMVar
    outRef <- newIORef mempty
    errRef <- newIORef ""

    -- Write the input to the child pipe
    _ <- forkIO $ writer inh input >> hFlush inh >> hClose inh

    -- Read from stdout
    _ <- forkIO $ do
        out <- reader outh
        hClose outh
        writeIORef outRef out
        putMVar lock ()

    -- Read from stderr
    _ <- forkIO $ do
        hSetEncoding errh localeEncoding
        err <- hGetContents errh
        _   <- deepseq err (return err)
        hClose errh
        writeIORef errRef err
        putMVar lock ()

    -- Get exit code & return
    takeMVar lock
    takeMVar lock
    exitCode <- waitForProcess pid
    out      <- readIORef outRef
    err      <- readIORef errRef
    return (out, err, exitCode)