module Distribution.Cab.Commands (
    FunctionCommand
  , Option(..)
  , deps, revdeps, installed, outdated, uninstall, search
  , genpaths, check, initSandbox, add, ghci
  ) where

import qualified Control.Exception as E
import Control.Monad (forM_, unless, when, void)
import Data.Char (toLower)
import Data.List (intercalate, isPrefixOf)
import qualified Data.Map as M
import Distribution.Cab.GenPaths
import Distribution.Cab.PkgDB
import Distribution.Cab.Printer
import Distribution.Cab.Sandbox
import Distribution.Cab.VerDB
import Distribution.Cab.Version
import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
import System.Exit (exitFailure)
import System.FilePath (takeDirectory, takeFileName)
import System.IO (hPutStrLn, stderr)
import System.Process (readProcess, system)

----------------------------------------------------------------

type FunctionCommand = [String] -> [Option] -> [String] -> IO ()

data Option = OptNoharm
            | OptRecursive
            | OptAll
            | OptInfo
            | OptFlag String
            | OptTest
            | OptHelp
            | OptBench
            | OptDepsOnly
            | OptLibProfile
            | OptExecProfile
            | OptJobs String
            | OptImport String
            | OptStatic
            | OptFuture
            | OptDebug
            | OptAllowNewer
            | OptCleanUp
            deriving (Option -> Option -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c== :: Option -> Option -> Bool
Eq,Int -> Option -> ShowS
[Option] -> ShowS
Option -> PkgName
forall a.
(Int -> a -> ShowS) -> (a -> PkgName) -> ([a] -> ShowS) -> Show a
showList :: [Option] -> ShowS
$cshowList :: [Option] -> ShowS
show :: Option -> PkgName
$cshow :: Option -> PkgName
showsPrec :: Int -> Option -> ShowS
$cshowsPrec :: Int -> Option -> ShowS
Show)

----------------------------------------------------------------

search :: FunctionCommand
search :: FunctionCommand
search [PkgName
x] [Option]
_ [PkgName]
_ = do
    [(PkgName, Ver)]
nvls <- VerDB -> [(PkgName, Ver)]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HowToObtain -> IO VerDB
getVerDB HowToObtain
AllRegistered
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall {b}. [(PkgName, b)] -> [(PkgName, b)]
lok [(PkgName, Ver)]
nvls) forall a b. (a -> b) -> a -> b
$ \(PkgName
n,Ver
v) -> PkgName -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ PkgName
n forall a. [a] -> [a] -> [a]
++ PkgName
" " forall a. [a] -> [a] -> [a]
++ Ver -> PkgName
verToString Ver
v
  where
    key :: PkgName
key = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower PkgName
x
    sat :: (PkgName, b) -> Bool
sat (PkgName
n,b
_) = PkgName
key forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower PkgName
n
    lok :: [(PkgName, b)] -> [(PkgName, b)]
lok = forall a. (a -> Bool) -> [a] -> [a]
filter forall {b}. (PkgName, b) -> Bool
sat
search [PkgName]
_ [Option]
_ [PkgName]
_ = do
    Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr PkgName
"One search-key should be specified."
    forall a. IO a
exitFailure

----------------------------------------------------------------

installed :: FunctionCommand
installed :: FunctionCommand
installed [PkgName]
_ [Option]
opts [PkgName]
_ = do
    PkgDB
db <- [Option] -> IO PkgDB
getDB [Option]
opts
    let pkgs :: [PkgInfo]
pkgs = PkgDB -> [PkgInfo]
toPkgInfos PkgDB
db
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PkgInfo]
pkgs forall a b. (a -> b) -> a -> b
$ \PkgInfo
pkgi -> do
        PkgName -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ PkgInfo -> PkgName
fullNameOfPkgInfo PkgInfo
pkgi
        Bool -> PkgInfo -> IO ()
extraInfo Bool
info PkgInfo
pkgi
        PkgName -> IO ()
putStrLn PkgName
""
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
optrec forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()
printDeps Bool
True Bool
info PkgDB
db Int
1 PkgInfo
pkgi
  where
    info :: Bool
info = Option
OptInfo forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
    optrec :: Bool
