module Data.WhichEmbed where

import Control.Exception (catch)
import Control.Monad.Catch (MonadMask)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bits ((.|.))
import Data.ByteString qualified as BS
import Data.FileEmbed (embedFile)
import Language.Haskell.TH (Exp (LitE), Lit (StringL), Q, runIO)
import Path (Abs, File, Path, parseRelFile, toFilePath, (</>))
import Path.IO (withSystemTempDir)
import System.Environment (getEnv)
import System.Posix.Files (ownerExecuteMode, ownerReadMode, ownerWriteMode, setFileMode)
import System.Which (staticWhich)

embedWhich :: FilePath -> Q Exp
embedWhich :: [Char] -> Q Exp
embedWhich [Char]
cmd = do
  -- Log entry to confirm function is running
  IO () -> Q ()
forall a. IO a -> Q a
runIO ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Debug: Entering embedWhich with cmd = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmd)

  -- Log the PATH
  [Char]
path <- IO [Char] -> Q [Char]
forall a. IO a -> Q a
runIO ([Char] -> IO [Char]
getEnv [Char]
"PATH" IO [Char] -> (IOError -> IO [Char]) -> IO [Char]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOError
_ :: IOError) -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"PATH not set"))
  IO () -> Q ()
forall a. IO a -> Q a
runIO ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Debug: PATH during compilation = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
path)

  -- Call staticWhich and log its result
  Exp
x <- [Char] -> Q Exp
staticWhich [Char]
cmd
  IO () -> Q ()
forall a. IO a -> Q a
runIO ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Debug: staticWhich " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" returned: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp -> [Char]
forall a. Show a => a -> [Char]
show Exp
x)

  -- Handle the result
  case Exp
x of
    LitE (StringL [Char]
z) -> do
      IO () -> Q ()
forall a. IO a -> Q a
runIO ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Debug: Embedding file at: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
z)
      [Char] -> Q Exp
embedFile [Char]
z
    Exp
_ -> do
      IO () -> Q ()
forall a. IO a -> Q a
runIO ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Debug: staticWhich failed, returned non-literal: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp -> [Char]
forall a. Show a => a -> [Char]
show Exp
x)
      [Char] -> Q Exp
forall a. HasCallStack => [Char] -> a
error ([Char] -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char]
"staticWhich did not return a string literal, got: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp -> [Char]
forall a. Show a => a -> [Char]
show Exp
x

withEmbeddedExe ::
  (MonadIO m) =>
  (MonadMask m) =>
  -- | A name to use for the temp directory.
  String ->
  -- | The embedded bytes to use as an executable.
  BS.ByteString ->
  -- | A callback using the path to the executable.
  (Path Abs File -> m a) ->
  m a
withEmbeddedExe :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ByteString -> (Path Abs File -> m a) -> m a
withEmbeddedExe [Char]
name ByteString
bytes Path Abs File -> m a
f = do
  [Char] -> (Path Abs Dir -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> (Path Abs Dir -> m a) -> m a
withSystemTempDir [Char]
name ((Path Abs Dir -> m a) -> m a) -> (Path Abs Dir -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
fp -> do
    Path Rel File
x <- [Char] -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile [Char]
name
    let exe :: Path Abs File
exe = Path Abs Dir
fp Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
x
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      [Char] -> ByteString -> IO ()
BS.writeFile (Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs File
exe) ByteString
bytes
      [Char] -> FileMode -> IO ()
setFileMode (Path Abs File -> [Char]
forall b t. Path b t -> [Char]
toFilePath Path Abs File
exe) (FileMode
ownerReadMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
ownerWriteMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
ownerExecuteMode)
    Path Abs File -> m a
f Path Abs File
exe