summaryrefslogtreecommitdiff
path: root/src/StackWrapper.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/StackWrapper.hs')
-rw-r--r--src/StackWrapper.hs58
1 files changed, 58 insertions, 0 deletions
diff --git a/src/StackWrapper.hs b/src/StackWrapper.hs
new file mode 100644
index 0000000..37cb72c
--- /dev/null
+++ b/src/StackWrapper.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE CPP #-}
+
+module StackWrapper
+ ( run
+ , envPrefix
+ ) where
+
+import Paths_stack_wrapper (version)
+
+import Data.Version (showVersion)
+import System.Environment (getArgs, getExecutablePath, getProgName, lookupEnv, setEnv)
+import System.Exit (exitFailure, exitSuccess)
+import System.IO (hPutStrLn, stderr)
+import System.Process (callProcess)
+
+#ifdef mingw32_HOST_OS
+import System.FilePath (takeBaseName)
+#endif
+
+option :: String
+option = "--stack-wrapper"
+
+envPrefix :: String
+envPrefix = "STACK_WRAPPER_"
+
+callerEnv :: String
+callerEnv = envPrefix <> "CALLER"
+
+run :: IO () -> IO ()
+run act = do
+ args <- getArgs
+ case args of
+ a0:_ | a0 == option -> do
+ putStrLn $ "stack-wrapper " <> showVersion version
+ exitSuccess
+ _ -> do
+ this <- getExecutablePath
+ mcaller <- lookupEnv callerEnv
+ case mcaller of
+ Just caller | this == caller -> do
+ name <- getProgBaseName
+ mdefaultExe <- lookupEnv $ envPrefix <> name
+ case mdefaultExe of
+ Just defaultExe ->
+ callProcess defaultExe args
+ Nothing -> do
+ hPutStrLn stderr "recursive call detected"
+ exitFailure
+ _ -> do
+ setEnv callerEnv this
+ act
+
+getProgBaseName :: IO String
+#ifdef mingw32_HOST_OS
+getProgBaseName = takeBaseName <$> getProgName
+#else
+getProgName = getProgName
+#endif