optrec = Option
OptRecursive forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts

outdated :: FunctionCommand
outdated :: FunctionCommand
outdated [PkgName]
_ [Option]
opts [PkgName]
_ = do
    [PkgInfo]
pkgs <- PkgDB -> [PkgInfo]
toPkgInfos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Option] -> IO PkgDB
getDB [Option]
opts
    Map PkgName Ver
verDB <- VerDB -> Map PkgName Ver
toMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HowToObtain -> IO VerDB
getVerDB HowToObtain
InstalledOnly
    let del :: Bool
del = Option
OptCleanUp forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PkgInfo]
pkgs forall a b. (a -> b) -> a -> b
$ \PkgInfo
p -> case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (PkgInfo -> PkgName
nameOfPkgInfo PkgInfo
p) Map PkgName Ver
verDB of
        Maybe Ver
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Ver
ver -> do
            let comp :: Ordering
comp = PkgInfo -> Ver
verOfPkgInfo PkgInfo
p forall a. Ord a => a -> a -> Ordering
`compare` Ver
ver
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ordering -> Bool
dated Ordering
comp) forall a b. (a -> b) -> a -> b
$ do
                if Bool
del then do
                    let (PkgName
nm,PkgName
vr) = PkgInfo -> (PkgName, PkgName)
pairNameOfPkgInfo PkgInfo
p
                    FunctionCommand
uninstall [PkgName
nm,PkgName
vr] [Option
OptRecursive] [] forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(E.SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  else
                    PkgName -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ PkgInfo -> PkgName
fullNameOfPkgInfo PkgInfo
p forall a. [a] -> [a] -> [a]
++ Ordering -> PkgName
showIneq Ordering
comp forall a. [a] -> [a] -> [a]
++ Ver -> PkgName
verToString Ver
ver
  where
    dated :: Ordering -> Bool
dated Ordering
LT = Bool
True
    dated Ordering
GT = Option
OptFuture forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
    dated Ordering
EQ = Bool
False
    showIneq :: Ordering -> PkgName
showIneq Ordering
LT = PkgName
" < "
    showIneq Ordering
GT = PkgName
" > "
    showIneq Ordering
EQ = forall a. HasCallStack => PkgName -> a
error PkgName
"Packages have equal versions"

getDB :: [Option] -> IO PkgDB
getDB :: [Option] -> IO PkgDB
getDB [Option]
opts
  | Bool
optall    = IO (Maybe PkgName)
getSandbox forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe PkgName -> IO PkgDB
getPkgDB
  | Bool
otherwise = IO (Maybe PkgName)
getSandbox forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe PkgName -> IO PkgDB
getUserPkgDB
  where
    optall :: Bool
optall = Option
OptAll forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts

----------------------------------------------------------------

uninstall :: FunctionCommand
uninstall :: FunctionCommand
uninstall [PkgName]
nmver [Option]
opts [PkgName]
_ = do
    PkgDB
userDB <- IO (Maybe PkgName)
getSandbox forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe PkgName -> IO PkgDB
getUserPkgDB
    PkgInfo
pkg <- [PkgName] -> PkgDB -> IO PkgInfo
lookupPkg [PkgName]
nmver PkgDB
userDB
    let sortedPkgs :: [PkgInfo]
sortedPkgs = PkgInfo -> PkgDB -> [PkgInfo]
topSortedPkgs PkgInfo
pkg PkgDB
userDB
    if Bool
onlyOne Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [PkgInfo]
sortedPkgs forall a. Eq a => a -> a -> Bool
/= Int
1 then do
        Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr PkgName
"The following packages depend on this. Use the \"-r\" option."
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgInfo -> PkgName
fullNameOfPkgInfo) (forall a. [a] -> [a]
init [PkgInfo]
sortedPkgs)
      else do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doit forall a b. (a -> b) -> a -> b
$ PkgName -> IO ()
putStrLn PkgName
"The following packages are deleted without the \"-n\" option."
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> [Option] -> PkgInfo -> IO ()
purge Bool
doit [Option]
opts) [PkgInfo]
sortedPkgs
  where
    onlyOne :: Bool
