Subcommands.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Utils.Subcommands(runSubcommand)
 where

import           Control.Conditional(condM, ifM, otherwiseM)
import qualified Control.Exception.Lifted as CEL
import           Control.Monad.Loops(firstM)
import           Data.Text(pack, splitOn, unpack)
import           System.Directory(doesFileExist)
import           System.Environment(lookupEnv)
import           System.Exit(exitFailure)
import           System.FilePath((</>))
import           System.Process.Typed(proc, runProcess_)

import Paths_bdcs(getLibexecDir)

getBasePath :: String -> IO FilePath
getBasePath masterCmdName = do
    dir <- getLibexecDir
    return $ dir </> masterCmdName

findInPath :: FilePath -> IO (Maybe FilePath)
findInPath sought = lookupEnv "PATH" >>= \case
    Nothing -> return Nothing
    Just p  -> do let searchPath = splitOn ":" (pack p)
                  fmap (\d -> unpack d </> sought) <$>
                       firstM (\d -> doesFileExist (unpack d </> sought)) searchPath

existsInPath :: FilePath -> IO Bool
existsInPath sought = fmap (/= Nothing) (findInPath sought)

runSubcommand :: String -> String -> [String] -> [(String, String)] -> IO () -> IO ()
runSubcommand basecmdPrefix subcmd subcmdArgs knownSubcommands usage = do
    basePath <- getBasePath basecmdPrefix

    let cmd1 = basePath ++ subcmd
    let cmd2 = basecmdPrefix ++ subcmd

    case subcmd `lookup` knownSubcommands of
        -- This is a subcommand we have built-in knowledge of.  For ease of development, it
        -- could be located in a couple different places:  Installed in /usr/libexec/weldr,
        -- or in the $PATH.  The latter allows us to run "PATH=$PATH:dist/build/... cabal run"
        -- without having to run "cabal install" every time we want to test something.
        --
        -- While tryCallProcess will search the $PATH itself, we need to know if the file
        -- exists somewhere in the $PATH first.  This allows us to separate file not found
        -- errors from the command failing.
        Just _  -> condM [(doesFileExist cmd1, tryCallProcess cmd1 subcmdArgs),
                          (existsInPath cmd1,  tryCallProcess cmd1 subcmdArgs),
                          (doesFileExist cmd2, tryCallProcess cmd2 subcmdArgs),
                          (existsInPath cmd2,  tryCallProcess cmd2 subcmdArgs),
                          (otherwiseM,         putStrLn ("subcommand " ++ subcmd ++ " does not exist\n") >> usage)]

        -- This is a subcommand we know nothing about.  Check to see if it exists in
        -- /usr/libexec/weldr, since it could have been installed by a third party.  If so,
        -- run that.  If not, display an error message and quit.
        Nothing -> ifM (doesFileExist cmd1)
                       (tryCallProcess cmd1 subcmdArgs)
                       (putStrLn ("subcommand " ++ subcmd ++ " does not exist\n") >> usage)
 where
     tryCallProcess cmd args = CEL.catch (runProcess_ (proc cmd args))
                                         -- We handled the case where an unknown subcommand was
                                         -- given on the command line.  For now, the only other
                                         -- errors possible are when the subcommand ran, but
                                         -- failed for some reason.  Those are handled inside
                                         -- the subcommand.  Just quit.
                                         (\(_ :: CEL.SomeException) -> exitFailure)