    ------------------------------------------------------------------------
    -- |
    -- Module           : What4.Utils.Environemnt
    -- Description      : Provides functions for finding an executable, and
    --                    expanding a path with referenced to environment
    --                    variables.
    -- Copyright        : (c) Galois, Inc 2013-2020
    -- License          : BSD3
    -- Maintainer       : Joe Hendrix <jhendrix@galois.com>
    -- Stability        : provisional
    --
    -- Provides functions for finding an executable, and expanding a path
    -- with referenced to environment variables.
    ------------------------------------------------------------------------
    {-# 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 qualified Data.List as List (foldl')
    import Data.Map (Map)
    import qualified Data.Map as Map
    import qualified System.Directory as Sys
    import System.Environment
    import System.FilePath

    -- | Given a mapping of variables to values, this replaces
    -- substrings of the form $VAR with the associated value
    -- in a string.
    expandVars :: MonadFail m => Map String String -> String -> m String
    expandVars :: forall (m :: Type -> Type).
    MonadFail m =>
    Map String String -> String -> m String
    expandVars Map String String
    m = ShowS -> String -> m String
    forall (m :: Type -> Type).
    MonadFail m =>
    ShowS -> String -> m String
    outsideVar ShowS
    forall a. a -> a
    id
      where -- Parse characters not part of a var.
            outsideVar :: MonadFail m => ShowS -> String -> m String
            outsideVar :: forall (m :: Type -> Type).
    MonadFail m =>
    ShowS -> String -> m String
    outsideVar ShowS
    res String
    s =
              case String
    s of
                [] -> String -> m String
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (ShowS
    res [])
                Char
    '$' : Char
    '{' : String
    r -> ShowS -> ShowS -> String -> m String
    forall {m :: Type -> Type}.
    MonadFail m =>
    ShowS -> ShowS -> String -> m String
    matchBracketedVar ShowS
    res ShowS
    forall a. a -> a
    id String
    r
                Char
    '$' : Char
    c : String
    r | Char -> Bool
    isNumber Char
    c -> ShowS -> ShowS -> String -> m String
    forall {m :: Type -> Type} {a}.
    MonadFail m =>
    ShowS -> ([a] -> String) -> String -> m String
    expandVar ShowS
    res (Char -> ShowS
    showChar Char
    c) String
    r
                Char
    '$' : String
    r -> ShowS -> ShowS -> String -> m String
    forall {m :: Type -> Type}.
    MonadFail m =>
    ShowS -> ShowS -> String -> m String
    matchVarName ShowS
    res ShowS
    forall a. a -> a
    id String
    r
                Char
    c   : String
    r -> ShowS -> String -> m String
    forall (m :: Type -> Type).
    MonadFail m =>
    ShowS -> String -> m String
    outsideVar (ShowS
    res ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    c) String
    r

            -- Return true if this is a character.
            isVarChar :: Char -> Bool
            isVarChar :: Char -> Bool
    isVarChar Char
    '_' = Bool
    True
            isVarChar Char
    c = Char -> Bool
    isAlphaNum Char
    c

            matchVarName :: MonadFail m => ShowS -> ShowS -> String -> m String
            matchVarName :: forall {m :: Type -> Type}.
    MonadFail m =>
    ShowS -> ShowS -> String -> m String
    matchVarName ShowS
    res ShowS
    rnm String
    s =
              case String
    s of
                [] -> ShowS -> ShowS -> String -> m String
    forall {m :: Type -> Type} {a}.
    MonadFail m =>
    ShowS -> ([a] -> String) -> String -> m String
    expandVar ShowS
    res ShowS
    rnm String
    s
                Char
    c:String
    r | Char -> Bool
    isVarChar Char
    c -> ShowS -> ShowS -> String -> m String
    forall {m :: Type -> Type}.
    MonadFail m =>
    ShowS -> ShowS -> String -> m String
    matchVarName ShowS
    res (ShowS
    rnm ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    c) String
    r
                    | Bool
    otherwise -> ShowS -> ShowS -> String -> m String
    forall {m :: Type -> Type} {a}.
    MonadFail m =>
    ShowS -> ([a] -> String) -> String -> m String
    expandVar ShowS
    res ShowS
    rnm String
    s

            matchBracketedVar :: ShowS -> ShowS -> String -> m String
    matchBracketedVar ShowS
    res ShowS
    rnm String
    s =
              case String
    s of
                [] -> String -> m String
    forall a. String -> m a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail String
    "Missing '}' to close variable name."
                Char
    '}':String
    r -> ShowS -> ShowS -> String -> m String
    forall {m :: Type -> Type} {a}.
    MonadFail m =>
    ShowS -> ([a] -> String) -> String -> m String
    expandVar ShowS
    res ShowS
    rnm String
    r
                Char
    c  :String
    r -> ShowS -> ShowS -> String -> m String
    matchBracketedVar ShowS
    res (ShowS
    rnm ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    c) String
    r

            expandVar :: ShowS -> ([a] -> String) -> String -> m String
    expandVar ShowS
    res [a] -> String
    rnm String
    r = do
              let nm :: String
    nm = [a] -> String
    rnm []
              case String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    nm Map String String
    m of
                Just String
    v -> ShowS -> String -> m String
    forall (m :: Type -> Type).
    MonadFail m =>
    ShowS -> String -> m String
    outsideVar (ShowS
    res ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    v) String
    r
                Maybe String
    Nothing -> String -> m String
    forall a. String -> m a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> m String) -> String -> m String
    forall a b. (a -> b) -> a -> b
    $ String
    "Could not find variable " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    nm
                                  String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " in environment."

    expandEnvironmentPath :: Map String String
                          -> String
                          -> IO String
    expandEnvironmentPath :: Map String String -> String -> IO String
    expandEnvironmentPath Map String String
    base_map String
    path = do
      -- Get program name.
      prog_name <- IO String
    getExecutablePath
      let prog_path = ShowS
    dropTrailingPathSeparator (ShowS
    dropFileName String
    prog_name)
      let init_map = [(String, String)] -> Map String String
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [ (String
    "MSS_BINPATH", String
    prog_path) ]
      -- Extend init_map with environment variables.
      env <- getEnvironment
      let expanded_map = (Map String String -> (String, String) -> Map String String)
    -> Map String String -> [(String, String)] -> Map String String
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' (\Map String String
    m (String
    k,String
    v) -> String -> String -> Map String String -> Map String String
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert String
    k String
    v Map String String
    m) Map String String
    init_map [(String, String)]
    env
      -- Return expanded path.
      expandVars (Map.union base_map expanded_map) path

    -- | Find an executable from a string.
    findExecutable :: (MonadIO m, MonadFail m)
                   => FilePath
                      -- ^ Path to expand
                   -> m FilePath
    findExecutable :: forall (m :: Type -> Type).
    (MonadIO m, MonadFail m) =>
    String -> m String
    findExecutable String
    expanded_path = do
      -- Look for variable in expanded_path.
      mr <- IO (Maybe String) -> m (Maybe String)
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe String) -> m (Maybe String))
    -> IO (Maybe String) -> m (Maybe String)
    forall a b. (a -> b) -> a -> b
    $ String -> IO (Maybe String)
    Sys.findExecutable String
    expanded_path
      case mr of
        Maybe String
    Nothing -> String -> m String
    forall a. String -> m a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail (String -> m String) -> String -> m String
    forall a b. (a -> b) -> a -> b
    $ String
    "Could not find: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    expanded_path
        Just String
    r -> String -> m String
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return String
    r