onlyOne = Option
OptRecursive forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Option]
opts
    doit :: Bool
doit = Option
OptNoharm forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Option]
opts

purge :: Bool -> [Option] -> PkgInfo -> IO ()
purge :: Bool -> [Option] -> PkgInfo -> IO ()
purge Bool
doit [Option]
opts PkgInfo
pkgInfo = do
    [PkgName]
sandboxOpts <- (PkgName -> [PkgName]
makeOptList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PkgName -> PkgName
getSandboxOpts2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe PkgName)
getSandbox
    [PkgName]
dirs <- (PkgName, PkgName) -> [PkgName] -> IO [PkgName]
getDirs (PkgName, PkgName)
nameVer [PkgName]
sandboxOpts
    Bool -> [Option] -> (PkgName, PkgName) -> IO ()
unregister Bool
doit [Option]
opts (PkgName, PkgName)
nameVer
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PkgName -> IO ()
unregisterInternal forall a b. (a -> b) -> a -> b
$ PkgInfo -> [PkgName]
findInternalLibs PkgInfo
pkgInfo
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> PkgName -> IO ()
removeDir Bool
doit) [PkgName]
dirs
  where
    unregisterInternal :: PkgName -> IO ()
unregisterInternal PkgName
subname = Bool -> [Option] -> (PkgName, PkgName) -> IO ()
unregister Bool
doit [Option]
opts (PkgName
nm,PkgName
ver)
      where
        nm :: PkgName
nm = PkgName
"z-" forall a. [a] -> [a] -> [a]
++ PkgName
name forall a. [a] -> [a] -> [a]
++ PkgName
"-z-" forall a. [a] -> [a] -> [a]
++ PkgName
subname
    nameVer :: (PkgName, PkgName)
nameVer@(PkgName
name,PkgName
ver) = PkgInfo -> (PkgName, PkgName)
pairNameOfPkgInfo PkgInfo
pkgInfo
    makeOptList :: PkgName -> [PkgName]
makeOptList PkgName
"" = []
    makeOptList PkgName
x  = [PkgName
x]

getDirs :: (String,String) -> [String] -> IO [FilePath]
getDirs :: (PkgName, PkgName) -> [PkgName] -> IO [PkgName]
getDirs (PkgName
name,PkgName
ver) [PkgName]
sandboxOpts = do
    [PkgName]
importDirs <- PkgName -> IO [PkgName]
queryGhcPkg PkgName
"import-dirs"
    [PkgName]
haddock <- forall a b. (a -> b) -> [a] -> [b]
map ShowS
docDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PkgName -> IO [PkgName]
queryGhcPkg PkgName
"haddock-html"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [PkgName] -> [PkgName]
topDir forall a b. (a -> b) -> a -> b
$ [PkgName]
importDirs forall a. [a] -> [a] -> [a]
++ [PkgName]
haddock
  where
    nameVer :: PkgName
nameVer = PkgName
name forall a. [a] -> [a] -> [a]
++ PkgName
"-" forall a. [a] -> [a] -> [a]
++ PkgName
ver
    queryGhcPkg :: PkgName -> IO [PkgName]
queryGhcPkg PkgName
field = do
        let options :: [PkgName]
options = [PkgName
"field"] forall a. [a] -> [a] -> [a]
++ [PkgName]
sandboxOpts forall a. [a] -> [a] -> [a]
++ [PkgName
nameVer, PkgName
field]
        [PkgName]
ws <- PkgName -> [PkgName]
words forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PkgName -> [PkgName] -> PkgName -> IO PkgName
readProcess PkgName
"ghc-pkg" [PkgName]
options PkgName
""
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case [PkgName]
ws of
            []     -> []
            (PkgName
_:[PkgName]
xs) -> [PkgName]
xs
    docDir :: ShowS
docDir PkgName
dir
      | ShowS
takeFileName PkgName
dir forall a. Eq a => a -> a -> Bool
== PkgName
"html" = ShowS
takeDirectory PkgName
dir
      | Bool
otherwise                  = PkgName
dir
    topDir :: [PkgName] -> [PkgName]
topDir []     = []
    topDir ds :: [PkgName]
