module Distribution.Cab.Commands (
FunctionCommand
, Option(..)
, deps, revdeps, installed, outdated, uninstall, search
, genpaths, check, initSandbox, add, ghci
) where
import Control.Applicative ((<$>))
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
deriving (Option -> Option -> Bool
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
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 -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Option] -> ShowS
$cshowList :: [Option] -> ShowS
show :: Option -> String
$cshow :: Option -> String
showsPrec :: Int -> Option -> ShowS
$cshowsPrec :: Int -> Option -> ShowS
Show)
search :: FunctionCommand
search :: FunctionCommand
search [x :: String
x] _ _ = do
[(String, Ver)]
nvls <- VerDB -> [(String, Ver)]
toList (VerDB -> [(String, Ver)]) -> IO VerDB -> IO [(String, Ver)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HowToObtain -> IO VerDB
getVerDB HowToObtain
AllRegistered
[(String, Ver)] -> ((String, Ver) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(String, Ver)] -> [(String, Ver)]
forall b. [(String, b)] -> [(String, b)]
lok [(String, Ver)]
nvls) (((String, Ver) -> IO ()) -> IO ())
-> ((String, Ver) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(n :: String
n,v :: Ver
v) -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ver -> String
verToString Ver
v
where
key :: String
key = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x
sat :: (String, b) -> Bool
sat (n :: String
n,_) = String
key String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
n
lok :: [(String, b)] -> [(String, b)]
lok = ((String, b) -> Bool) -> [(String, b)] -> [(String, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, b) -> Bool
forall b. (String, b) -> Bool
sat
search _ _ _ = do
Handle -> String -> IO ()
hPutStrLn Handle
stderr "One search-key should be specified."
IO ()
forall a. IO a
exitFailure
installed :: FunctionCommand
installed :: FunctionCommand
installed _ opts :: [Option]
opts _ = 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
$ \pkgi :: PkgInfo
pkgi -> do
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgInfo -> String
fullNameOfPkgInfo PkgInfo
pkgi
Bool -> PkgInfo -> IO ()
extraInfo Bool
info PkgInfo
pkgi
String -> IO ()
putStrLn ""
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 1 PkgInfo
pkgi
where
info :: Bool
info = Option
OptInfo Option -> [Option] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
optrec :: Bool
optrec = Option
OptRecursive Option -> [Option] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
outdated :: FunctionCommand
outdated :: FunctionCommand
outdated _ opts :: [Option]
opts _ = 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 String Ver
verDB <- VerDB -> Map String Ver
toMap (VerDB -> Map String Ver) -> IO VerDB -> IO (Map String Ver)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HowToObtain -> IO VerDB
getVerDB HowToObtain
InstalledOnly
[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
$ \p :: PkgInfo
p -> case String -> Map String Ver -> Maybe Ver
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (PkgInfo -> String
nameOfPkgInfo PkgInfo
p) Map String Ver
verDB of
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ver :: 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
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgInfo -> String
fullNameOfPkgInfo PkgInfo
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Ordering -> String
showIneq Ordering
comp) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ver -> String
verToString Ver
ver
where
dated :: Ordering -> Bool
dated LT = Bool
True
dated GT = Option
OptFuture Option -> [Option] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
dated EQ = Bool
False
showIneq :: Ordering -> String
showIneq LT = " < "
showIneq GT = " > "
showIneq EQ = ShowS
forall a. HasCallStack => String -> a
error "Packages have equal versions"
getDB :: [Option] -> IO PkgDB
getDB :: [Option] -> IO PkgDB
getDB opts :: [Option]
opts
| Bool
optall = IO (Maybe String)
getSandbox IO (Maybe String) -> (Maybe String -> IO PkgDB) -> IO PkgDB
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> IO PkgDB
getPkgDB
| Bool
otherwise = IO (Maybe String)
getSandbox IO (Maybe String) -> (Maybe String -> IO PkgDB) -> IO PkgDB
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> IO PkgDB
getUserPkgDB
where
optall :: Bool
optall = Option
OptAll Option -> [Option] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
uninstall :: FunctionCommand
uninstall :: FunctionCommand
uninstall nmver :: [String]
nmver opts :: [Option]
opts _ = do
PkgDB
userDB <- IO (Maybe String)
getSandbox IO (Maybe String) -> (Maybe String -> IO PkgDB) -> IO PkgDB
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> IO PkgDB
getUserPkgDB
PkgInfo
pkg <- [String] -> PkgDB -> IO PkgInfo
lookupPkg [String]
nmver PkgDB
userDB
let sortedPkgs :: [PkgInfo]
sortedPkgs = PkgInfo -> PkgDB -> [PkgInfo]
topSortedPkgs PkgInfo
pkg PkgDB
userDB
if Bool
onlyOne Bool -> Bool -> Bool
&& [PkgInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PkgInfo]
sortedPkgs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1 then do
Handle -> String -> IO ()
hPutStrLn Handle
stderr "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 -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> (PkgInfo -> String) -> PkgInfo -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgInfo -> String
fullNameOfPkgInfo) ([PkgInfo] -> [PkgInfo]
forall a. [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
$ String -> IO ()
putStrLn "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] -> (String, String) -> IO ()
purge Bool
doit [Option]
opts ((String, String) -> IO ())
-> (PkgInfo -> (String, String)) -> PkgInfo -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgInfo -> (String, String)
pairNameOfPkgInfo) [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] -> (String,String) -> IO ()
purge :: Bool -> [Option] -> (String, String) -> IO ()
purge doit :: Bool
doit opts :: [Option]
opts nameVer :: (String, String)
nameVer = do
[String]
sandboxOpts <- (String -> [String]
makeOptList (String -> [String])
-> (Maybe String -> String) -> Maybe String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
getSandboxOpts2) (Maybe String -> [String]) -> IO (Maybe String) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe String)
getSandbox
[String]
dirs <- (String, String) -> [String] -> IO [String]
getDirs (String, String)
nameVer [String]
sandboxOpts
Bool -> [Option] -> (String, String) -> IO ()
unregister Bool
doit [Option]
opts (String, String)
nameVer
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> String -> IO ()
removeDir Bool
doit) [String]
dirs
where
makeOptList :: String -> [String]
makeOptList "" = []
makeOptList x :: String
x = [String
x]
getDirs :: (String,String) -> [String] -> IO [FilePath]
getDirs :: (String, String) -> [String] -> IO [String]
getDirs (name :: String
name,ver :: String
ver) sandboxOpts :: [String]
sandboxOpts = do
[String]
importDirs <- String -> IO [String]
queryGhcPkg "import-dirs"
[String]
haddock <- ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
docDir ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
queryGhcPkg "haddock-html"
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
topDir ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
importDirs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
haddock
where
nameVer :: String
nameVer = String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ver
queryGhcPkg :: String -> IO [String]
queryGhcPkg field :: String
field = do
let options :: [String]
options = ["field"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
sandboxOpts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
nameVer, String
field]
[String]
ws <- String -> [String]
words (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess "ghc-pkg" [String]
options ""
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ case [String]
ws of
[] -> []
(_:xs :: [String]
xs) -> [String]
xs
docDir :: ShowS
docDir dir :: String
dir
| ShowS
takeFileName String
dir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "html" = ShowS
takeDirectory String
dir
| Bool
otherwise = String
dir
topDir :: [String] -> [String]
topDir [] = []
topDir ds :: [String]
ds@(dir :: String
dir:_)
| ShowS
takeFileName String
top String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
nameVer = String
top String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ds
| Bool
otherwise = [String]
ds
where
top :: String
top = ShowS
takeDirectory String
dir
removeDir :: Bool -> FilePath -> IO ()
removeDir :: Bool -> String -> IO ()
removeDir doit :: Bool
doit dir :: String
dir = do
Bool
exist <- String -> IO Bool
doesDirectoryExist String
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
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Deleting " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
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
$ String -> IO ()
removeDirectoryRecursive String
dir
unregister :: Bool -> [Option] -> (String,String) -> IO ()
unregister :: Bool -> [Option] -> (String, String) -> IO ()
unregister doit :: Bool
doit _ (name :: String
name,ver :: String
ver) =
if Bool
doit then do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Deleting " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ver
String
sandboxOpts <- Maybe String -> String
getSandboxOpts2 (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe String)
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 ())
-> (String -> IO ExitCode) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ExitCode
system (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
script String
sandboxOpts
else
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ver
where
script :: ShowS
script sandboxOpts :: String
sandboxOpts = "ghc-pkg unregister " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sandboxOpts String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ver
genpaths :: FunctionCommand
genpaths :: FunctionCommand
genpaths _ _ _ = IO ()
genPaths
check :: FunctionCommand
check :: FunctionCommand
check _ _ _ = do
String
sandboxOpts <- Maybe String -> String
getSandboxOpts2 (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe String)
getSandbox
IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ())
-> (String -> IO ExitCode) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ExitCode
system (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
script String
sandboxOpts
where
script :: ShowS
script sandboxOpts :: String
sandboxOpts = "ghc-pkg check -v " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sandboxOpts
deps :: FunctionCommand
deps :: FunctionCommand
deps nmver :: [String]
nmver opts :: [Option]
opts _ = [String]
-> [Option]
-> (Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ())
-> IO ()
printDepends [String]
nmver [Option]
opts Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()
printDeps
revdeps :: FunctionCommand
revdeps :: FunctionCommand
revdeps nmver :: [String]
nmver opts :: [Option]
opts _ = [String]
-> [Option]
-> (Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ())
-> IO ()
printDepends [String]
nmver [Option]
opts Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()
printRevDeps
printDepends :: [String] -> [Option]
-> (Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()) -> IO ()
printDepends :: [String]
-> [Option]
-> (Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ())
-> IO ()
printDepends nmver :: [String]
nmver opts :: [Option]
opts func :: Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()
func = do
PkgDB
db' <- IO (Maybe String)
getSandbox IO (Maybe String) -> (Maybe String -> IO PkgDB) -> IO PkgDB
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> IO PkgDB
getPkgDB
PkgInfo
pkg <- [String] -> PkgDB -> IO PkgInfo
lookupPkg [String]
nmver PkgDB
db'
PkgDB
db <- [Option] -> IO PkgDB
getDB [Option]
opts
Bool -> Bool -> PkgDB -> Int -> PkgInfo -> IO ()
func Bool
rec Bool
info PkgDB
db 0 PkgInfo
pkg
where
rec :: Bool
rec = Option
OptRecursive Option -> [Option] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
info :: Bool
info = Option
OptInfo Option -> [Option] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Option]
opts
lookupPkg :: [String] -> PkgDB -> IO PkgInfo
lookupPkg :: [String] -> PkgDB -> IO PkgInfo
lookupPkg [] _ = do
Handle -> String -> IO ()
hPutStrLn Handle
stderr "Package name must be specified."
IO PkgInfo
forall a. IO a
exitFailure
lookupPkg [name :: String
name] db :: PkgDB
db = [PkgInfo] -> IO PkgInfo
checkOne ([PkgInfo] -> IO PkgInfo) -> [PkgInfo] -> IO PkgInfo
forall a b. (a -> b) -> a -> b
$ String -> PkgDB -> [PkgInfo]
lookupByName String
name PkgDB
db
lookupPkg [name :: String
name,ver :: String
ver] db :: PkgDB
db = [PkgInfo] -> IO PkgInfo
checkOne ([PkgInfo] -> IO PkgInfo) -> [PkgInfo] -> IO PkgInfo
forall a b. (a -> b) -> a -> b
$ String -> String -> PkgDB -> [PkgInfo]
lookupByVersion String
name String
ver PkgDB
db
lookupPkg _ _ = do
Handle -> String -> IO ()
hPutStrLn Handle
stderr "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 -> String -> IO ()
hPutStrLn Handle
stderr "No such package found."
IO PkgInfo
forall a. IO a
exitFailure
checkOne [pkg :: PkgInfo
pkg] = PkgInfo -> IO PkgInfo
forall (m :: * -> *) a. Monad m => a -> m a
return PkgInfo
pkg
checkOne pkgs :: [PkgInfo]
pkgs = do
Handle -> String -> IO ()
hPutStrLn Handle
stderr "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 -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> (PkgInfo -> String) -> PkgInfo -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgInfo -> String
fullNameOfPkgInfo) [PkgInfo]
pkgs
IO PkgInfo
forall a. IO a
exitFailure
initSandbox :: FunctionCommand
initSandbox :: FunctionCommand
initSandbox [] _ _ = IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ())
-> (String -> IO ExitCode) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ExitCode
system (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "cabal sandbox init"
initSandbox [path :: String
path] _ _ = IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ())
-> (String -> IO ExitCode) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ExitCode
system (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "cabal sandbox init --sandbox " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
initSandbox _ _ _ = do
Handle -> String -> IO ()
hPutStrLn Handle
stderr "Only one argument is allowed"
IO ()
forall a. IO a
exitFailure
add :: FunctionCommand
add :: FunctionCommand
add [src :: String
src] _ _ = IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ())
-> (String -> IO ExitCode) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ExitCode
system (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "cabal sandbox add-source " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
src
add _ _ _ = do
Handle -> String -> IO ()
hPutStrLn Handle
stderr "A source path be specified."
IO ()
forall a. IO a
exitFailure
ghci :: FunctionCommand
ghci :: FunctionCommand
ghci args :: [String]
args _ options :: [String]
options = do
String
sbxOpts <- Maybe String -> String
getSandboxOpts (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe String)
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
$ String -> IO ExitCode
system (String -> IO ExitCode) -> String -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ "ghci" String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sbxOpts String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " ([String]
options [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args)