{-# LANGUAGE DeriveLift #-}
module GHC.Check.PackageDb
( PackageVersion(abi), version,
getPackageVersion,
fromVersionString
)
where
import Control.Monad.Trans.Class as Monad (MonadTrans (lift))
import Data.String (IsString (fromString))
import Data.Version (Version)
import GHC
(pkgState, Ghc,
getSessionDynFlags,
)
import GHC.Check.Util
import Maybes (MaybeT (MaybeT), runMaybeT)
import Module (componentIdToInstalledUnitId)
import PackageConfig (PackageName (PackageName))
import Packages
(lookupPackage, explicitPackages, lookupInstalledPackage,
lookupPackageName
)
import Packages (InstalledPackageInfo (..))
import Packages (PackageConfig)
import Language.Haskell.TH.Syntax (Lift)
import Data.Foldable (find)
import Packages (packageNameString)
import Control.Applicative (Alternative((<|>)))
import GHC.Stack (HasCallStack)
data PackageVersion
= PackageVersion
{ PackageVersion -> MyVersion
myVersion :: !MyVersion,
PackageVersion -> Maybe String
abi :: Maybe String
}
deriving (PackageVersion -> PackageVersion -> Bool
(PackageVersion -> PackageVersion -> Bool)
-> (PackageVersion -> PackageVersion -> Bool) -> Eq PackageVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageVersion -> PackageVersion -> Bool
$c/= :: PackageVersion -> PackageVersion -> Bool
== :: PackageVersion -> PackageVersion -> Bool
$c== :: PackageVersion -> PackageVersion -> Bool
Eq, PackageVersion -> Q Exp
PackageVersion -> Q (TExp PackageVersion)
(PackageVersion -> Q Exp)
-> (PackageVersion -> Q (TExp PackageVersion))
-> Lift PackageVersion
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: PackageVersion -> Q (TExp PackageVersion)
$cliftTyped :: PackageVersion -> Q (TExp PackageVersion)
lift :: PackageVersion -> Q Exp
$clift :: PackageVersion -> Q Exp
Lift, Int -> PackageVersion -> ShowS
[PackageVersion] -> ShowS
PackageVersion -> String
(Int -> PackageVersion -> ShowS)
-> (PackageVersion -> String)
-> ([PackageVersion] -> ShowS)
-> Show PackageVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageVersion] -> ShowS
$cshowList :: [PackageVersion] -> ShowS
show :: PackageVersion -> String
$cshow :: PackageVersion -> String
showsPrec :: Int -> PackageVersion -> ShowS
$cshowsPrec :: Int -> PackageVersion -> ShowS
Show)
version :: PackageVersion -> Version
version :: PackageVersion -> Version
version PackageVersion{ myVersion :: PackageVersion -> MyVersion
myVersion = MyVersion Version
v} = Version
v
getPackageVersion :: String -> Ghc (Maybe PackageVersion)
getPackageVersion :: String -> Ghc (Maybe PackageVersion)
getPackageVersion String
pName = MaybeT Ghc PackageVersion -> Ghc (Maybe PackageVersion)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Ghc PackageVersion -> Ghc (Maybe PackageVersion))
-> MaybeT Ghc PackageVersion -> Ghc (Maybe PackageVersion)
forall a b. (a -> b) -> a -> b
$ do
DynFlags
dflags <- Ghc DynFlags -> MaybeT Ghc DynFlags
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Monad.lift Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
let pkgst :: PackageState
pkgst = DynFlags -> PackageState
pkgState DynFlags
dflags
depends :: [UnitId]
depends = PackageState -> [UnitId]
explicitPackages PackageState
pkgst
let explicit :: MaybeT Ghc PackageConfig
explicit = do
[PackageConfig]
pkgs <- (UnitId -> MaybeT Ghc PackageConfig)
-> [UnitId] -> MaybeT Ghc [PackageConfig]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Ghc (Maybe PackageConfig) -> MaybeT Ghc PackageConfig
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Ghc (Maybe PackageConfig) -> MaybeT Ghc PackageConfig)
-> (UnitId -> Ghc (Maybe PackageConfig))
-> UnitId
-> MaybeT Ghc PackageConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PackageConfig -> Ghc (Maybe PackageConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PackageConfig -> Ghc (Maybe PackageConfig))
-> (UnitId -> Maybe PackageConfig)
-> UnitId
-> Ghc (Maybe PackageConfig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage DynFlags
dflags) [UnitId]
depends
Ghc (Maybe PackageConfig) -> MaybeT Ghc PackageConfig
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Ghc (Maybe PackageConfig) -> MaybeT Ghc PackageConfig)
-> Ghc (Maybe PackageConfig) -> MaybeT Ghc PackageConfig
forall a b. (a -> b) -> a -> b
$ Maybe PackageConfig -> Ghc (Maybe PackageConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PackageConfig -> Ghc (Maybe PackageConfig))
-> Maybe PackageConfig -> Ghc (Maybe PackageConfig)
forall a b. (a -> b) -> a -> b
$ (PackageConfig -> Bool) -> [PackageConfig] -> Maybe PackageConfig
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PackageConfig
p -> PackageConfig -> String
packageNameString PackageConfig
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pName ) [PackageConfig]
pkgs
notExplicit :: MaybeT Ghc PackageConfig
notExplicit = do
ComponentId
component <- Ghc (Maybe ComponentId) -> MaybeT Ghc ComponentId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Ghc (Maybe ComponentId) -> MaybeT Ghc ComponentId)
-> Ghc (Maybe ComponentId) -> MaybeT Ghc ComponentId
forall a b. (a -> b) -> a -> b
$ Maybe ComponentId -> Ghc (Maybe ComponentId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ComponentId -> Ghc (Maybe ComponentId))
-> Maybe ComponentId -> Ghc (Maybe ComponentId)
forall a b. (a -> b) -> a -> b
$ DynFlags -> PackageName -> Maybe ComponentId
lookupPackageName DynFlags
dflags (PackageName -> Maybe ComponentId)
-> PackageName -> Maybe ComponentId
forall a b. (a -> b) -> a -> b
$ FastString -> PackageName
PackageName (FastString -> PackageName) -> FastString -> PackageName
forall a b. (a -> b) -> a -> b
$ String -> FastString
forall a. IsString a => String -> a
fromString String
pName
Ghc (Maybe PackageConfig) -> MaybeT Ghc PackageConfig
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Ghc (Maybe PackageConfig) -> MaybeT Ghc PackageConfig)
-> Ghc (Maybe PackageConfig) -> MaybeT Ghc PackageConfig
forall a b. (a -> b) -> a -> b
$ Maybe PackageConfig -> Ghc (Maybe PackageConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PackageConfig -> Ghc (Maybe PackageConfig))
-> Maybe PackageConfig -> Ghc (Maybe PackageConfig)
forall a b. (a -> b) -> a -> b
$ DynFlags -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage DynFlags
dflags (ComponentId -> InstalledUnitId
componentIdToInstalledUnitId ComponentId
component)
PackageConfig
p <- MaybeT Ghc PackageConfig
explicit MaybeT Ghc PackageConfig
-> MaybeT Ghc PackageConfig -> MaybeT Ghc PackageConfig
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT Ghc PackageConfig
notExplicit
PackageVersion -> MaybeT Ghc PackageVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageVersion -> MaybeT Ghc PackageVersion)
-> PackageVersion -> MaybeT Ghc PackageVersion
forall a b. (a -> b) -> a -> b
$ PackageConfig -> PackageVersion
fromPackageConfig PackageConfig
p
fromPackageConfig :: PackageConfig -> PackageVersion
fromPackageConfig :: PackageConfig -> PackageVersion
fromPackageConfig PackageConfig
p = MyVersion -> Maybe String -> PackageVersion
PackageVersion (Version -> MyVersion
MyVersion (Version -> MyVersion) -> Version -> MyVersion
forall a b. (a -> b) -> a -> b
$ PackageConfig -> Version
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Version
packageVersion PackageConfig
p) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ PackageConfig -> String
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> String
abiHash PackageConfig
p)
fromVersionString :: HasCallStack => String -> PackageVersion
fromVersionString :: String -> PackageVersion
fromVersionString String
v = MyVersion -> Maybe String -> PackageVersion
PackageVersion (Version -> MyVersion
MyVersion (Version -> MyVersion) -> Version -> MyVersion
forall a b. (a -> b) -> a -> b
$ String -> Version
forall a. Read a => String -> a
read String
v) Maybe String
forall a. Maybe a
Nothing