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

import           Imports

import           System.IO
import           System.Environment
import           System.Exit (exitWith)
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
ghc :: String
ghcPkg :: String
cache :: String
ghc :: Paths -> String
ghcPkg :: Paths -> String
cache :: Paths -> String
..} <- String -> [String] -> IO Paths
paths String
cabal ([String] -> [String]
discardReplOptions [String]
args)

  let
    doctest :: String
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
script = String
cache String -> String -> String
</> String
"init-ghci-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
Info.version

  String -> IO Bool
doesFileExist String
doctest IO Bool -> (Bool -> 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
    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
      , String
"--with-hc-pkg", String
ghcPkg
      ]

  String -> IO Bool
doesFileExist String
script IO Bool -> (Bool -> 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
    Bool
True -> IO ()
forall (m :: * -> *). Monad m => m ()
pass
    Bool
False -> String -> String -> IO ()
writeFileAtomically String
script String
":seti -w -Wdefault"

  String -> [String] -> IO ()
callProcess String
doctest [String
"--version"]

  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 -> [String] -> IO ExitCode
rawSystem 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
"--with-compiler", String
doctest
    , String
"--with-hc-pkg", String
ghcPkg
    ]) IO ExitCode -> (ExitCode -> 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
>>= ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith

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