ds@(PkgName
dir:[PkgName]
_)
      | ShowS
takeFileName PkgName
top forall a. Eq a => a -> a -> Bool
== PkgName
nameVer = PkgName
top forall a. a -> [a] -> [a]
: [PkgName]
ds
      | Bool
otherwise                   = [PkgName]
ds
      where
        top :: PkgName
top = ShowS
takeDirectory PkgName
dir

removeDir :: Bool -> FilePath -> IO ()
removeDir :: Bool -> PkgName -> IO ()
removeDir Bool
doit PkgName
dir = do
    Bool
exist <- PkgName -> IO Bool
doesDirectoryExist PkgName
dir
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exist forall a b. (a -> b) -> a -> b
$ do
        PkgName -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ PkgName
"Deleting " forall a. [a] -> [a] -> [a]
++ PkgName
dir
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doit forall a b. (a -> b) -> a -> b
$ PkgName -> IO ()
removeDirectoryRecursive PkgName
dir

unregister :: Bool -> [Option] -> (String,String) -> IO ()
unregister :: Bool -> [Option] -> (PkgName, PkgName) -> IO ()
unregister Bool
doit [Option]
_ (PkgName
name,PkgName
ver) =
    if Bool
doit then do
        PkgName -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ PkgName
"Deleting " forall a. [a] -> [a] -> [a]
++ PkgName
name forall a. [a] -> [a] -> [a]
++ PkgName
" " forall a. [a] -> [a] -> [a]
++ PkgName
ver
        PkgName
sandboxOpts <- Maybe PkgName -> PkgName
getSandboxOpts2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe PkgName)
getSandbox
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doit forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> IO ExitCode
system forall a b. (a -> b) -> a -> b
$ ShowS
script PkgName
sandboxOpts
      else
        PkgName -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ PkgName
name forall a. [a] -> [a] -> [a]
++ PkgName
" " forall a. [a] -> [a] -> [a]
++ PkgName
ver
  where
    script :: ShowS
script PkgName
sandboxOpts = PkgName
"ghc-pkg unregister " forall a. [a] -> [a] -> [a]
++ PkgName
sandboxOpts forall a. [a] -> [a] -> [a]
++ PkgName
" " forall a. [a] -> [a] -> [a]
++ PkgName
name forall a. [a] -> [a] -> [a]
++ PkgName
"-" forall a. [a] -> [a] -> [a]
++ PkgName
ver

----------------------------------------------------------------

genpaths :: FunctionCommand
genpaths :: FunctionCommand
genpaths [PkgName]
_ [Option]
_ [PkgName]
_ = IO ()
genPaths

----------------------------------------------------------------

check :: FunctionCommand
check :: FunctionCommand
check [PkgName]
_ [Option]
_ [PkgName]
_ = do
    PkgName
sandboxOpts <- Maybe PkgName -> PkgName
getSandboxOpts2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe PkgName)
getSandbox
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> IO ExitCode
system forall a b. (a -> b) -> a -> b
$ ShowS
script PkgName
sandboxOpts
  where
    script :: ShowS
script PkgName
sandboxOpts = PkgName
"ghc-pkg check -v " forall a. [a] -> [a] -> [a]
++ PkgName
sandboxOpts

----------------------------------------------------------------

deps :: FunctionCommand
deps :: FunctionCommand
deps [PkgName]
nmver [Option]
opts [PkgName]
_ = [PkgName]
-> [Option]
-> (Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ())
-> IO ()
printDepends [PkgName]
nmver [Option]
opts Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()
printDeps

revdeps :: FunctionCommand
revdeps :: FunctionCommand
revdeps [PkgName]
nmver [Option]
opts [PkgName]
_ = [PkgName]
-> [Option]
-> (Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ())
-> IO ()
printDepends [PkgName]
nmver [Option]
opts Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()
printRevDeps

printDepends :: [String] -> [Option]
             -> (Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()) -> IO ()
printDepends :: [PkgName]
-> [Option]
-> (Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ())
-> IO ()
printDepends [PkgName]
nmver [Option]
opts Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()
func = do
    PkgDB
db' <- IO (Maybe PkgName)
getSandbox forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe PkgName -> IO PkgDB
getPkgDB
    PkgInfo
pkg <- [PkgName] -> PkgDB -> IO PkgInfo
lookupPkg [PkgName]
nmver PkgDB
db'
    PkgDB
db <- [Option] -> IO PkgDB
getDB [Option]
opts
    Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()
func Bool
rec Bool
info PkgDB
db Int
0 PkgInfo
pkg
  where
    rec :: Bool
rec = Option
OptRecursive forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
    info :: Bool
info = Option
OptInfo forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts

----------------------------------------------------------------

lookupPkg :: [String] -> PkgDB -> IO PkgInfo
lookupPkg :: [PkgName] -> PkgDB -> IO PkgInfo
lookupPkg [] PkgDB
_ = do
  Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr PkgName
"Package name must be specified."
  forall a. IO a
exitFailure
lookupPkg [PkgName
name] PkgDB
db = [PkgInfo] -> IO PkgInfo
checkOne forall a b. (a -> b) -> a -> b
$ PkgName -> PkgDB -> [PkgInfo]
lookupByName PkgName
name PkgDB
db
lookupPkg [PkgName
name,PkgName
ver] PkgDB
db = [PkgInfo] -> IO PkgInfo
checkOne forall a b. (a -> b) -> a -> b
$ PkgName -> PkgName -> PkgDB -> [PkgInfo]
lookupByVersion PkgName
name PkgName
ver PkgDB
db
lookupPkg [PkgName]
_ PkgDB
_ = do
  Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr PkgName
"Only one package name must be specified."
  forall a. IO a
exitFailure

checkOne :: [PkgInfo] -> IO PkgInfo
checkOne :: [PkgInfo] -> IO PkgInfo
checkOne [] = do
    Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr PkgName
"No such package found."
    forall a. IO a
exitFailure
checkOne [PkgInfo
pkg] = forall (m :: * -> *) a. Monad m => a -> m a
return PkgInfo
pkg
checkOne [PkgInfo]
pkgs = do
    Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr PkgName
"Package version must be specified."
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgInfo -> PkgName
fullNameOfPkgInfo) [PkgInfo]
pkgs
    forall a. IO a
exitFailure

----------------------------------------------------------------

initSandbox :: FunctionCommand
initSandbox :: FunctionCommand
initSandbox []     [Option]
_ [PkgName]
_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> IO ExitCode
system forall a b. (a -> b) -> a -> b
$ PkgName
"cabal v1-sandbox init"
initSandbox [PkgName
path] [Option]
_ [PkgName]
_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> IO ExitCode
system forall a b. (a -> b) -> a -> b
$ PkgName
"cabal v1-sandbox init --sandbox " forall a. [a] -> [a] -> [a]
++ PkgName
path
initSandbox [PkgName]
_      [Option]
_ [PkgName]
_ = do
    Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr PkgName
"Only one argument is allowed"
    forall a. IO a
exitFailure

----------------------------------------------------------------

add :: FunctionCommand
add :: FunctionCommand
add [PkgName
src] [Option]
_ [PkgName]
_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> IO ExitCode
system forall a b. (a -> b) -> a -> b
$ PkgName
"cabal v1-sandbox add-source " forall a. [a] -> [a] -> [a]
++ PkgName
src
add [PkgName]
_     [Option]
_ [PkgName]
_ = do
    Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr PkgName
"A source path be specified."
    forall a. IO a
exitFailure

----------------------------------------------------------------

ghci :: FunctionCommand
ghci :: FunctionCommand
ghci [PkgName]
args [Option]
_ [PkgName]
options = do
    PkgName
sbxOpts <- Maybe PkgName -> PkgName
getSandboxOpts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe PkgName)
getSandbox
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ PkgName -> IO ExitCode
system forall a b. (a -> b) -> a -> b
$ PkgName
"ghci" forall a. [a] -> [a] -> [a]
++ PkgName
" " forall a. [a] -> [a] -> [a]
++ PkgName
sbxOpts forall a. [a] -> [a] -> [a]
++ PkgName
" " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate PkgName
" " ([PkgName]
options forall a. [a] -> [a] -> [a]
++ [PkgName]
args)