Add Haskell script trying to reproduce the build

We add a Haskell script in charge of reproducing the build.

ReproTest.hs

@@ -1,9 +1,19 @@
 #!/usr/bin/env nix-shell
-#!nix-shell -i runhaskell -p "haskellPackages.ghcWithPackages(p: with p; [ optparse-applicative text process ])" -p nix -p diffoscope
+#!nix-shell -i runhaskell -p "haskellPackages.ghcWithPackages(p: with p; [ relude optparse-applicative process ])" -p nix -p diffoscope
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
 
+import Relude
+
+import Data.Maybe
+import GHC.IO.Handle
+import Control.Monad.Except
+import Control.DeepSeq
 import Options.Applicative
-import Data.Text hiding (filter)
-import System.Exit
+import Data.Text hiding (foldl')
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import qualified System.Exit as E
 import System.Process
 
 
@@ -13,56 +23,76 @@ data Config = Config
 
 type ReproPaths = [Text]
 type StorePath  = Text
+type NixError   = Text
+type ReproStatus = Maybe ReproPaths
 
 main :: IO ()
 main = do
   c <- execParser opts
-  mdp <- repro c
-  print mdp
-  pure ()
+  rs <- runExceptT $ repro c
+  case rs of
+    Left err -> T.putStr err >> exitFailure
+    Right Nothing -> T.putStr "SUCCESS" >> exitSuccess
+    Right (Just rp) -> T.putStr $ "Cannot Reproduce build:\n" <> unwords rp
   where
     opts = info (configParser <**> helper)
        ( fullDesc
        <> header "ReproTest.hs - Test the GHC binary reproducibility for a hackage package"
        )
 
-repro :: Config -> IO (Maybe ReproPaths)
+configParser :: Parser Config
+configParser = Config
+  <$> strOption (long "package-name" <> short 'p' <> help "Hackage package to test")
+  <*> strOption (long "ghc-nixexpr-path" <> short 'e' <> help "Path to the nix derivation retrieving the custom GHC checkpout you want to use.")
+
+repro :: (MonadIO m) => Config -> ExceptT NixError m ReproStatus
 repro c = do
   -- 1. Nix instantiate derivation
-  (eci, drvPathDirty, err) <- readProcessWithExitCode "nix-instantiate"
+  (eci, drvPath) <- streamRunCmd "nix-instantiate"
     [
-      "--arg", "hs-pkg-name", "\"" ++ unpack (pkgName c) ++ "\"",
-      "--arg", "ghcSrc", unpack $ ghcPath c,
+      "--arg", "hs-pkg-name", "\"" <> pkgName c <> "\"",
+      "--arg", "ghcSrcDrv", ghcPath c,
       "./repro.nix"
-    ] ""
-  let drvPath =  filter (/= '\n') drvPathDirty
-  print err
-  print drvPath
-  print eci
+    ] True
   -- 2. nix-store --realize /nix/store/xxx.drv
-  (ecr1, p1, err1) <- readProcessWithExitCode "nix-store"
-    [ "--realise", "--quiet", filter (/= '\n') drvPath ] ""
-  print ecr1
-  print p1
-  print err1
+  (_, p1) <- streamRunCmd "nix-store"
+    ["--realise", "--quiet", drvPath] True
   -- 3. nix-store --realize --check /nix/store/xxx.drv
-  (ecr2, p2, err2) <- readProcessWithExitCode "nix-store"
-    [ "--realise", "--quiet", "-K", "--check", drvPath ] ""
-  print ecr2
-  print p2
-  print ecr2
+  (ecr2, p2) <- streamRunCmd "nix-store"
+    ["--realise", "--quiet", "-K", "--check", drvPath] False
   -- 4. If exit code > 1 => Just two repro paths
-  if ecr2 == ExitSuccess
+  if ecr2 == E.ExitSuccess
     then pure Nothing
-    else pure $ Just [ pack p1, pack p2 ]
+    else pure $ Just [ p1, p2 ]
+
+
 
 runDiffoscope :: ReproPaths -> IO StorePath
 runDiffoscope = undefined
   -- Take the two different paths.
   -- Run diffoscope on them.
 
-configParser :: Parser Config
-configParser = Config
-  <$> strOption (long "package-name" <> short 'p' <> help "Hackage package to test")
-  <*> (strOption (long "ghc-path" <> short 'g' <> help "Path to the local GHC checkpoint")
-       <|> strOption (long "ghc-nixexpr-path" <> short 'e' <> help "Path to the nix expression generating the GHC binary"))
+-- Partially vendored from Shask
+-- TODO:
+-- - Handle custom Exp stacks in Shask.
+-- - Determine whether the out parsing should be part of the Shask API or not.
+-- - Release Shask.
+streamRunCmd :: (MonadIO m) => Text -> [Text] -> Bool -> ExceptT NixError m (E.ExitCode, StorePath)
+streamRunCmd cmd args fail = do
+    liftIO . T.putStr $ "[+] " <> cmd <> " " <> unwords args <> "\n\n"
+    (ec, out) <- liftIO $ withCreateProcess p progressFn
+    when (ec /= E.ExitSuccess && fail) . throwError $ "Failed to run " <> cmd <> " " <> unwords args
+    liftIO $ T.putStr $ "    " <> "DONE\n\n"
+    return (force ec, force . T.filter (/= '\n') $ out)
+  where
+      p = (proc (unpack cmd) (unpack <$> args)) { std_out = CreatePipe, std_err = CreatePipe }
+      progressFn _ (Just hout) (Just herr) ph = go
+        where
+          go = do
+            eof <- hIsEOF herr
+            unless eof $ T.hGetLine herr >>= T.putStrLn
+            mec <- getProcessExitCode ph
+            case mec of
+              (Just ec) -> T.hGetContents hout >>= \out -> pure (ec, out)
+              Nothing   -> go
+      progressFn _ _ _ ph = error "Cannot open subprocess IO handles"