finally really add back custom-setup stanza

Fourth or fifth try at this and finally found a way to make it work.

Absurd amount of busy-work forced on me by change in cabal's behavior.
Split up Utility modules that need posix stuff out of ones used by
Setup. Various other hacks around inability for Setup to use anything
that ifdefs a use of unix.

Probably lost a full day of my life to this.
This is how build systems make their users hate them. Just saying.
This commit is contained in:
Joey Hess 2017-12-31 16:08:31 -04:00
parent 2bfdd690e2
commit 25703e1413
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
50 changed files with 494 additions and 345 deletions

View file

@ -0,0 +1,87 @@
{- Process transcript
-
- Copyright 2012-2015 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Process.Transcript where
import Utility.Process
import System.IO
import Control.Concurrent
import qualified Control.Exception as E
import Control.Monad
#ifndef mingw32_HOST_OS
import qualified System.Posix.IO
#else
import Control.Applicative
#endif
import Data.Maybe
import Prelude
-- | Runs a process, optionally feeding it some input, and
-- returns a transcript combining its stdout and stderr, and
-- whether it succeeded or failed.
processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
processTranscript cmd opts = processTranscript' (proc cmd opts)
processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)
processTranscript' cp input = do
#ifndef mingw32_HOST_OS
{- This implementation interleves stdout and stderr in exactly the order
- the process writes them. -}
(readf, writef) <- System.Posix.IO.createPipe
readh <- System.Posix.IO.fdToHandle readf
writeh <- System.Posix.IO.fdToHandle writef
p@(_, _, _, pid) <- createProcess $ cp
{ std_in = if isJust input then CreatePipe else Inherit
, std_out = UseHandle writeh
, std_err = UseHandle writeh
}
hClose writeh
get <- mkreader readh
writeinput input p
transcript <- get
ok <- checkSuccessProcess pid
return (transcript, ok)
#else
{- This implementation for Windows puts stderr after stdout. -}
p@(_, _, _, pid) <- createProcess $ cp
{ std_in = if isJust input then CreatePipe else Inherit
, std_out = CreatePipe
, std_err = CreatePipe
}
getout <- mkreader (stdoutHandle p)
geterr <- mkreader (stderrHandle p)
writeinput input p
transcript <- (++) <$> getout <*> geterr
ok <- checkSuccessProcess pid
return (transcript, ok)
#endif
where
mkreader h = do
s <- hGetContents h
v <- newEmptyMVar
void $ forkIO $ do
void $ E.evaluate (length s)
putMVar v ()
return $ do
takeMVar v
return s
writeinput (Just s) p = do
let inh = stdinHandle p
unless (null s) $ do
hPutStr inh s
hFlush inh
hClose inh
writeinput Nothing _ = return ()