module Distribution.ArchHs.Utils
( getPkgName,
getPkgName',
getPkgVersion,
dependencyTypeToKind,
unExe,
unExeV,
unLegacyExeV,
unBuildTools,
unDepV,
getUrl,
getTwo,
buildDependsIfBuild,
buildToolsAndbuildToolDependsIfBuild,
traceCallStack,
trace',
depNotInGHCLib,
depNotMyself,
depIsKind,
extractFromEVR,
isProvided,
)
where
import Control.Monad ((<=<))
import Distribution.ArchHs.Internal.Prelude
import Distribution.ArchHs.Local (ghcLibList)
import Distribution.ArchHs.Types
import Distribution.PackageDescription (repoLocation)
import Distribution.Types.BuildInfo (BuildInfo (..))
import Distribution.Types.Dependency (Dependency, depPkgName, depVerRange)
import Distribution.Types.ExeDependency (ExeDependency (..))
import Distribution.Types.LegacyExeDependency
import qualified Distribution.Types.PackageId as I
import Distribution.Utils.ShortText (fromShortText)
import GHC.Stack (callStack, prettyCallStack)
unExe :: ExeDependency -> PackageName
unExe :: ExeDependency -> PackageName
unExe (ExeDependency PackageName
name UnqualComponentName
_ VersionRange
_) = PackageName
name
unExeV :: ExeDependency -> (PackageName, VersionRange)
unExeV :: ExeDependency -> (PackageName, VersionRange)
unExeV (ExeDependency PackageName
name UnqualComponentName
_ VersionRange
v) = (PackageName
name, VersionRange
v)
unLegacyExeV :: LegacyExeDependency -> (PackageName, VersionRange)
unLegacyExeV :: LegacyExeDependency -> (PackageName, VersionRange)
unLegacyExeV (LegacyExeDependency String
name VersionRange
v) = (String -> PackageName
mkPackageName String
name, VersionRange
v)
unBuildTools :: ([LegacyExeDependency], [ExeDependency]) -> [(PackageName, VersionRange)]
unBuildTools :: ([LegacyExeDependency], [ExeDependency])
-> [(PackageName, VersionRange)]
unBuildTools ([LegacyExeDependency]
l, [ExeDependency]
e) = (LegacyExeDependency -> (PackageName, VersionRange)
unLegacyExeV (LegacyExeDependency -> (PackageName, VersionRange))
-> [LegacyExeDependency] -> [(PackageName, VersionRange)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LegacyExeDependency]
l) [(PackageName, VersionRange)]
-> [(PackageName, VersionRange)] -> [(PackageName, VersionRange)]
forall a. Semigroup a => a -> a -> a
<> (ExeDependency -> (PackageName, VersionRange)
unExeV (ExeDependency -> (PackageName, VersionRange))
-> [ExeDependency] -> [(PackageName, VersionRange)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExeDependency]
e)
unDepV :: Dependency -> (PackageName, VersionRange)
unDepV :: Dependency -> (PackageName, VersionRange)
unDepV Dependency
dep = (Dependency -> PackageName
depPkgName Dependency
dep, Dependency -> VersionRange
depVerRange Dependency
dep)
getPkgName :: PackageDescription -> PackageName
getPkgName :: PackageDescription -> PackageName
getPkgName = PackageIdentifier -> PackageName
I.pkgName (PackageIdentifier -> PackageName)
-> (PackageDescription -> PackageIdentifier)
-> PackageDescription
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
package
getPkgName' :: GenericPackageDescription -> PackageName
getPkgName' :: GenericPackageDescription -> PackageName
getPkgName' = PackageIdentifier -> PackageName
I.pkgName (PackageIdentifier -> PackageName)
-> (GenericPackageDescription -> PackageIdentifier)
-> GenericPackageDescription
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
package (PackageDescription -> PackageIdentifier)
-> (GenericPackageDescription -> PackageDescription)
-> GenericPackageDescription
-> PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
packageDescription
getPkgVersion :: PackageDescription -> Version
getPkgVersion :: PackageDescription -> Version
getPkgVersion = PackageIdentifier -> Version
I.pkgVersion (PackageIdentifier -> Version)
-> (PackageDescription -> PackageIdentifier)
-> PackageDescription
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
package
getUrl :: PackageDescription -> String
getUrl :: PackageDescription -> String
getUrl PackageDescription
cabal = Maybe String -> String
forall (m :: * -> *) a. MonadFail m => Maybe (m a) -> m a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Maybe String
home Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
vcs Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
fallback
where
f :: String -> Maybe String
f String
"" = Maybe String
forall a. Maybe a
Nothing
f String
x = String -> Maybe String
forall a. a -> Maybe a
Just String
x
fromJust :: Maybe (m a) -> m a
fromJust (Just m a
x) = m a
x
fromJust Maybe (m a)
_ = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Impossible."
home :: Maybe String
home = String -> Maybe String
f (String -> Maybe String)
-> (PackageDescription -> String)
-> PackageDescription
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> String
fromShortText (ShortText -> String)
-> (PackageDescription -> ShortText)
-> PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> ShortText
homepage (PackageDescription -> Maybe String)
-> PackageDescription -> Maybe String
forall a b. (a -> b) -> a -> b
$ PackageDescription
cabal
vcs :: Maybe String
vcs = SourceRepo -> Maybe String
repoLocation (SourceRepo -> Maybe String)
-> (PackageDescription -> Maybe SourceRepo)
-> PackageDescription
-> Maybe String
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ([SourceRepo]
-> Getting (First SourceRepo) [SourceRepo] SourceRepo
-> Maybe SourceRepo
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index [SourceRepo]
-> Traversal' [SourceRepo] (IxValue [SourceRepo])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [SourceRepo]
0) ([SourceRepo] -> Maybe SourceRepo)
-> (PackageDescription -> [SourceRepo])
-> PackageDescription
-> Maybe SourceRepo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [SourceRepo]
sourceRepos (PackageDescription -> Maybe String)
-> PackageDescription -> Maybe String
forall a b. (a -> b) -> a -> b
$ PackageDescription
cabal
fallback :: Maybe String
fallback = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"https://hackage.haskell.org/package/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> PackageName -> String
unPackageName (PackageDescription -> PackageName
getPkgName PackageDescription
cabal)
dependencyTypeToKind :: DependencyType -> DependencyKind
dependencyTypeToKind :: DependencyType -> DependencyKind
dependencyTypeToKind (CExe UnqualComponentName
_) = DependencyKind
Exe
dependencyTypeToKind (CExeBuildTools UnqualComponentName
_) = DependencyKind
ExeBuildTools
dependencyTypeToKind DependencyType
CLib = DependencyKind
Lib
dependencyTypeToKind (CTest UnqualComponentName
_) = DependencyKind
Test
dependencyTypeToKind (CBenchmark UnqualComponentName
_) = DependencyKind
Benchmark
dependencyTypeToKind DependencyType
CLibBuildTools = DependencyKind
LibBuildTools
dependencyTypeToKind (CTestBuildTools UnqualComponentName
_) = DependencyKind
TestBuildTools
dependencyTypeToKind (CBenchmarkBuildTools UnqualComponentName
_) = DependencyKind
BenchmarkBuildTools
dependencyTypeToKind (CSubLibs UnqualComponentName
_) = DependencyKind
SubLibs
dependencyTypeToKind (CSubLibsBuildTools UnqualComponentName
_) = DependencyKind
SubLibsBuildTools
getTwo :: Getting b s b -> s -> s -> (b, b)
getTwo :: Getting b s b -> s -> s -> (b, b)
getTwo Getting b s b
l s
a s
b = (s
a, s
b) (s, s) -> ((s, s) -> (b, b)) -> (b, b)
forall a b. a -> (a -> b) -> b
& (s -> Identity b) -> (s, s) -> Identity (b, b)
forall a b. Traversal (a, a) (b, b) a b
both ((s -> Identity b) -> (s, s) -> Identity (b, b))
-> (s -> b) -> (s, s) -> (b, b)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (s -> Getting b s b -> b
forall s a. s -> Getting a s a -> a
^. Getting b s b
l)
buildDependsIfBuild :: BuildInfo -> [Dependency]
buildDependsIfBuild :: BuildInfo -> [Dependency]
buildDependsIfBuild BuildInfo
info = if BuildInfo -> Bool
buildable BuildInfo
info then BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
info else []
buildToolsAndbuildToolDependsIfBuild :: BuildInfo -> ([LegacyExeDependency], [ExeDependency])
buildToolsAndbuildToolDependsIfBuild :: BuildInfo -> ([LegacyExeDependency], [ExeDependency])
buildToolsAndbuildToolDependsIfBuild BuildInfo
info = if BuildInfo -> Bool
buildable BuildInfo
info then (BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
info, BuildInfo -> [ExeDependency]
buildToolDepends BuildInfo
info) else ([], [])
trace' :: MemberWithError Trace r => String -> Sem r ()
trace' :: String -> Sem r ()
trace' String
s = String -> Sem r ()
forall (r :: [Effect]).
MemberWithError Trace r =>
String -> Sem r ()
trace (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ String
"[TRACE] " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s
traceCallStack :: (HasCallStack, MemberWithError Trace r) => Sem r ()
traceCallStack :: Sem r ()
traceCallStack = do
String -> Sem r ()
forall (r :: [Effect]).
MemberWithError Trace r =>
String -> Sem r ()
trace (String -> Sem r ()) -> (String -> String) -> String -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
prefix (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack
where
prefix :: String -> String
prefix = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"[TRACE] " 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]
lines
depNotInGHCLib :: SolvedDependency -> Bool
depNotInGHCLib :: SolvedDependency -> Bool
depNotInGHCLib SolvedDependency
x = (SolvedDependency
x SolvedDependency
-> Getting PackageName SolvedDependency PackageName -> PackageName
forall s a. s -> Getting a s a -> a
^. Getting PackageName SolvedDependency PackageName
Lens' SolvedDependency PackageName
depName) PackageName -> [PackageName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageName]
ghcLibList
depNotMyself :: PackageName -> SolvedDependency -> Bool
depNotMyself :: PackageName -> SolvedDependency -> Bool
depNotMyself PackageName
name SolvedDependency
x = SolvedDependency
x SolvedDependency
-> Getting PackageName SolvedDependency PackageName -> PackageName
forall s a. s -> Getting a s a -> a
^. Getting PackageName SolvedDependency PackageName
Lens' SolvedDependency PackageName
depName PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageName
name
depIsKind :: DependencyKind -> SolvedDependency -> Bool
depIsKind :: DependencyKind -> SolvedDependency -> Bool
depIsKind DependencyKind
k SolvedDependency
x = DependencyKind
k DependencyKind -> [DependencyKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (SolvedDependency
x SolvedDependency
-> Getting [DependencyType] SolvedDependency [DependencyType]
-> [DependencyType]
forall s a. s -> Getting a s a -> a
^. Getting [DependencyType] SolvedDependency [DependencyType]
Lens' SolvedDependency [DependencyType]
depType [DependencyType]
-> (DependencyType -> DependencyKind) -> [DependencyKind]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> DependencyType -> DependencyKind
dependencyTypeToKind)
extractFromEVR :: String -> CommunityVersion
String
evr =
let ev :: String
ev = [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"-" String
evr
in if Char
':' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
ev then String -> String
forall a. [a] -> [a]
tail (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') String
ev else String
ev
isProvided :: SolvedPackage -> Bool
isProvided :: SolvedPackage -> Bool
isProvided (ProvidedPackage PackageName
_ DependencyProvider
_) = Bool
True
isProvided SolvedPackage
_ = Bool
False