{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Distribution.ArchHs.Utils
( findCabalFile,
getPkgName,
getPkgName',
getPkgVersion,
dependencyTypeToKind,
unExe,
unExeV,
unLegacyExeV,
unBuildTools,
unSystemDependency,
unDepV,
getUrl,
getTwo,
buildDependsIfBuild,
buildToolsAndbuildToolDependsIfBuild,
pkgconfigDependsAndExtraLibsIfBuild,
traceCallStack,
trace',
depNotInGHCLib,
depNotMyself,
depIsKind,
extractFromEVR,
isProvided,
filterFirstDiff,
filterFirstAndBothDiff,
filterSecondDiff,
filterSecondAndBothDiff,
noDiff,
mapDiff,
unDiff,
archHsVersion,
defaultFlags,
getFlagAssignment,
)
where
import Control.Monad ((<=<))
import Data.Algorithm.Diff
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
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.Types.PkgconfigDependency
import Distribution.Types.PkgconfigName
import Distribution.Utils.ShortText (fromShortText)
import GHC.Stack (callStack, prettyCallStack)
import Options.Applicative.Simple (simpleVersion)
import qualified Paths_arch_hs as Path
import System.Directory (listDirectory)
import System.FilePath (takeExtension)
findCabalFile :: FilePath -> IO FilePath
findCabalFile :: String -> IO String
findCabalFile String
dir =
String -> IO [String]
listDirectory String
dir
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \case
[String
x] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
x
[] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unable to find any cabal file in directory " forall a. Semigroup a => a -> a -> a
<> String
dir
[String]
xs -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Found more than one cabal files" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [String]
xs forall a. Semigroup a => a -> a -> a
<> String
"in directory " forall a. Semigroup a => a -> a -> a
<> String
dir
)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> String -> String
takeExtension String
x forall a. Eq a => a -> a -> Bool
== String
".cabal")
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LegacyExeDependency]
l) forall a. Semigroup a => a -> a -> a
<> (ExeDependency -> (PackageName, VersionRange)
unExeV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExeDependency]
e)
unSystemDependency :: ([PkgconfigDependency], [String]) -> [SystemDependency]
unSystemDependency :: ([PkgconfigDependency], [String]) -> [SystemDependency]
unSystemDependency ([PkgconfigDependency]
p, [String]
s) = [String -> SystemDependency
SystemDependency forall a b. (a -> b) -> a -> b
$ String
name forall a. Semigroup a => a -> a -> a
<> String
".pc" | (PkgconfigDependency (PkgconfigName -> String
unPkgconfigName -> String
name) PkgconfigVersionRange
_) <- [PkgconfigDependency]
p] forall a. Semigroup a => a -> a -> a
<> [String -> SystemDependency
SystemDependency forall a b. (a -> b) -> a -> b
$ String
"lib" forall a. Semigroup a => a -> a -> a
<> String
name forall a. Semigroup a => a -> a -> a
<> String
".so" | String
name <- [String]
s]
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
package
getPkgName' :: GenericPackageDescription -> PackageName
getPkgName' :: GenericPackageDescription -> PackageName
getPkgName' = PackageIdentifier -> PackageName
I.pkgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
package forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
packageDescription
getPkgVersion :: PackageDescription -> Version
getPkgVersion :: PackageDescription -> Version
getPkgVersion = PackageIdentifier -> Version
I.pkgVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
package
getUrl :: PackageDescription -> String
getUrl :: PackageDescription -> String
getUrl PackageDescription
cabal = forall {m :: * -> *} {a}. MonadFail m => Maybe (m a) -> m a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe String
home forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
vcs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
fallback
where
f :: String -> Maybe String
f String
"" = forall a. Maybe a
Nothing
f String
x = 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)
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Impossible."
home :: Maybe String
home = String -> Maybe String
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> String
fromShortText forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> ShortText
homepage forall a b. (a -> b) -> a -> b
$ PackageDescription
cabal
vcs :: Maybe String
vcs = SourceRepo -> Maybe String
repoLocation forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (forall s a. s -> Getting (First a) s a -> Maybe a
^? forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [SourceRepo]
sourceRepos forall a b. (a -> b) -> a -> b
$ PackageDescription
cabal
fallback :: Maybe String
fallback = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"https://hackage.haskell.org/package/" 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
dependencyTypeToKind DependencyType
CSetup = DependencyKind
Setup
getTwo :: Getting b s b -> s -> s -> (b, b)
getTwo :: forall b s. Getting b s b -> s -> s -> (b, b)
getTwo Getting b s b
l s
a s
b = (s
a, s
b) forall a b. a -> (a -> b) -> b
& forall a b. Traversal (a, a) (b, b) a b
both forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall s a. s -> Getting a s a -> a
^. Getting b s b
l)
buildDependsIfBuild :: BuildInfo -> [Dependency]
buildDependsIfBuild :: BuildInfo -> [Dependency]
buildDependsIfBuild BuildInfo
info = forall a. a -> BuildInfo -> (BuildInfo -> a) -> a
whenBuildable [] BuildInfo
info BuildInfo -> [Dependency]
targetBuildDepends
buildToolsAndbuildToolDependsIfBuild :: BuildInfo -> ([LegacyExeDependency], [ExeDependency])
buildToolsAndbuildToolDependsIfBuild :: BuildInfo -> ([LegacyExeDependency], [ExeDependency])
buildToolsAndbuildToolDependsIfBuild BuildInfo
info = forall a. a -> BuildInfo -> (BuildInfo -> a) -> a
whenBuildable ([], []) BuildInfo
info forall a b. (a -> b) -> a -> b
$ \BuildInfo
i -> (BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
i, BuildInfo -> [ExeDependency]
buildToolDepends BuildInfo
i)
pkgconfigDependsAndExtraLibsIfBuild :: BuildInfo -> ([PkgconfigDependency], [String])
pkgconfigDependsAndExtraLibsIfBuild :: BuildInfo -> ([PkgconfigDependency], [String])
pkgconfigDependsAndExtraLibsIfBuild BuildInfo
info = forall a. a -> BuildInfo -> (BuildInfo -> a) -> a
whenBuildable ([], []) BuildInfo
info forall a b. (a -> b) -> a -> b
$ \BuildInfo
i -> (BuildInfo -> [PkgconfigDependency]
pkgconfigDepends BuildInfo
i, BuildInfo -> [String]
extraLibs BuildInfo
i)
whenBuildable :: a -> BuildInfo -> (BuildInfo -> a) -> a
whenBuildable :: forall a. a -> BuildInfo -> (BuildInfo -> a) -> a
whenBuildable a
def BuildInfo
info BuildInfo -> a
f
| BuildInfo -> Bool
buildable BuildInfo
info = BuildInfo -> a
f BuildInfo
info
| Bool
otherwise = a
def
trace' :: Member Trace r => String -> Sem r ()
trace' :: forall (r :: EffectRow). Member Trace r => String -> Sem r ()
trace' String
s = forall (r :: EffectRow). Member Trace r => String -> Sem r ()
trace forall a b. (a -> b) -> a -> b
$ String
"[TRACE] " forall a. Semigroup a => a -> a -> a
<> String
s
traceCallStack :: (HasCallStack, Member Trace r) => Sem r ()
traceCallStack :: forall (r :: EffectRow). (HasCallStack, Member Trace r) => Sem r ()
traceCallStack = do
forall (r :: EffectRow). Member Trace r => String -> Sem r ()
trace forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
prefix forall a b. (a -> b) -> a -> b
$ CallStack -> String
prettyCallStack HasCallStack => CallStack
callStack
where
prefix :: String -> String
prefix = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"[TRACE] " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
depNotInGHCLib :: SolvedDependency -> Bool
depNotInGHCLib :: SolvedDependency -> Bool
depNotInGHCLib SolvedDependency
x = (SolvedDependency
x forall s a. s -> Getting a s a -> a
^. Lens' SolvedDependency PackageName
depName) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` PkgList
ghcLibList
depNotMyself :: PackageName -> SolvedDependency -> Bool
depNotMyself :: PackageName -> SolvedDependency -> Bool
depNotMyself PackageName
name SolvedDependency
x = SolvedDependency
x forall s a. s -> Getting a s a -> a
^. Lens' SolvedDependency PackageName
depName forall a. Eq a => a -> a -> Bool
/= PackageName
name
depIsKind :: DependencyKind -> SolvedDependency -> Bool
depIsKind :: DependencyKind -> SolvedDependency -> Bool
depIsKind DependencyKind
k SolvedDependency
x = DependencyKind
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (SolvedDependency
x forall s a. s -> Getting a s a -> a
^. Lens' SolvedDependency [DependencyType]
depType forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> DependencyType -> DependencyKind
dependencyTypeToKind)
extractFromEVR :: String -> ArchLinuxVersion
String
evr =
let ev :: String
ev = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"-" String
evr
in if Char
':' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
ev then forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (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
filterFirstDiff :: [Diff a] -> [Diff a]
filterFirstDiff :: forall a. [Diff a] -> [Diff a]
filterFirstDiff = forall a. (a -> Bool) -> [a] -> [a]
filter (\case First a
_ -> Bool
True; Diff a
_ -> Bool
False)
filterSecondDiff :: [Diff a] -> [Diff a]
filterSecondDiff :: forall a. [Diff a] -> [Diff a]
filterSecondDiff = forall a. (a -> Bool) -> [a] -> [a]
filter (\case Second a
_ -> Bool
True; Diff a
_ -> Bool
False)
filterFirstAndBothDiff :: [Diff a] -> [Diff a]
filterFirstAndBothDiff :: forall a. [Diff a] -> [Diff a]
filterFirstAndBothDiff = forall a. (a -> Bool) -> [a] -> [a]
filter (\case Second a
_ -> Bool
False; Diff a
_ -> Bool
True)
filterSecondAndBothDiff :: [Diff a] -> [Diff a]
filterSecondAndBothDiff :: forall a. [Diff a] -> [Diff a]
filterSecondAndBothDiff = forall a. (a -> Bool) -> [a] -> [a]
filter (\case First a
_ -> Bool
False; Diff a
_ -> Bool
True)
noDiff :: [Diff a] -> Bool
noDiff :: forall a. [Diff a] -> Bool
noDiff = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case Both a
_ a
_ -> Bool
True; Diff a
_ -> Bool
False)
mapDiff :: (a -> b) -> Diff a -> Diff b
mapDiff :: forall a b. (a -> b) -> Diff a -> Diff b
mapDiff a -> b
f (First a
x) = forall a b. a -> PolyDiff a b
First forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
mapDiff a -> b
f (Second a
x) = forall a b. b -> PolyDiff a b
Second forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
mapDiff a -> b
f (Both a
x a
y) = forall a b. a -> b -> PolyDiff a b
Both (a -> b
f a
x) (a -> b
f a
y)
unDiff :: Diff a -> a
unDiff :: forall a. Diff a -> a
unDiff (First a
x) = a
x
unDiff (Second a
x) = a
x
unDiff (Both a
x a
_) = a
x
archHsVersion :: String
archHsVersion :: String
archHsVersion = $(simpleVersion Path.version)
defaultFlags :: [PkgFlag] -> FlagAssignment -> FlagAssignment
defaultFlags :: [PkgFlag] -> FlagAssignment -> FlagAssignment
defaultFlags [PkgFlag]
pkgFlags FlagAssignment
assignment = FlagAssignment
result
where
defaultFlagAssignments :: FlagAssignment
defaultFlagAssignments =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\PkgFlag
f FlagAssignment
acc -> FlagName -> Bool -> FlagAssignment -> FlagAssignment
insertFlagAssignment (PkgFlag -> FlagName
flagName PkgFlag
f) (PkgFlag -> Bool
flagDefault PkgFlag
f) FlagAssignment
acc) ([(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment []) [PkgFlag]
pkgFlags
flagAssignment :: [(FlagName, Bool)]
flagAssignment = FlagAssignment -> [(FlagName, Bool)]
unFlagAssignment FlagAssignment
assignment
flagNames :: [FlagName]
flagNames = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(FlagName, Bool)]
flagAssignment
result :: FlagAssignment
result =
[(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> [(FlagName, Bool)]
flagAssignment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\(FlagName
fName, Bool
_) -> FlagName
fName forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FlagName]
flagNames)
forall a b. (a -> b) -> a -> b
$ FlagAssignment -> [(FlagName, Bool)]
unFlagAssignment FlagAssignment
defaultFlagAssignments
getFlagAssignment :: PackageName -> FlagAssignments -> FlagAssignment
getFlagAssignment :: PackageName -> FlagAssignments -> FlagAssignment
getFlagAssignment PackageName
k FlagAssignments
v = forall a. a -> Maybe a -> a
fromMaybe ([(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment []) forall a b. (a -> b) -> a -> b
$ PackageName
k forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` FlagAssignments
v