{-# 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