{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE TypeApplications #-}

module HaskellWorks.CabalCache.GhcPkg where

import Control.Lens
import Data.Generics.Product.Any
import System.Exit               (ExitCode (..), exitWith)
import System.Process            (waitForProcess)

import qualified HaskellWorks.CabalCache.Types as Z
import qualified System.IO                     as IO
import qualified System.Process                as IO

system :: [String] -> IO IO.ProcessHandle
system :: [String] -> IO ProcessHandle
system (String
cmd:[String]
args) = String -> [String] -> IO ProcessHandle
IO.spawnProcess String
cmd [String]
args
system []         = String -> IO ProcessHandle
forall a. HasCallStack => String -> a
error String
"No command supplied" -- TODO Better error handling

runGhcPkg :: Z.CompilerContext -> [String] -> IO ()
runGhcPkg :: CompilerContext -> [String] -> IO ()
runGhcPkg CompilerContext
cc [String]
params = do
  ProcessHandle
hGhcPkg2 <- [String] -> IO ProcessHandle
system ((CompilerContext
cc CompilerContext
-> Getting [String] CompilerContext [String] -> [String]
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "ghcPkgCmd" s t a b => Lens s t a b
the @"ghcPkgCmd") [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
params)
  ExitCode
exitCodeGhcPkg2 <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
hGhcPkg2
  case ExitCode
exitCodeGhcPkg2 of
    ExitFailure Int
_ -> do
      Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr String
"ERROR: Unable to recache package db"
      ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
    ExitCode
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

testAvailability :: Z.CompilerContext -> IO ()
testAvailability :: CompilerContext -> IO ()
testAvailability CompilerContext
cc = CompilerContext -> [String] -> IO ()
runGhcPkg CompilerContext
cc [String
"--version"]

recache :: Z.CompilerContext -> FilePath -> IO ()
recache :: CompilerContext -> String -> IO ()
recache CompilerContext
cc String
packageDb = CompilerContext -> [String] -> IO ()
runGhcPkg CompilerContext
cc [String
"recache", String
"--package-db", String
packageDb]

init :: Z.CompilerContext -> FilePath -> IO ()
init :: CompilerContext -> String -> IO ()
init CompilerContext
cc String
packageDb = CompilerContext -> [String] -> IO ()
runGhcPkg CompilerContext
cc [String
"init", String
packageDb]