module HIE.Bios.Cradle.Utils
(
ProcessErrorDetails(..)
, prettyProcessErrorDetails
, selectCradle
, removeInteractive
, removeRTS
, removeVerbosityOpts
, expandGhcOptionResponseFile
)
where
import HIE.Bios.Types (prettyCmdSpec)
import Data.List
import System.Process.Extra
import GHC.ResponseFile (expandResponse)
data ProcessErrorDetails = ProcessErrorDetails
{ ProcessErrorDetails -> CmdSpec
processCmd :: CmdSpec
, ProcessErrorDetails -> [String]
processStdout :: [String]
, ProcessErrorDetails -> [String]
processStderr :: [String]
, ProcessErrorDetails -> [String]
processGhcOptions :: [String]
, ProcessErrorDetails -> [(String, String)]
processHieBiosEnvironment :: [(String, String)]
}
prettyProcessErrorDetails :: ProcessErrorDetails -> [String]
prettyProcessErrorDetails :: ProcessErrorDetails -> [String]
prettyProcessErrorDetails ProcessErrorDetails
p =
[ String
"Failed command: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> CmdSpec -> String
prettyCmdSpec (ProcessErrorDetails -> CmdSpec
processCmd ProcessErrorDetails
p),
[String] -> String
unlines (ProcessErrorDetails -> [String]
processStdout ProcessErrorDetails
p),
[String] -> String
unlines (ProcessErrorDetails -> [String]
processStderr ProcessErrorDetails
p),
[String] -> String
unlines (ProcessErrorDetails -> [String]
processGhcOptions ProcessErrorDetails
p),
String
"Process Environment:"
] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [ String
key String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
value
| (String
key, String
value) <- ProcessErrorDetails -> [(String, String)]
processHieBiosEnvironment ProcessErrorDetails
p
]
selectCradle :: (a -> FilePath) -> FilePath -> [a] -> Maybe a
selectCradle :: forall a. (a -> String) -> String -> [a] -> Maybe a
selectCradle a -> String
_ String
_ [] = Maybe a
forall a. Maybe a
Nothing
selectCradle a -> String
k String
cur_fp (a
c: [a]
css) =
if a -> String
k a
c String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
cur_fp
then a -> Maybe a
forall a. a -> Maybe a
Just a
c
else (a -> String) -> String -> [a] -> Maybe a
forall a. (a -> String) -> String -> [a] -> Maybe a
selectCradle a -> String
k String
cur_fp [a]
css
removeInteractive :: [String] -> [String]
removeInteractive :: [String] -> [String]
removeInteractive = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"--interactive")
data InRTS = OutsideRTS | InsideRTS
removeRTS :: [String] -> [String]
removeRTS :: [String] -> [String]
removeRTS = InRTS -> [String] -> [String]
go InRTS
OutsideRTS
where
go :: InRTS -> [String] -> [String]
go :: InRTS -> [String] -> [String]
go InRTS
_ [] = []
go InRTS
OutsideRTS (String
y:[String]
ys)
| String
"+RTS" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
y = InRTS -> [String] -> [String]
go (if String
"-RTS" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
y then InRTS
OutsideRTS else InRTS
InsideRTS) [String]
ys
| Bool
otherwise = String
y String -> [String] -> [String]
forall a. a -> [a] -> [a]
: InRTS -> [String] -> [String]
go InRTS
OutsideRTS [String]
ys
go InRTS
InsideRTS (String
y:[String]
ys) = InRTS -> [String] -> [String]
go (if String
"-RTS" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
y then InRTS
OutsideRTS else InRTS
InsideRTS) [String]
ys
removeVerbosityOpts :: [String] -> [String]
removeVerbosityOpts :: [String] -> [String]
removeVerbosityOpts = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> (String -> Bool) -> String -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-v0") (String -> Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall a b. (String -> a -> b) -> (String -> a) -> String -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-w"))
expandGhcOptionResponseFile :: [String] -> IO [String]
expandGhcOptionResponseFile :: [String] -> IO [String]
expandGhcOptionResponseFile [String]
args = do
[String]
expanded_args <- [String] -> IO [String]
expandResponse [String]
args
[String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
removeInteractive [String]
expanded_args