-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE OverloadedStrings #-}
module Shake.HsDeps (
    Generated(..)
    , importsOf, transitiveImportsOf
    , importsOfIO
    , importsPackagagesOf_
    , loadPackageDb, savePackageDb
) where
import qualified Control.Concurrent as Concurrent
import qualified Control.Exception as Exception
import qualified Control.Monad.Trans as Trans

import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Serialize as Serialize
import qualified Data.Set as Set

import qualified Development.Shake as Shake
import qualified System.Directory as Directory
import qualified System.Exit as Exit
import qualified System.FilePath as FilePath
import qualified System.IO as IO
import qualified System.Process as Process

import qualified Util.Maps as Maps
import qualified Util.Seq as Seq
import qualified Shake.Util as Util

import           Control.Monad


type Package = String
type ModuleName = B.ByteString

-- | Normally 'importsOf' and 'transitiveImportsOf' filter out files that don't
-- exist, under the assumption that they belong to external packages.  This
-- set contains exceptions to that, so they will get a need call, so they can
-- be generated.
data Generated = Generated {
    Generated -> Set [Char]
_generatedHs :: Set.Set FilePath
    -- | Try files with these extensions, in addition to .hs.
    -- E.g. [".hsc", ".chs"].
    , Generated -> [[Char]]
_generatedExtensions :: [FilePath]
    } deriving (Generated -> Generated -> Bool
(Generated -> Generated -> Bool)
-> (Generated -> Generated -> Bool) -> Eq Generated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Generated -> Generated -> Bool
$c/= :: Generated -> Generated -> Bool
== :: Generated -> Generated -> Bool
$c== :: Generated -> Generated -> Bool
Eq, Int -> Generated -> ShowS
[Generated] -> ShowS
Generated -> [Char]
(Int -> Generated -> ShowS)
-> (Generated -> [Char])
-> ([Generated] -> ShowS)
-> Show Generated
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Generated] -> ShowS
$cshowList :: [Generated] -> ShowS
show :: Generated -> [Char]
$cshow :: Generated -> [Char]
showsPrec :: Int -> Generated -> ShowS
$cshowsPrec :: Int -> Generated -> ShowS
Show)

-- | Find files of modules this module imports, in the form A/B.hs or A/B.hsc.
-- Paths that don't exist are assumed to be package imports and are omitted.
importsOf :: Generated -> Maybe [String] -> FilePath -> Shake.Action [FilePath]
importsOf :: Generated -> Maybe [[Char]] -> [Char] -> Action [[Char]]
importsOf Generated
generated Maybe [[Char]]
cppFlags [Char]
fn = do
    Partial => [[Char]] -> Action ()
