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
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
/= :: Option -> Option -> Bool
Eq,Int -> Option -> ShowS
[Option] -> ShowS
Option -> PkgName
(Int -> Option -> ShowS)
-> (Option -> PkgName) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> PkgName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Option -> ShowS
showsPrec :: Int -> Option -> ShowS
$cshow :: Option -> PkgName
show :: Option -> PkgName
$cshowList :: [Option] -> ShowS
showList :: [Option] -> ShowS
Show)
search :: FunctionCommand
search :: FunctionCommand
search [PkgName
x] [Option]
_ [PkgName]
_ = do
[(PkgName, Ver)]
nvls <- VerDB -> [(PkgName, Ver)]
toList (VerDB -> [(PkgName, Ver)]) -> IO VerDB -> IO [(PkgName, Ver)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HowToObtain -> IO VerDB
getVerDB HowToObtain
AllRegistered
[(PkgName, Ver)] -> ((PkgName, Ver) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(PkgName, Ver)] -> [(PkgName, Ver)]
forall {b}. [(PkgName, b)] -> [(PkgName, b)]
lok [(PkgName, Ver)]
nvls) (((PkgName, Ver) -> IO ()) -> IO ())
-> ((PkgName, Ver) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(PkgName
n,Ver
v) -> PkgName -> IO ()
putStrLn (PkgName -> IO ()) -> PkgName -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgName
n PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
" " PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ Ver -> PkgName
verToString Ver
v
where
key :: PkgName
key = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower PkgName
x
sat :: (PkgName, b) -> Bool
sat (PkgName
n,b
_) = PkgName
key PkgName -> PkgName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower PkgName
n
lok :: [(PkgName, b)] -> [(PkgName, b)]
lok = ((PkgName, b) -> Bool) -> [(PkgName, b)] -> [(PkgName, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (PkgName, b) -> Bool
forall {b}. (PkgName, b) -> Bool
sat
search [PkgName]
_ [Option]
_ [PkgName]
_ = do
Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr PkgName
"One search-key should be specified."
IO ()
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
[PkgInfo] -> (PkgInfo -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PkgInfo]
pkgs ((PkgInfo -> IO ()) -> IO ()) -> (PkgInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PkgInfo
pkgi -> do
PkgName -> IO ()
putStr (PkgName -> IO ()) -> PkgName -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgInfo -> PkgName
fullNameOfPkgInfo PkgInfo
pkgi
Bool -> PkgInfo -> IO ()
extraInfo Bool
info PkgInfo
pkgi
PkgName -> IO ()
putStrLn PkgName
""
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
optrec (IO () -> IO ()) -> IO () -> IO ()
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 Option -> [Option] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
optrec :: Bool
optrec = Option
OptRecursive Option -> [Option] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 (PkgDB -> [PkgInfo]) -> IO PkgDB -> IO [PkgInfo]
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 (VerDB -> Map PkgName Ver) -> IO VerDB -> IO (Map PkgName Ver)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HowToObtain -> IO VerDB
getVerDB HowToObtain
InstalledOnly
let del :: Bool
del = Option
OptCleanUp Option -> [Option] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
[PkgInfo] -> (PkgInfo -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PkgInfo]
pkgs ((PkgInfo -> IO ()) -> IO ()) -> (PkgInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PkgInfo
p -> case PkgName -> Map PkgName Ver -> Maybe Ver
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 -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Ver
ver -> do
let comp :: Ordering
comp = PkgInfo -> Ver
verOfPkgInfo PkgInfo
p Ver -> Ver -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Ver
ver
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ordering -> Bool
dated Ordering
comp) (IO () -> IO ()) -> IO () -> IO ()
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] [] IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(E.SomeException e
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else
PkgName -> IO ()
putStrLn (PkgName -> IO ()) -> PkgName -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgInfo -> PkgName
fullNameOfPkgInfo PkgInfo
p PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ Ordering -> PkgName
showIneq Ordering
comp PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ Ver -> PkgName
verToString Ver
ver
where
dated :: Ordering -> Bool
dated Ordering
LT = Bool
True
dated Ordering
GT = Option
OptFuture Option -> [Option] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 = ShowS
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 IO (Maybe PkgName) -> (Maybe PkgName -> IO PkgDB) -> IO PkgDB
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe PkgName -> IO PkgDB
getPkgDB
| Bool
otherwise = IO (Maybe PkgName)
getSandbox IO (Maybe PkgName) -> (Maybe PkgName -> IO PkgDB) -> IO PkgDB
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe PkgName -> IO PkgDB
getUserPkgDB
where
optall :: Bool
optall = Option
OptAll Option -> [Option] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 IO (Maybe PkgName) -> (Maybe PkgName -> IO PkgDB) -> IO PkgDB
forall a b. IO a -> (a -> IO b) -> IO b
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
&& [PkgInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PkgInfo]
sortedPkgs Int -> Int -> Bool
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."
(PkgInfo -> IO ()) -> [PkgInfo] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr (PkgName -> IO ()) -> (PkgInfo -> PkgName) -> PkgInfo -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgInfo -> PkgName
fullNameOfPkgInfo) ([PkgInfo] -> [PkgInfo]
forall a. HasCallStack => [a] -> [a]
init [PkgInfo]
sortedPkgs)
else do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doit (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgName -> IO ()
putStrLn PkgName
"The following packages are deleted without the \"-n\" option."
(PkgInfo -> IO ()) -> [PkgInfo] -> IO ()
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 Option -> [Option] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Option]
opts
doit :: Bool
doit = Option
OptNoharm Option -> [Option] -> Bool
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 (PkgName -> [PkgName])
-> (Maybe PkgName -> PkgName) -> Maybe PkgName -> [PkgName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PkgName -> PkgName
getSandboxOpts2) (Maybe PkgName -> [PkgName]) -> IO (Maybe PkgName) -> IO [PkgName]
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
(PkgName -> IO ()) -> [PkgName] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PkgName -> IO ()
unregisterInternal ([PkgName] -> IO ()) -> [PkgName] -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgInfo -> [PkgName]
findInternalLibs PkgInfo
pkgInfo
(PkgName -> IO ()) -> [PkgName] -> IO ()
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-" PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
name PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
"-z-" PkgName -> ShowS
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 <- ShowS -> [PkgName] -> [PkgName]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
docDir ([PkgName] -> [PkgName]) -> IO [PkgName] -> IO [PkgName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PkgName -> IO [PkgName]
queryGhcPkg PkgName
"haddock-html"
[PkgName] -> IO [PkgName]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PkgName] -> IO [PkgName]) -> [PkgName] -> IO [PkgName]
forall a b. (a -> b) -> a -> b
$ [PkgName] -> [PkgName]
topDir ([PkgName] -> [PkgName]) -> [PkgName] -> [PkgName]
forall a b. (a -> b) -> a -> b
$ [PkgName]
importDirs [PkgName] -> [PkgName] -> [PkgName]
forall a. [a] -> [a] -> [a]
++ [PkgName]
haddock
where
nameVer :: PkgName
nameVer = PkgName
name PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
"-" PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
ver
queryGhcPkg :: PkgName -> IO [PkgName]
queryGhcPkg PkgName
field = do
let options :: [PkgName]
options = [PkgName
"field"] [PkgName] -> [PkgName] -> [PkgName]
forall a. [a] -> [a] -> [a]
++ [PkgName]
sandboxOpts [PkgName] -> [PkgName] -> [PkgName]
forall a. [a] -> [a] -> [a]
++ [PkgName
nameVer, PkgName
field]
[PkgName]
ws <- PkgName -> [PkgName]
words (PkgName -> [PkgName]) -> IO PkgName -> IO [PkgName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PkgName -> [PkgName] -> PkgName -> IO PkgName
readProcess PkgName
"ghc-pkg" [PkgName]
options PkgName
""
[PkgName] -> IO [PkgName]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PkgName] -> IO [PkgName]) -> [PkgName] -> IO [PkgName]
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 PkgName -> PkgName -> Bool
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 PkgName -> PkgName -> Bool
forall a. Eq a => a -> a -> Bool
== PkgName
nameVer = PkgName
top PkgName -> [PkgName] -> [PkgName]
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exist (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
PkgName -> IO ()
putStrLn (PkgName -> IO ()) -> PkgName -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgName
"Deleting " PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
dir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doit (IO () -> IO ()) -> IO () -> IO ()
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 (PkgName -> IO ()) -> PkgName -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgName
"Deleting " PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
name PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
" " PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
ver
PkgName
sandboxOpts <- Maybe PkgName -> PkgName
getSandboxOpts2 (Maybe PkgName -> PkgName) -> IO (Maybe PkgName) -> IO PkgName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe PkgName)
getSandbox
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doit (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ())
-> (PkgName -> IO ExitCode) -> PkgName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> IO ExitCode
system (PkgName -> IO ()) -> PkgName -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
script PkgName
sandboxOpts
else
PkgName -> IO ()
putStrLn (PkgName -> IO ()) -> PkgName -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgName
name PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
" " PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
ver
where
script :: ShowS
script PkgName
sandboxOpts = PkgName
"ghc-pkg unregister " PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
sandboxOpts PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
" " PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
name PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
"-" PkgName -> ShowS
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 (Maybe PkgName -> PkgName) -> IO (Maybe PkgName) -> IO PkgName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe PkgName)
getSandbox
IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ())
-> (PkgName -> IO ExitCode) -> PkgName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> IO ExitCode
system (PkgName -> IO ()) -> PkgName -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
script PkgName
sandboxOpts
where
script :: ShowS
script PkgName
sandboxOpts = PkgName
"ghc-pkg check -v " PkgName -> ShowS
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 IO (Maybe PkgName) -> (Maybe PkgName -> IO PkgDB) -> IO PkgDB
forall a b. IO a -> (a -> IO b) -> IO b
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 Option -> [Option] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
info :: Bool
info = Option
OptInfo Option -> [Option] -> Bool
forall a. Eq a => a -> [a] -> Bool
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."
IO PkgInfo
forall a. IO a
exitFailure
lookupPkg [PkgName
name] PkgDB
db = [PkgInfo] -> IO PkgInfo
checkOne ([PkgInfo] -> IO PkgInfo) -> [PkgInfo] -> IO PkgInfo
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 ([PkgInfo] -> IO PkgInfo) -> [PkgInfo] -> IO PkgInfo
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."
IO PkgInfo
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."
IO PkgInfo
forall a. IO a
exitFailure
checkOne [PkgInfo
pkg] = PkgInfo -> IO PkgInfo
forall a. a -> IO a
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."
(PkgInfo -> IO ()) -> [PkgInfo] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr (PkgName -> IO ()) -> (PkgInfo -> PkgName) -> PkgInfo -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgInfo -> PkgName
fullNameOfPkgInfo) [PkgInfo]
pkgs
IO PkgInfo
forall a. IO a
exitFailure
initSandbox :: FunctionCommand
initSandbox :: FunctionCommand
initSandbox [] [Option]
_ [PkgName]
_ = IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ())
-> (PkgName -> IO ExitCode) -> PkgName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> IO ExitCode
system (PkgName -> IO ()) -> PkgName -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgName
"cabal v1-sandbox init"
initSandbox [PkgName
path] [Option]
_ [PkgName]
_ = IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ())
-> (PkgName -> IO ExitCode) -> PkgName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> IO ExitCode
system (PkgName -> IO ()) -> PkgName -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgName
"cabal v1-sandbox init --sandbox " PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
path
initSandbox [PkgName]
_ [Option]
_ [PkgName]
_ = do
Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr PkgName
"Only one argument is allowed"
IO ()
forall a. IO a
exitFailure
add :: FunctionCommand
add :: FunctionCommand
add [PkgName
src] [Option]
_ [PkgName]
_ = IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ())
-> (PkgName -> IO ExitCode) -> PkgName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> IO ExitCode
system (PkgName -> IO ()) -> PkgName -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgName
"cabal v1-sandbox add-source " PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
src
add [PkgName]
_ [Option]
_ [PkgName]
_ = do
Handle -> PkgName -> IO ()
hPutStrLn Handle
stderr PkgName
"A source path be specified."
IO ()
forall a. IO a
exitFailure
ghci :: FunctionCommand
ghci :: FunctionCommand
ghci [PkgName]
args [Option]
_ [PkgName]
options = do
PkgName
sbxOpts <- Maybe PkgName -> PkgName
getSandboxOpts (Maybe PkgName -> PkgName) -> IO (Maybe PkgName) -> IO PkgName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe PkgName)
getSandbox
IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgName -> IO ExitCode
system (PkgName -> IO ExitCode) -> PkgName -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ PkgName
"ghci" PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
" " PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
sbxOpts PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName
" " PkgName -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgName -> [PkgName] -> PkgName
forall a. [a] -> [[a]] -> [a]
intercalate PkgName
" " ([PkgName]
options [PkgName] -> [PkgName] -> [PkgName]
forall a. [a] -> [a] -> [a]
++ [PkgName]
args)