{-# 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           Data.Monoid             (Monoid, mempty)
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 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


--------------------------------------------------------------------------------
-- | 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)