[[Char]] -> Action ()
Shake.need [[Char]
fn]
    IO [[Char]] -> Action [[Char]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Trans.liftIO (Generated -> Maybe [[Char]] -> [Char] -> IO [[Char]]
importsOfIO Generated
generated Maybe [[Char]]
cppFlags [Char]
fn)

importsOfIO :: Generated
    -> Maybe [String] -- ^ If Just, first run CPP with these flags.
    -> FilePath -> IO [FilePath]
importsOfIO :: Generated -> Maybe [[Char]] -> [Char] -> IO [[Char]]
importsOfIO Generated
generated Maybe [[Char]]
cppFlags [Char]
fn = do
    -- TODO get CcDeps.includesOf so I can need them too.
    [ModuleName]
mods <- [ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
Seq.unique_sort ([ModuleName] -> [ModuleName])
-> (ModuleName -> [ModuleName]) -> ModuleName -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [ModuleName]
parseImports (ModuleName -> [ModuleName]) -> IO ModuleName -> IO [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [[Char]] -> [Char] -> IO ModuleName
preprocess Maybe [[Char]]
cppFlags [Char]
fn
    [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
Maybe.catMaybes ([Maybe [Char]] -> [[Char]]) -> IO [Maybe [Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModuleName -> IO (Maybe [Char]))
-> [ModuleName] -> IO [Maybe [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Generated -> ModuleName -> IO (Maybe [Char])
fileOf Generated
generated) [ModuleName]
mods

-- * PackageDb

-- | Map a module name to the package it comes from.
type PackageDb = Map.Map ModuleName Package

-- | Get local imports and package dependencies.
--
-- I thought I wound use this but wound up not wanting it.  But I'll leave the
-- basic implementation here in case I change my mind.  This still needs to
-- be integrated with 'importsOf' and 'transitiveImportsOf'.
importsPackagagesOf_ :: PackageDb
    -> Generated -> Maybe [String] -- ^ If Just, first run CPP with these flags.
    -> FilePath -> IO ([FilePath], [Package])
importsPackagagesOf_ :: Map ModuleName [Char]
-> Generated -> Maybe [[Char]] -> [Char] -> IO ([[Char]], [[Char]])
importsPackagagesOf_ Map ModuleName [Char]
packageDb Generated
generated Maybe [[Char]]
cppFlags [Char]
fn = do
    [ModuleName]
mods <- ModuleName -> [ModuleName]
parseImports (ModuleName -> [ModuleName]) -> IO ModuleName -> IO [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [[Char]] -> [Char] -> IO ModuleName
preprocess Maybe [[Char]]
cppFlags [Char]
fn
    [[Char]]
files <- [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
Maybe.catMaybes ([Maybe [Char]] -> [[Char]]) -> IO [Maybe [Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModuleName -> IO (Maybe [Char]))
-> [ModuleName] -> IO [Maybe [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Generated -> ModuleName -> IO (Maybe [Char])
fileOf Generated
generated) [ModuleName]
mods
    ([[Char]], [[Char]]) -> IO ([[Char]], [[Char]])
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]]
files, (ModuleName -> Maybe [Char]) -> [ModuleName] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (ModuleName -> Map ModuleName [Char] -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map ModuleName [Char]
packageDb) [ModuleName]
mods)

-- | Load cached module to package db.
loadPackageDb :: FilePath -> Shake.Action PackageDb
loadPackageDb :: [Char] -> Action (Map ModuleName [Char])
loadPackageDb [Char]
fn = do
    Partial => [[Char]] -> Action ()
[[Char]] -> Action ()
Shake.need [[Char]
fn]
    IO (Map ModuleName [Char]) -> Action (Map ModuleName [Char])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Trans.liftIO (IO (Map ModuleName [Char]) -> Action (Map ModuleName [Char]))
-> IO (Map ModuleName [Char]) -> Action (Map ModuleName [Char])
forall a b. (a -> b) -> a -> b
$ do
        Either [Char] (Map ModuleName [Char])
result <- ModuleName -> Either [Char] (Map ModuleName [Char])
forall a. Serialize a => ModuleName -> Either [Char] a
Serialize.decode (ModuleName -> Either [Char] (Map ModuleName [Char]))
-> IO ModuleName -> IO (Either [Char] (Map ModuleName [Char]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ModuleName
B.readFile [Char]
fn
        ([Char] -> IO (Map ModuleName [Char]))
-> (Map ModuleName [Char] -> IO (Map ModuleName [Char]))
-> Either [Char] (Map ModuleName [Char])
-> IO (Map ModuleName [Char])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> IO (Map ModuleName [Char])
forall (m :: * -> *) a. MonadIO m => [Char] -> m a
Util.errorIO ([Char] -> IO (Map ModuleName [Char]))
-> ShowS -> [Char] -> IO (Map ModuleName [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char]
"load from " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fn [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":")++)) Map ModuleName [Char] -> IO (Map ModuleName [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Either [Char] (Map ModuleName [Char])
result

-- | Call 'getModuleToPackage' and save its contents to the file.
-- If there are colliding modules, throw an IO exception.
savePackageDb :: [Package] -> FilePath -> IO ()
savePackageDb :: [[Char]] -> [Char] -> IO ()
savePackageDb [[Char]]
packages [Char]
cacheFn = do
    (Map ModuleName [Char]
packageDb, [(ModuleName, [[Char]])]
collisions) <- [[Char]] -> IO (Map ModuleName [Char], [(ModuleName, [[Char]])])
getModuleToPackage [[Char]]
packages
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(ModuleName, [[Char]])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, [[Char]])]
collisions) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> IO ()
forall (m :: * -> *) a. MonadIO m => [Char] -> m a
Util.errorIO ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"modules found in >1 package:\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines
            [ModuleName -> [Char]
B.unpack ModuleName
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords [[Char]]
vs | (ModuleName
k, [[Char]]
vs) <- [(ModuleName, [[Char]])]
collisions]
    [Char] -> ModuleName -> IO ()
B.writeFile [Char]
cacheFn (ModuleName -> IO ()) -> ModuleName -> IO ()
forall a b. (a -> b) -> a -> b
$ Map ModuleName [Char] -> ModuleName
forall a. Serialize a => a -> ModuleName
Serialize.encode Map ModuleName [Char]
packageDb

getModuleToPackage :: [Package]
    -> IO (Map.Map ModuleName Package, [(ModuleName, [Package])])
    -- ^ also return any modules found under multiple packages
getModuleToPackage :: [[Char]] -> IO (Map ModuleName [Char], [(ModuleName, [[Char]])])
getModuleToPackage [[Char]]
packages = do
    [([Char], [ModuleName])]
packageMods <- [[Char]] -> [[ModuleName]] -> [([Char], [ModuleName])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
packages ([[ModuleName]] -> [([Char], [ModuleName])])
-> IO [[ModuleName]] -> IO [([Char], [ModuleName])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO [ModuleName]) -> [[Char]] -> IO [[ModuleName]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO [ModuleName]
getExposedModules [[Char]]
packages
    (Map ModuleName [Char], [(ModuleName, [[Char]])])
-> IO (Map ModuleName [Char], [(ModuleName, [[Char]])])
forall (m :: * -> *) a. Monad m => a -> m a
return ((Map ModuleName [Char], [(ModuleName, [[Char]])])
 -> IO (Map ModuleName [Char], [(ModuleName, [[Char]])]))
-> (Map ModuleName [Char], [(ModuleName, [[Char]])])
-> IO (Map ModuleName [Char], [(ModuleName, [[Char]])])
forall a b. (a -> b) -> a -> b
$ [(ModuleName, [Char])]
-> (Map ModuleName [Char], [(ModuleName, [[Char]])])
forall k v. Ord k => [(k, v)] -> (Map k v, [(k, [v])])
Maps.unique2
        [(ModuleName
mod, [Char]
package) | ([Char]
package, [ModuleName]
mods) <- [([Char], [ModuleName])]
packageMods, ModuleName
mod <- [ModuleName]
mods]

getExposedModules :: Package -> IO [ModuleName]
getExposedModules :: [Char] -> IO [ModuleName]
getExposedModules [Char]
package =
    ModuleName -> [ModuleName]
parse (ModuleName -> [ModuleName]) -> IO ModuleName -> IO [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> IO ModuleName
processStdout [Char]
"ghc-pkg" [[Char]
"field", [Char]
package, [Char]
"exposed-modules"]
    where
    -- The first word is "exposed-modules:".
    -- TODO gets duplicates if you have the same package installed under
    -- different versions.
    parse :: ModuleName -> [ModuleName]
parse = Int -> [ModuleName] -> [ModuleName]
forall a. Int -> [a] -> [a]
drop Int
1 ([ModuleName] -> [ModuleName])
-> (ModuleName -> [ModuleName]) -> ModuleName -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [ModuleName]
B.words

-- | Like 'importsOf' but transitive.  Includes the given module.
--
-- TODO Technically I should run CPP on the output of hsc2hs, which means
-- this should map the module names to the appropriate .hs and 'need' it.
-- Otherwise the '#include' that belongs to hsc2hs will get processed by CPP.
transitiveImportsOf :: Generated -> (FilePath -> Maybe [String])
    -> FilePath -> Shake.Action [FilePath]
transitiveImportsOf :: Generated
-> ([Char] -> Maybe [[Char]]) -> [Char] -> Action [[Char]]
transitiveImportsOf Generated
generated [Char] -> Maybe [[Char]]
cppFlagsOf [Char]
fn = do
    Partial => [[Char]] -> Action ()
[[Char]] -> Action ()
Shake.need [[Char]
fn]
    Set [Char] -> [[Char]] -> Action [[Char]]
go Set [Char]
forall a. Set a
Set.empty [[Char]
fn]
    where
    go :: Set [Char] -> [[Char]] -> Action [[Char]]
go Set [Char]
checked ([Char]
fn:[[Char]]
fns)
        | [Char]
fn [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set [Char]
checked = Set [Char] -> [[Char]] -> Action [[Char]]
go Set [Char]
checked [[Char]]
fns
        | Bool
otherwise = do
            [[Char]]
imports <- Generated -> Maybe [[Char]] -> [Char] -> Action [[Char]]
importsOf Generated
generated ([Char] -> Maybe [[Char]]
cppFlagsOf [Char]
fn) [Char]
fn
            let checked' :: Set [Char]
checked' = [Char] -> Set [Char] -> Set [Char]
forall a. Ord a => a -> Set a -> Set a
Set.insert [Char]
fn Set [Char]
checked
            Set [Char] -> [[Char]] -> Action [[Char]]
go Set [Char]
checked' ([[Char]]
fns [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set [Char]
checked') [[Char]]
imports)
    go Set [Char]
checked [] = [[Char]] -> Action [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> Action [[Char]]) -> [[Char]] -> Action [[Char]]
forall a b. (a -> b) -> a -> b
$ Set [Char] -> [[Char]]
forall a. Set a -> [a]
Set.toList Set [Char]
checked

fileOf :: Generated -> ModuleName -> IO (Maybe FilePath)
fileOf :: Generated -> ModuleName -> IO (Maybe [Char])
fileOf Generated
generated ModuleName
mod
    | [Char]
fn [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Generated -> Set [Char]
_generatedHs Generated
generated = Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
fn
    | Bool
otherwise = [[Char]] -> IO (Maybe [Char])
findExistingFile ([[Char]] -> IO (Maybe [Char])) -> [[Char]] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$
        [Char]
fn [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> ShowS
FilePath.replaceExtension [Char]
fn) (Generated -> [[Char]]
_generatedExtensions Generated
generated)
    where
    fn :: [Char]
fn = ModuleName -> [Char]
B.unpack (ModuleName -> [Char]) -> ModuleName -> [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> ModuleName -> ModuleName
B.map Char -> Char
slash ModuleName
mod ModuleName -> ModuleName -> ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName
".hs"
    slash :: Char -> Char
slash Char
c = if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
'/' else Char
c

-- | Any line that starts with @import@ should be an import.  It's a reserved
-- word so I think that's safe?
parseImports :: B.ByteString -> [ModuleName]
parseImports :: ModuleName -> [ModuleName]
parseImports = (ModuleName -> Maybe ModuleName) -> [ModuleName] -> [ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe ([ModuleName] -> Maybe ModuleName
forall {a}. (Eq a, IsString a) => [a] -> Maybe a
parse ([ModuleName] -> Maybe ModuleName)
-> (ModuleName -> [ModuleName]) -> ModuleName -> Maybe ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [ModuleName]
B.words) ([ModuleName] -> [ModuleName])
-> (ModuleName -> [ModuleName]) -> ModuleName -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [ModuleName]
B.lines
    where
    parse :: [a] -> Maybe a
parse (a
"import" : a
"qualified" : a
mod : [a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
mod
    parse (a
"import" : a
mod : [a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
mod
    parse [a]
_ = Maybe a
forall a. Maybe a
Nothing

-- | Read the file, and preprocess with CPPHS if cppFlags are given.
preprocess :: Maybe [String] -> FilePath -> IO B.ByteString
preprocess :: Maybe [[Char]] -> [Char] -> IO ModuleName
preprocess Maybe [[Char]]
Nothing [Char]
fn = [Char] -> IO ModuleName
B.readFile [Char]
fn
preprocess (Just [[Char]]
flags) [Char]
fn = [Char] -> [[Char]] -> IO ModuleName
processStdout [Char]
"cpphs" ([Char]
"--cpp" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
flags [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
fn])


-- * util

processStdout :: FilePath -> [String] -> IO B.ByteString
processStdout :: [Char] -> [[Char]] -> IO ModuleName
processStdout [Char]
cmd [[Char]]
args = IO Handle
-> (Handle -> IO ()) -> (Handle -> IO ModuleName) -> IO ModuleName
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket IO Handle
open Handle -> IO ()
IO.hClose Handle -> IO ModuleName
B.hGetContents
    where
    open :: IO Handle
open = do
        (Maybe Handle
_, Just Handle
stdout, Maybe Handle
_, ProcessHandle
_) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
loggedProcess (CreateProcess
 -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$
            ([Char] -> [[Char]] -> CreateProcess
Process.proc [Char]
cmd [[Char]]
args) { std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe }
        Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdout

-- | Like 'Process.createProcess', but actually report when the binary isn't
-- found.
loggedProcess :: Process.CreateProcess -> IO (Maybe IO.Handle,
       Maybe IO.Handle, Maybe IO.Handle, Process.ProcessHandle)
loggedProcess :: CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
loggedProcess CreateProcess
create = do
    r :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
r@(Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
pid) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
create
    IO () -> IO ThreadId
Concurrent.forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
        ExitCode
code <- ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
pid
        case ExitCode
code of
            Exit.ExitFailure Int
c -> Handle -> [Char] -> IO ()
IO.hPutStrLn Handle
IO.stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
                [Char]
"subprocess " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show (CreateProcess -> [Char]
binaryOf CreateProcess
create) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" failed: "
                [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ if Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
127 then [Char]
"binary not found" else Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c
            ExitCode
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
r
    where
    binaryOf :: CreateProcess -> [Char]
binaryOf CreateProcess
create = case CreateProcess -> CmdSpec
Process.cmdspec CreateProcess
create of
        Process.RawCommand [Char]
fn [[Char]]
_ -> [Char]
fn
        Process.ShellCommand [Char]
cmd -> (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') [Char]
cmd

findExistingFile :: [FilePath] -> IO (Maybe FilePath)
findExistingFile :: [[Char]] -> IO (Maybe [Char])
findExistingFile ([Char]
fn:[[Char]]
fns) =
    IO Bool
-> IO (Maybe [Char]) -> IO (Maybe [Char]) -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
Util.ifM ([Char] -> IO Bool
Directory.doesFileExist [Char]
fn) (Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
fn))
        ([[Char]] -> IO (Maybe [Char])
findExistingFile [[Char]]
fns)
findExistingFile [] = Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing