{-# LANGUAGE CPP #-}
module What4.Utils.Environment
( findExecutable
, expandEnvironmentPath
) where
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail( MonadFail )
#endif
import Control.Monad.IO.Class
import Data.Char
import Data.List (foldl')
import Data.Map (Map)
import qualified Data.Map as Map
import qualified System.Directory as Sys
import System.Environment
import System.FilePath
expandVars :: MonadFail m => Map String String -> String -> m String
expandVars m = outsideVar id
where
outsideVar :: MonadFail m => ShowS -> String -> m String
outsideVar res s =
case s of
[] -> return (res [])
'$' : '{' : r -> matchBracketedVar res id r
'$' : c : r | isNumber c -> expandVar res (showChar c) r
'$' : r -> matchVarName res id r
c : r -> outsideVar (res . showChar c) r
isVarChar :: Char -> Bool
isVarChar '_' = True
isVarChar c = isAlphaNum c
matchVarName :: MonadFail m => ShowS -> ShowS -> String -> m String
matchVarName res rnm s =
case s of
[] -> expandVar res rnm s
c:r | isVarChar c -> matchVarName res (rnm . showChar c) r
| otherwise -> expandVar res rnm s
matchBracketedVar res rnm s =
case s of
[] -> fail "Missing '}' to close variable name."
'}':r -> expandVar res rnm r
c :r -> matchBracketedVar res (rnm . showChar c) r
expandVar res rnm r = do
let nm = rnm []
case Map.lookup nm m of
Just v -> outsideVar (res . showString v) r
Nothing -> fail $ "Could not find variable " ++ show nm
++ " in environment."
expandEnvironmentPath :: Map String String
-> String
-> IO String
expandEnvironmentPath base_map path = do
prog_name <- getExecutablePath
let prog_path = dropTrailingPathSeparator (dropFileName prog_name)
let init_map = Map.fromList [ ("MSS_BINPATH", prog_path) ]
env <- getEnvironment
let expanded_map = foldl' (\m (k,v) -> Map.insert k v m) init_map env
expandVars (Map.union base_map expanded_map) path
findExecutable :: (MonadIO m, MonadFail m)
=> FilePath
-> m FilePath
findExecutable expanded_path = do
mr <- liftIO $ Sys.findExecutable expanded_path
case mr of
Nothing -> fail $ "Could not find: " ++ expanded_path
Just r -> return r