{-# LANGUAGE LambdaCase #-}
module Cabal (externalCommand) where

import           Imports

import           Data.List
import           Data.Version (makeVersion)
import           System.IO
import           System.IO.Temp
import           System.Environment
import           System.Directory
import           System.FilePath
import           System.Process

import qualified Info
import           Cabal.Paths
import           Cabal.Options

externalCommand :: [String] -> IO ()
externalCommand :: [String] -> IO ()
externalCommand [String]
args = do
  String -> IO (Maybe String)
lookupEnv String
"CABAL" IO (Maybe String) -> (Maybe String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
    Maybe String
Nothing -> String -> [String] -> IO ()
run String
"cabal" [String]
args
    Just String
cabal -> String -> [String] -> IO ()
run String
cabal (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
args)

run :: String -> [String] -> IO ()
run :: String -> [String] -> IO ()
run String
cabal [String]
args = do
  [String] -> IO ()
rejectUnsupportedOptions [String]
args

  Paths{..} <- String -> [String] -> IO Paths
paths String
cabal ([String] -> [String]
discardReplOptions [String]
args)

  let
    doctest = String
cache String -> String -> String
</> String
"doctest" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
Info.version
    script = String
cache String -> String -> String
</> String
"init-ghci-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
Info.version

  doesFileExist doctest >>= \ case
    Bool
True -> IO ()
forall (m :: * -> *). Monad m => m ()
pass
    Bool
False -> String -> [String] -> IO ()
callProcess String
cabal [
        String
"install" , String
"doctest-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
Info.version
      , String
"--flag", String
"-cabal-doctest"
      , String
"--ignore-project"
      , String
"--installdir", String
cache
      , String
"--program-suffix", String
"-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
Info.version
      , String
"--install-method=copy"
      , String
"--with-compiler", String
ghc
      ]

  doesFileExist script >>= \ case
    Bool
True -> IO ()
forall (m :: * -> *). Monad m => m ()
pass
    Bool
False -> String -> String -> IO ()
writeFileAtomically String
script String
":seti -w -Wdefault"

  callProcess doctest ["--version"]

  let
    repl [String]
extraArgs = String -> [String] -> IO ()
call String
cabal (String
"repl"
      String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"--build-depends=QuickCheck"
      String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"--build-depends=template-haskell"
      String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String
"--repl-options=-ghci-script=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
script)
      String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extraArgs)

  case ghcVersion < makeVersion [9,4] of
    Bool
True -> do
      String -> [String] -> IO ()
callProcess String
cabal (String
"build" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"--only-dependencies" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
discardReplOptions [String]
args)
      [String] -> IO ()
repl [String
"--with-compiler", String
doctest, String
"--with-hc-pkg", String
ghcPkg]

    Bool
False -> do
      String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"cabal-doctest" ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ String
dir -> do
        [String] -> IO ()
repl [String
"--keep-temp-files", String
"--repl-multi-file", String
dir]
        files <- (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
"-inplace") ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listDirectory String
dir
        options <- concat <$> mapM (fmap lines . readFile . combine dir) files
        call doctest ("--no-magic" : options)

writeFileAtomically :: FilePath -> String -> IO ()
writeFileAtomically :: String -> String -> IO ()
writeFileAtomically String
name String
contents = do
  (tmp, h) <- String -> String -> IO (String, Handle)
openTempFile (String -> String
takeDirectory String
name) (String -> String
takeFileName String
name)
  hPutStr h contents
  hClose h
  renameFile tmp name