{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes       #-}

-- TODO: a lot of the stuff in this module could be made pure so that it only
-- gets called once
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

-- TODO: do something more sophisticated; allow packages to return their own
-- dir?
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

-- | @since 0.2.3.0
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)

-- TODO: replace this with a proper/sensible database
registerPkg :: (MonadIO m, MonadDb m, MonadReader Verbosity m)
            => CPkg
            -> Maybe TargetTriple
            -> Bool -- ^ Globally installed?
            -> Bool -- ^ Manually installed?
            -> 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 -- ^ Was this package manually installed?
              -> 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 -- TODO: fix pinned build deps &c.
    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
    -- when hashing, pretend everything has was NOT manually installed so they
    -- all have the same hash
    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)