{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Package.C.Db.Register ( registerPkg
, unregisterPkg
, uninstallPkg
, uninstallPkgByName
, installedDb
, lookupOrFail
, cPkgToDir
, globalPkgDir
, printCompilerFlags
, printLinkerFlags
, printPkgConfigPath
, printIncludePath
, printLibPath
, printCabalFlags
, printLdLibPath
, packageInstalled
, allPackages
, parseHostIO
, Platform
) where
import Control.Monad.Reader
import Control.Monad.State (modify)
import CPkgPrelude
import Data.Binary (encode)
import qualified Data.ByteString.Lazy as BSL
import Data.Hashable (Hashable (..))
import Data.List (intercalate)
import qualified Data.Set as S
import Numeric (showHex)
import Package.C.Db.Memory
import Package.C.Db.Monad
import Package.C.Db.Type
import Package.C.Error
import Package.C.Logging
import Package.C.Triple
import Package.C.Type hiding (Dep (name))
type Platform = String
type FlagPrint = forall m. MonadIO m => BuildCfg -> m String
allPackages :: IO [String]
allPackages :: IO [String]
allPackages = do
(InstallDb Set BuildCfg
index) <- IO InstallDb
forall (m :: * -> *). MonadIO m => m InstallDb
strictIndex
[String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BuildCfg -> String
buildName (BuildCfg -> String) -> [BuildCfg] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set BuildCfg -> [BuildCfg]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set BuildCfg
index)
printCompilerFlags :: (MonadIO m, MonadDb m) => String -> Maybe Platform -> m ()
printCompilerFlags :: forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
String -> Maybe String -> m ()
printCompilerFlags = FlagPrint -> String -> Maybe String -> m ()
forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
FlagPrint -> String -> Maybe String -> m ()
printFlagsWith BuildCfg -> m String
FlagPrint
buildCfgToCFlags
printLinkerFlags :: (MonadIO m, MonadDb m) => String -> Maybe Platform -> m ()
printLinkerFlags :: forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
String -> Maybe String -> m ()
printLinkerFlags = FlagPrint -> String -> Maybe String -> m ()
forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
FlagPrint -> String -> Maybe String -> m ()
printFlagsWith BuildCfg -> m String
FlagPrint
buildCfgToLinkerFlags
printPkgConfigPath :: (MonadIO m, MonadDb m) => [String] -> Maybe Platform -> m ()
printPkgConfigPath :: forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
[String] -> Maybe String -> m ()
printPkgConfigPath = ([BuildCfg] -> m ()) -> [String] -> Maybe String -> m ()
forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
([BuildCfg] -> m ()) -> [String] -> Maybe String -> m ()
printMany (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> m ()) -> ([BuildCfg] -> m String) -> [BuildCfg] -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (([String] -> String) -> m [String] -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
":") (m [String] -> m String)
-> ([BuildCfg] -> m [String]) -> [BuildCfg] -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildCfg -> m String) -> [BuildCfg] -> m [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse BuildCfg -> m String
FlagPrint
buildCfgToPkgConfigPath))
printIncludePath :: (MonadIO m, MonadDb m) => String -> Maybe Platform -> m ()
printIncludePath :: forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
String -> Maybe String -> m ()
printIncludePath = FlagPrint -> String -> Maybe String -> m ()
forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
FlagPrint -> String -> Maybe String -> m ()
printFlagsWith BuildCfg -> m String
FlagPrint
buildCfgToIncludePath
printLibPath :: (MonadIO m, MonadDb m) => String -> Maybe Platform -> m ()
printLibPath :: forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
String -> Maybe String -> m ()
printLibPath = FlagPrint -> String -> Maybe String -> m ()
forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
FlagPrint -> String -> Maybe String -> m ()
printFlagsWith BuildCfg -> m String
FlagPrint
buildCfgToLibPath
parseHostIO :: MonadIO m => Maybe Platform -> m (Maybe TargetTriple)
parseHostIO :: forall (m :: * -> *).
MonadIO m =>
Maybe String -> m (Maybe TargetTriple)
parseHostIO (Just String
x) = (TargetTriple -> Maybe TargetTriple)
-> m TargetTriple -> m (Maybe TargetTriple)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TargetTriple -> Maybe TargetTriple
forall a. a -> Maybe a
Just (String -> m TargetTriple
forall (m :: * -> *). MonadIO m => String -> m TargetTriple
parseTripleIO String
x)
parseHostIO Maybe String
Nothing = Maybe TargetTriple -> m (Maybe TargetTriple)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TargetTriple
forall a. Maybe a
Nothing
printFlagsWith :: (MonadIO m, MonadDb m) => FlagPrint -> String -> Maybe Platform -> m ()
printFlagsWith :: forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
FlagPrint -> String -> Maybe String -> m ()
printFlagsWith FlagPrint
f String
name Maybe String
host = do
Maybe TargetTriple
parsedHost <- Maybe String -> m (Maybe TargetTriple)
forall (m :: * -> *).
MonadIO m =>
Maybe String -> m (Maybe TargetTriple)
parseHostIO Maybe String
host
Maybe BuildCfg
maybePackage <- String -> Maybe TargetTriple -> m (Maybe BuildCfg)
forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
String -> Maybe TargetTriple -> m (Maybe BuildCfg)
lookupPackage String
name Maybe TargetTriple
parsedHost
case Maybe BuildCfg
maybePackage of
Maybe BuildCfg
Nothing -> String -> m ()
forall (m :: * -> *) a. MonadIO m => String -> m a
indexError String
name
Just BuildCfg
p -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStrLn (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildCfg -> IO String
FlagPrint
f BuildCfg
p)
printMany :: (MonadIO m, MonadDb m) => ([BuildCfg] -> m ()) -> [String] -> Maybe Platform -> m ()
printMany :: forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
([BuildCfg] -> m ()) -> [String] -> Maybe String -> m ()
printMany [BuildCfg] -> m ()
f [String]
names Maybe String
host = do
Maybe TargetTriple
parsedHost <- Maybe String -> m (Maybe TargetTriple)
forall (m :: * -> *).
MonadIO m =>
Maybe String -> m (Maybe TargetTriple)
parseHostIO Maybe String
host
Maybe [BuildCfg]
maybePackages <- [Maybe BuildCfg] -> Maybe [BuildCfg]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Maybe BuildCfg] -> Maybe [BuildCfg])
-> m [Maybe BuildCfg] -> m (Maybe [BuildCfg])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> m (Maybe BuildCfg)) -> [String] -> m [Maybe BuildCfg]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\String
n -> String -> Maybe TargetTriple -> m (Maybe BuildCfg)
forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
String -> Maybe TargetTriple -> m (Maybe BuildCfg)
lookupPackage String
n Maybe TargetTriple
parsedHost) [String]
names
case Maybe [BuildCfg]
maybePackages of
Maybe [BuildCfg]
Nothing -> String -> m ()
forall (m :: * -> *) a. MonadIO m => String -> m a
indexError ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
names)
Just [BuildCfg]
ps -> [BuildCfg] -> m ()
f [BuildCfg]
ps
printLdLibPath :: (MonadIO m, MonadDb m) => [String] -> Maybe Platform -> m ()
printLdLibPath :: forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
[String] -> Maybe String -> m ()
printLdLibPath = ([BuildCfg] -> m ()) -> [String] -> Maybe String -> m ()
forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
([BuildCfg] -> m ()) -> [String] -> Maybe String -> m ()
printMany (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> m ()) -> ([BuildCfg] -> m String) -> [BuildCfg] -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (([String] -> String) -> m [String] -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
":") (m [String] -> m String)
-> ([BuildCfg] -> m [String]) -> [BuildCfg] -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildCfg -> m String) -> [BuildCfg] -> m [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse BuildCfg -> m String
FlagPrint
buildCfgToLibPath))
printCabalFlags :: (MonadIO m, MonadDb m) => [String] -> Maybe Platform -> m ()
printCabalFlags :: forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
[String] -> Maybe String -> m ()
printCabalFlags = ([BuildCfg] -> m ()) -> [String] -> Maybe String -> m ()
forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
([BuildCfg] -> m ()) -> [String] -> Maybe String -> m ()
printMany (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> m ()) -> ([BuildCfg] -> m String) -> [BuildCfg] -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (([String] -> String) -> m [String] -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
unwords (m [String] -> m String)
-> ([BuildCfg] -> m [String]) -> [BuildCfg] -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildCfg -> m String) -> [BuildCfg] -> m [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse BuildCfg -> m String
FlagPrint
buildCfgToCabalFlag))
buildCfgToCabalFlag :: MonadIO m => BuildCfg -> m String
buildCfgToCabalFlag :: FlagPrint
buildCfgToCabalFlag = (String -> String) -> m String -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String
"--extra-lib-dirs=" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
</> String
"lib")) (m String -> m String)
-> (BuildCfg -> m String) -> BuildCfg -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildCfg -> m String
FlagPrint
buildCfgToDir
buildCfgToLinkerFlags :: MonadIO m => BuildCfg -> m String
buildCfgToLinkerFlags :: FlagPrint
buildCfgToLinkerFlags = (String -> String) -> m String -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String
"-L" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
</> String
"lib")) (m String -> m String)
-> (BuildCfg -> m String) -> BuildCfg -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildCfg -> m String
FlagPrint
buildCfgToDir
buildCfgToCFlags :: MonadIO m => BuildCfg -> m String
buildCfgToCFlags :: FlagPrint
buildCfgToCFlags = (String -> String) -> m String -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String
"-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
</> String
"include")) (m String -> m String)
-> (BuildCfg -> m String) -> BuildCfg -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildCfg -> m String
FlagPrint
buildCfgToDir
buildCfgToPkgConfigPath :: MonadIO m => BuildCfg -> m String
buildCfgToPkgConfigPath :: FlagPrint
buildCfgToPkgConfigPath = (String -> String) -> m String -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
</> String
"lib" String -> String -> String
</> String
"pkgconfig") (m String -> m String)
-> (BuildCfg -> m String) -> BuildCfg -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildCfg -> m String
FlagPrint
buildCfgToDir
buildCfgToLibPath :: MonadIO m => BuildCfg -> m String
buildCfgToLibPath :: FlagPrint
buildCfgToLibPath = (String -> String) -> m String -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
</> String
"lib") (m String -> m String)
-> (BuildCfg -> m String) -> BuildCfg -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildCfg -> m String
FlagPrint
buildCfgToDir
buildCfgToIncludePath :: MonadIO m => BuildCfg -> m String
buildCfgToIncludePath :: FlagPrint
buildCfgToIncludePath = (String -> String) -> m String -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
</> String
"include") (m String -> m String)
-> (BuildCfg -> m String) -> BuildCfg -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildCfg -> m String
FlagPrint
buildCfgToDir
installedDb :: (MonadIO m, MonadDb m)
=> m (S.Set BuildCfg)
installedDb :: forall (m :: * -> *). (MonadIO m, MonadDb m) => m (Set BuildCfg)
installedDb =
InstallDb -> Set BuildCfg
_installedPackages (InstallDb -> Set BuildCfg) -> m InstallDb -> m (Set BuildCfg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m InstallDb
forall (m :: * -> *). MonadDb m => m InstallDb
memIndex
packageInstalled :: (MonadIO m, MonadDb m)
=> CPkg
-> Maybe TargetTriple
-> Bool
-> BuildVars
-> m Bool
packageInstalled :: forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
CPkg -> Maybe TargetTriple -> Bool -> BuildVars -> m Bool
packageInstalled CPkg
pkg Maybe TargetTriple
host Bool
glob BuildVars
b = do
Set BuildCfg
packs <- m (Set BuildCfg)
forall (m :: * -> *). (MonadIO m, MonadDb m) => m (Set BuildCfg)
installedDb
Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
(CPkg -> Maybe TargetTriple -> Bool -> Bool -> BuildVars -> BuildCfg
pkgToBuildCfg CPkg
pkg Maybe TargetTriple
host Bool
glob Bool
True BuildVars
b BuildCfg -> Set BuildCfg -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set BuildCfg
packs)
Bool -> Bool -> Bool
|| (CPkg -> Maybe TargetTriple -> Bool -> Bool -> BuildVars -> BuildCfg
pkgToBuildCfg CPkg
pkg Maybe TargetTriple
host Bool
glob Bool
False BuildVars
b BuildCfg -> Set BuildCfg -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set BuildCfg
packs)
lookupPackage :: (MonadIO m, MonadDb m) => String -> Maybe TargetTriple -> m (Maybe BuildCfg)
lookupPackage :: forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
String -> Maybe TargetTriple -> m (Maybe BuildCfg)
lookupPackage String
name Maybe TargetTriple
host = do
Set BuildCfg
packs <- m (Set BuildCfg)
forall (m :: * -> *). (MonadIO m, MonadDb m) => m (Set BuildCfg)
installedDb
let matches :: Set BuildCfg
matches = (BuildCfg -> Bool) -> Set BuildCfg -> Set BuildCfg
forall a. (a -> Bool) -> Set a -> Set a
S.filter (\BuildCfg
pkg -> BuildCfg -> String
buildName BuildCfg
pkg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name Bool -> Bool -> Bool
&& BuildCfg -> Maybe TargetTriple
targetArch BuildCfg
pkg Maybe TargetTriple -> Maybe TargetTriple -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe TargetTriple
host) Set BuildCfg
packs
Maybe BuildCfg -> m (Maybe BuildCfg)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set BuildCfg -> Maybe BuildCfg
forall a. Set a -> Maybe a
S.lookupMax Set BuildCfg
matches)
lookupOrFail :: (MonadIO m, MonadDb m) => String -> Maybe TargetTriple -> m BuildCfg
lookupOrFail :: forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
String -> Maybe TargetTriple -> m BuildCfg
lookupOrFail String
name Maybe TargetTriple
host = do
Maybe BuildCfg
pk <- String -> Maybe TargetTriple -> m (Maybe BuildCfg)
forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
String -> Maybe TargetTriple -> m (Maybe BuildCfg)
lookupPackage String
name Maybe TargetTriple
host
case Maybe BuildCfg
pk of
Just BuildCfg
cfg -> BuildCfg -> m BuildCfg
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuildCfg
cfg
Maybe BuildCfg
Nothing -> String -> m BuildCfg
forall (m :: * -> *) a. MonadIO m => String -> m a
notInstalled String
name
uninstallPkgByName :: (MonadReader Verbosity m, MonadIO m, MonadDb m)
=> String
-> Maybe TargetTriple
-> m ()
uninstallPkgByName :: forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m, MonadDb m) =>
String -> Maybe TargetTriple -> m ()
uninstallPkgByName String
name Maybe TargetTriple
host =
BuildCfg -> m ()
forall (m :: * -> *).
(MonadIO m, MonadDb m, MonadReader Verbosity m) =>
BuildCfg -> m ()
uninstallPkg (BuildCfg -> m ()) -> m BuildCfg -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Maybe TargetTriple -> m BuildCfg
forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
String -> Maybe TargetTriple -> m BuildCfg
lookupOrFail String
name Maybe TargetTriple
host
uninstallPkg :: (MonadIO m, MonadDb m, MonadReader Verbosity m)
=> BuildCfg
-> m ()
uninstallPkg :: forall (m :: * -> *).
(MonadIO m, MonadDb m, MonadReader Verbosity m) =>
BuildCfg -> m ()
uninstallPkg BuildCfg
cpkg = do
BuildCfg -> m ()
forall (m :: * -> *).
(MonadIO m, MonadDb m, MonadReader Verbosity m) =>
BuildCfg -> m ()
unregisterPkg BuildCfg
cpkg
(IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
removeDirectoryRecursive)
(String -> m ()) -> m String -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildCfg -> m String
FlagPrint
buildCfgToDir BuildCfg
cpkg
unregisterPkg :: (MonadIO m, MonadDb m, MonadReader Verbosity m)
=> BuildCfg
-> m ()
unregisterPkg :: forall (m :: * -> *).
(MonadIO m, MonadDb m, MonadReader Verbosity m) =>
BuildCfg -> m ()
unregisterPkg BuildCfg
buildCfg = do
String -> m ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putLoud (String
"Unregistering package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BuildCfg -> String
buildName BuildCfg
buildCfg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"...")
String
indexFile <- m String
forall (m :: * -> *). MonadIO m => m String
pkgIndex
InstallDb
indexContents <- m InstallDb
forall (m :: * -> *). MonadDb m => m InstallDb
memIndex
let modIndex :: InstallDb -> InstallDb
modIndex = ASetter InstallDb InstallDb (Set BuildCfg) (Set BuildCfg)
-> (Set BuildCfg -> Set BuildCfg) -> InstallDb -> InstallDb
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter InstallDb InstallDb (Set BuildCfg) (Set BuildCfg)
Lens' InstallDb (Set BuildCfg)
installedPackages (BuildCfg -> Set BuildCfg -> Set BuildCfg
forall a. Ord a => a -> Set a -> Set a
S.delete BuildCfg
buildCfg)
newIndex :: InstallDb
newIndex = InstallDb -> InstallDb
modIndex InstallDb
indexContents
(InstallDb -> InstallDb) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify InstallDb -> InstallDb
modIndex
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BSL.writeFile String
indexFile (InstallDb -> ByteString
forall a. Binary a => a -> ByteString
encode InstallDb
newIndex)
registerPkg :: (MonadIO m, MonadDb m, MonadReader Verbosity m)
=> CPkg
-> Maybe TargetTriple
-> Bool
-> Bool
-> BuildVars
-> m ()
registerPkg :: forall (m :: * -> *).
(MonadIO m, MonadDb m, MonadReader Verbosity m) =>
CPkg -> Maybe TargetTriple -> Bool -> Bool -> BuildVars -> m ()
registerPkg CPkg
cpkg Maybe TargetTriple
host Bool
glob Bool
usr BuildVars
b = do
String -> m ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putDiagnostic (String
"Registering package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CPkg -> String
pkgName CPkg
cpkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"...")
String
indexFile <- m String
forall (m :: * -> *). MonadIO m => m String
pkgIndex
InstallDb
indexContents <- m InstallDb
forall (m :: * -> *). MonadDb m => m InstallDb
memIndex
let buildCfg :: BuildCfg
buildCfg = CPkg -> Maybe TargetTriple -> Bool -> Bool -> BuildVars -> BuildCfg
pkgToBuildCfg CPkg
cpkg Maybe TargetTriple
host Bool
glob Bool
usr BuildVars
b
modIndex :: InstallDb -> InstallDb
modIndex = ASetter InstallDb InstallDb (Set BuildCfg) (Set BuildCfg)
-> (Set BuildCfg -> Set BuildCfg) -> InstallDb -> InstallDb
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter InstallDb InstallDb (Set BuildCfg) (Set BuildCfg)
Lens' InstallDb (Set BuildCfg)
installedPackages (BuildCfg -> Set BuildCfg -> Set BuildCfg
forall a. Ord a => a -> Set a -> Set a
S.insert BuildCfg
buildCfg)
newIndex :: InstallDb
newIndex = InstallDb -> InstallDb
modIndex InstallDb
indexContents
(InstallDb -> InstallDb) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify InstallDb -> InstallDb
modIndex
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BSL.writeFile String
indexFile (InstallDb -> ByteString
forall a. Binary a => a -> ByteString
encode InstallDb
newIndex)
pkgToBuildCfg :: CPkg
-> Maybe TargetTriple
-> Bool
-> Bool
-> BuildVars
-> BuildCfg
pkgToBuildCfg :: CPkg -> Maybe TargetTriple -> Bool -> Bool -> BuildVars -> BuildCfg
pkgToBuildCfg (CPkg String
n Version
v String
_ String
_ [Dep]
bds [Dep]
ds BuildVars -> [Command]
cCmd BuildVars -> [Command]
bCmd BuildVars -> [Command]
iCmd) Maybe TargetTriple
host Bool
glob Bool
usr BuildVars
bVar =
String
-> Version
-> [(Text, Version)]
-> [(Text, Version)]
-> Maybe TargetTriple
-> Bool
-> [Command]
-> [Command]
-> [Command]
-> Bool
-> BuildCfg
BuildCfg String
n Version
v (Dep -> (Text, Version)
go (Dep -> (Text, Version)) -> [Dep] -> [(Text, Version)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Dep]
bds) (Dep -> (Text, Version)
go (Dep -> (Text, Version)) -> [Dep] -> [(Text, Version)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Dep]
ds) Maybe TargetTriple
host Bool
glob (BuildVars -> [Command]
cCmd BuildVars
bVar) (BuildVars -> [Command]
bCmd BuildVars
bVar) (BuildVars -> [Command]
iCmd BuildVars
bVar) Bool
usr
where placeholderVersion :: Version
placeholderVersion = [Natural] -> Version
Version [Natural
0,Natural
1,Natural
0,Natural
0]
go :: Dep -> (Text, Version)
go (Dep Text
n' VersionBound
_) = (Text
n', Version
placeholderVersion)
platformString :: Maybe TargetTriple -> (FilePath -> FilePath -> FilePath)
platformString :: Maybe TargetTriple -> String -> String -> String
platformString Maybe TargetTriple
Nothing = String -> String -> String
(</>)
platformString (Just TargetTriple
p) = \String
x String
y -> String
x String -> String -> String
</> TargetTriple -> String
forall a. Show a => a -> String
show TargetTriple
p String -> String -> String
</> String
y
buildCfgToDir :: MonadIO m => BuildCfg -> m FilePath
buildCfgToDir :: FlagPrint
buildCfgToDir BuildCfg
buildCfg = do
String
global' <- m String
forall (m :: * -> *). MonadIO m => m String
globalPkgDir
let hashed :: String
hashed = Int -> String -> String
forall a. Integral a => a -> String -> String
showHex (Int -> Int
forall a. Num a => a -> a
abs (BuildCfg -> Int
forall a. Hashable a => a -> Int
hash (BuildCfg
buildCfg { manual = False}))) String
forall a. Monoid a => a
mempty
<?> :: String -> String -> String
(<?>) = Maybe TargetTriple -> String -> String -> String
platformString (BuildCfg -> Maybe TargetTriple
targetArch BuildCfg
buildCfg)
String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
global' String -> String -> String
<?> BuildCfg -> String
buildName BuildCfg
buildCfg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion (BuildCfg -> Version
buildVersion BuildCfg
buildCfg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hashed)
globDir :: Maybe TargetTriple -> FilePath
globDir :: Maybe TargetTriple -> String
globDir Maybe TargetTriple
Nothing = String
"/usr/local"
globDir (Just TargetTriple
arch') = String
"/usr" String -> String -> String
</> TargetTriple -> String
forall a. Show a => a -> String
show TargetTriple
arch'
cPkgToDir :: MonadIO m
=> CPkg
-> Maybe TargetTriple
-> Bool
-> BuildVars
-> m FilePath
cPkgToDir :: forall (m :: * -> *).
MonadIO m =>
CPkg -> Maybe TargetTriple -> Bool -> BuildVars -> m String
cPkgToDir CPkg
pk Maybe TargetTriple
host Bool
False BuildVars
bv = BuildCfg -> m String
FlagPrint
buildCfgToDir (CPkg -> Maybe TargetTriple -> Bool -> Bool -> BuildVars -> BuildCfg
pkgToBuildCfg CPkg
pk Maybe TargetTriple
host Bool
False Bool
forall a. HasCallStack => a
undefined BuildVars
bv)
cPkgToDir CPkg
_ Maybe TargetTriple
host Bool
_ BuildVars
_ = String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TargetTriple -> String
globDir Maybe TargetTriple
host)