{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module System.Which (which, staticWhich, staticWhichNix) where

import qualified Shelly as Sh
import qualified Data.Text as T
import Language.Haskell.TH (Exp, Q, reportError, runIO)
import Data.Monoid ((<>))
import Data.List (isPrefixOf)

-- | Determine which executable would run if the given path were
--   executed, or return Nothing if a suitable executable cannot be
--   found
which :: FilePath -> IO (Maybe FilePath)
which :: String -> IO (Maybe String)
which String
f = (Maybe String -> Maybe String)
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
T.unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Sh.toTextIgnore)) (IO (Maybe String) -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ Sh (Maybe String) -> IO (Maybe String)
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
Sh.shelly (Sh (Maybe String) -> IO (Maybe String))
-> Sh (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Sh (Maybe String)
Sh.which (String -> Sh (Maybe String)) -> String -> Sh (Maybe String)
forall a b. (a -> b) -> a -> b
$ Text -> String
Sh.fromText (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
f

staticWhichImpl :: (FilePath -> Maybe String) -> FilePath -> Q Exp
staticWhichImpl :: (String -> Maybe String) -> String -> Q Exp
staticWhichImpl String -> Maybe String
test String
f = do
  mf' <- IO (Maybe String) -> Q (Maybe String)
forall a. IO a -> Q a
runIO (IO (Maybe String) -> Q (Maybe String))
-> IO (Maybe String) -> Q (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
which String
f
  case mf' of
    Maybe String
Nothing -> String -> Q Exp
compileError (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Could not find executable for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
f
    Just String
f' -> case String -> Maybe String
test String
f' of
      Just String
err -> String -> Q Exp
compileError String
err
      Maybe String
Nothing -> [| f' |]
  where
    compileError :: String -> Q Exp
compileError String
msg' = do
      let msg :: String
msg = String
"staticWhich: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg'
      String -> Q ()
reportError String
msg
      [| error msg |]

-- | Run `which` at compile time, and substitute the full path to the executable.
staticWhich :: FilePath -> Q Exp
staticWhich :: String -> Q Exp
staticWhich = (String -> Maybe String) -> String -> Q Exp
staticWhichImpl (Maybe String -> String -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing)

-- A variant of 'staticWhich' that ensures the executable is in the nix store.
-- This is useful in NixOS to ensure that the resulting executable
-- contains the dependency in its closure and that it refers to the
-- same version at run time as at compile time
staticWhichNix :: FilePath -> Q Exp
staticWhichNix :: String -> Q Exp
staticWhichNix = (String -> Maybe String) -> String -> Q Exp
staticWhichImpl ((String -> Maybe String) -> String -> Q Exp)
-> (String -> Maybe String) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ \String
x ->
  if String
"/nix/store/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x
    then Maybe String
forall a. Maybe a
Nothing
    else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Executable was found in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" which is not in /nix/store."