{-# 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 :: [[Char]] -> IO ()
externalCommand [[Char]]
args = do
  [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"CABAL" IO (Maybe [Char]) -> (Maybe [Char] -> 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 [Char]
Nothing -> [Char] -> [[Char]] -> IO ()
run [Char]
"cabal" [[Char]]
args
    Just [Char]
cabal -> [Char] -> [[Char]] -> IO ()
run [Char]
cabal (Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
1 [[Char]]
args)

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

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

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

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

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

  callProcess doctest ["--version"]

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

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

    Bool
False -> do
      [Char] -> ([Char] -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> m a) -> m a
withSystemTempDirectory [Char]
"cabal-doctest" (([Char] -> IO ()) -> IO ()) -> ([Char] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ [Char]
dir -> do
        [[Char]] -> IO ()
repl [[Char]
"--keep-temp-files", [Char]
"--repl-multi-file", [Char]
dir]
        files <- ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [Char]
"-inplace") ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
listDirectory [Char]
dir
        let options = ([Char] -> [[Char]]) -> [[Char]] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ [Char]
file -> [[Char]
"-unit", Char
'@' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
file]) [[Char]]
files
        call doctest ("--no-magic" : options)

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