    {-# 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 :: String -> [String] -> String -> Compiler String
    unixFilter = (Handle -> String -> IO ())
    -> (Handle -> IO String)
    -> String
    -> [String]
    -> String
    -> Compiler String
    forall o i.
    Monoid o =>
    (Handle -> i -> IO ())
    -> (Handle -> IO o) -> String -> [String] -> i -> Compiler o
    unixFilterWith Handle -> String -> IO ()
    writer Handle -> IO String
    reader
      where
        writer :: Handle -> String -> IO ()
    writer Handle
    handle String
    input = do
            Handle -> TextEncoding -> IO ()
    hSetEncoding Handle
    handle TextEncoding
    localeEncoding
            Handle -> String -> IO ()
    hPutStr Handle
    handle String
    input
        reader :: Handle -> IO String
    reader Handle
    handle = do
            Handle -> TextEncoding -> IO ()
    hSetEncoding Handle
    handle TextEncoding
    localeEncoding
            String
    out <- Handle -> IO String
    hGetContents Handle
    handle
            String -> IO String -> IO String
    forall a b. NFData a => a -> b -> b
    deepseq String
    out (String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    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 :: String -> [String] -> ByteString -> Compiler ByteString
    unixFilterLBS = (Handle -> ByteString -> IO ())
    -> (Handle -> IO ByteString)
    -> String
    -> [String]
    -> ByteString
    -> Compiler ByteString
    forall o i.
    Monoid o =>
    (Handle -> i -> IO ())
    -> (Handle -> IO o) -> String -> [String] -> i -> Compiler o
    unixFilterWith Handle -> ByteString -> IO ()
    LB.hPutStr ((Handle -> IO ByteString)
     -> String -> [String] -> ByteString -> Compiler ByteString)
    -> (Handle -> IO ByteString)
    -> String
    -> [String]
    -> ByteString
    -> Compiler ByteString
    forall a b. (a -> b) -> a -> b
    $ \Handle
    handle -> do
        ByteString
    out <- Handle -> IO ByteString
    LB.hGetContents Handle
    handle
        ByteString -> Int64
    LB.length ByteString
    out Int64 -> IO ByteString -> IO ByteString
    forall a b. a -> b -> b
    `seq` ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    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 :: forall o i.
    Monoid o =>
    (Handle -> i -> IO ())
    -> (Handle -> IO o) -> String -> [String] -> i -> Compiler o
    unixFilterWith Handle -> i -> IO ()
    writer Handle -> IO o
    reader String
    programName [String]
    args i
    input = do
        String -> Compiler ()
    debugCompiler (String
    "Executing external program " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    programName)
        (o
    output, String
    err, ExitCode
    exitCode) <- IO (o, String, ExitCode) -> Compiler (o, String, ExitCode)
    forall a. IO a -> Compiler a
    unsafeCompiler (IO (o, String, ExitCode) -> Compiler (o, String, ExitCode))
    -> IO (o, String, ExitCode) -> Compiler (o, String, ExitCode)
    forall a b. (a -> b) -> a -> b
    $
            (Handle -> i -> IO ())
    -> (Handle -> IO o)
    -> String
    -> [String]
    -> i
    -> IO (o, String, ExitCode)
    forall o i.
    Monoid o =>
    (Handle -> i -> IO ())
    -> (Handle -> IO o)
    -> String
    -> [String]
    -> i
    -> IO (o, String, ExitCode)
    unixFilterIO Handle -> i -> IO ()
    writer Handle -> IO o
    reader String
    programName [String]
    args i
    input
        [String] -> (String -> Compiler ()) -> Compiler ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (String -> [String]
    lines String
    err) String -> Compiler ()
    debugCompiler
        case ExitCode
    exitCode of
            ExitCode
    ExitSuccess   -> o -> Compiler o
    forall a. a -> Compiler a
    forall (m :: * -> *) a. Monad m => a -> m a
    return o
    output
            ExitFailure Int
    e -> String -> Compiler o
    forall a. String -> Compiler a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Compiler o) -> String -> Compiler o
    forall a b. (a -> b) -> a -> b
    $
                String
    "Hakyll.Core.UnixFilter.unixFilterWith: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                [String] -> String
    unwords (String
    programName String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    args) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " gave exit code " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    e String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                String
    ". (Error: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    err String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"

    --------------------------------------------------------------------------------
    -- | Internally used function
    unixFilterIO :: Monoid o
                 => (Handle -> i -> IO ())
                 -> (Handle -> IO o)
                 -> String
                 -> [String]
                 -> i
                 -> IO (o, String, ExitCode)
    unixFilterIO :: forall o i.
    Monoid o =>
    (Handle -> i -> IO ())
    -> (Handle -> IO o)
    -> String
    -> [String]
    -> i
    -> IO (o, String, ExitCode)
    unixFilterIO Handle -> i -> IO ()
    writer Handle -> IO o
    reader String
    programName [String]
    args i
    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 :: CreateProcess
    pr = String -> [String] -> CreateProcess
    proc String
    programName [String]
    args
    #endif

        (Just Handle
    inh, Just Handle
    outh, Just Handle
    errh, ProcessHandle
    pid) <-
            CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcess CreateProcess
    pr
                    { std_in :: StdStream
    std_in  = StdStream
    CreatePipe
                    , std_out :: StdStream
    std_out = StdStream
    CreatePipe
                    , std_err :: StdStream
    std_err = StdStream
    CreatePipe
                    }

        -- Create boxes
        MVar ()
    lock   <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar
        IORef o
    outRef <- o -> IO (IORef o)
    forall a. a -> IO (IORef a)
    newIORef o
    forall a. Monoid a => a
    mempty
        IORef String
    errRef <- String -> IO (IORef String)
    forall a. a -> IO (IORef a)
    newIORef String
    ""

        -- Write the input to the child pipe
        ThreadId
    _ <- IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ Handle -> i -> IO ()
    writer Handle
    inh i
    input IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hFlush Handle
    inh IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hClose Handle
    inh

        -- Read from stdout
        ThreadId
    _ <- IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ do
            o
    out <- Handle -> IO o
    reader Handle
    outh
            Handle -> IO ()
    hClose Handle
    outh
            IORef o -> o -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef o
    outRef o
    out
            MVar () -> () -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar ()
    lock ()

        -- Read from stderr
        ThreadId
    _ <- IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ do
            Handle -> TextEncoding -> IO ()
    hSetEncoding Handle
    errh TextEncoding
    localeEncoding
            String
    err <- Handle -> IO String
    hGetContents Handle
    errh
            String
    _   <- String -> IO String -> IO String
    forall a b. NFData a => a -> b -> b
    deepseq String
    err (String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    err)
            Handle -> IO ()
    hClose Handle
    errh
            IORef String -> String -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef String
    errRef String
    err
            MVar () -> () -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar ()
    lock ()

        -- Get exit code & return
        MVar () -> IO ()
    forall a. MVar a -> IO a
    takeMVar MVar ()
    lock
        MVar () -> IO ()
    forall a. MVar a -> IO a
    takeMVar MVar ()
    lock
        ExitCode
    exitCode <- ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    pid
        o
    out      <- IORef o -> IO o
    forall a. IORef a -> IO a
    readIORef IORef o
    outRef
        String
    err      <- IORef String -> IO String
    forall a. IORef a -> IO a
    readIORef IORef String
    errRef
        (o, String, ExitCode) -> IO (o, String, ExitCode)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (o
    out, String
    err, ExitCode
    exitCode)