{-# LANGUAGE ViewPatterns #-}

-- | Copyright: (c) 2020 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability: portable
-- Miscellaneous functions used crossing modules.
module Distribution.ArchHs.Utils
  ( 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,
  )
where

import Control.Monad ((<=<))
import Data.Algorithm.Diff
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)

-- | Extract the package name from a 'ExeDependency'.
unExe :: ExeDependency -> PackageName
unExe :: ExeDependency -> PackageName
unExe (ExeDependency PackageName
name UnqualComponentName
_ VersionRange
_) = PackageName
name

-- | Extract the package name and the version range from a 'ExeDependency'.
unExeV :: ExeDependency -> (PackageName, VersionRange)
unExeV :: ExeDependency -> (PackageName, VersionRange)
unExeV (ExeDependency PackageName
name UnqualComponentName
_ VersionRange
v) = (PackageName
name, VersionRange
v)

-- | Extract the package name and the version range from a 'LegacyExeDependency'.
unLegacyExeV :: LegacyExeDependency -> (PackageName, VersionRange)
unLegacyExeV :: LegacyExeDependency -> (PackageName, VersionRange)
unLegacyExeV (LegacyExeDependency String
name VersionRange
v) = (String -> PackageName
mkPackageName String
name, VersionRange
v)

-- | Extract and join package names and version ranges of '[LegacyExeDependency]' and '[ExeDependency]'.
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)

-- | Extract dependency names from '[PkgconfigDependency]' and '[SystemDependency]'.
-- >>> (PkgconfigDependency "foo" _ver) --> (SystemDependency "foo.pc")
-- >>> "foo" --> (SystemDependency "libfoo.so")
unSystemDependency :: ([PkgconfigDependency], [String]) -> [SystemDependency]
unSystemDependency :: ([PkgconfigDependency], [String]) -> [SystemDependency]
unSystemDependency ([PkgconfigDependency]
p, [String]
s) = [String -> SystemDependency
SystemDependency (String -> SystemDependency) -> String -> SystemDependency
forall a b. (a -> b) -> a -> b
$ String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".pc" | (PkgconfigDependency (PkgconfigName -> String
unPkgconfigName -> String
name) PkgconfigVersionRange
_) <- [PkgconfigDependency]
p] [SystemDependency] -> [SystemDependency] -> [SystemDependency]
forall a. Semigroup a => a -> a -> a
<> [String -> SystemDependency
SystemDependency (String -> SystemDependency) -> String -> SystemDependency
forall a b. (a -> b) -> a -> b
$ String
"lib" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".so" | String
name <- [String]
s]

-- | Extract the 'PackageName' and 'VersionRange' of a 'Dependency'.
unDepV :: Dependency -> (PackageName, VersionRange)
unDepV :: Dependency -> (PackageName, VersionRange)
unDepV Dependency
dep = (Dependency -> PackageName
depPkgName Dependency
dep, Dependency -> VersionRange
depVerRange Dependency
dep)

-- | Extract the package name from 'PackageDescription'.
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

-- | Extract the package name from 'GenericPackageDescription'.
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

-- | Extract the package version from '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

-- | Extract the url from 'PackageDescription'.
-- It tries 'homepage', the head of 'sourceRepos', and finally fallback into hackage website.
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)

-- | Map 'DependencyType' with its data constructor tag 'DependencyKind'.
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

-- | Apply a 'Getting' to two values respectively, and get the result as a pair.
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)

-- | Same as 'targetBuildDepends', but check if this is 'buildable'.
buildDependsIfBuild :: BuildInfo -> [Dependency]
buildDependsIfBuild :: BuildInfo -> [Dependency]
buildDependsIfBuild BuildInfo
info = [Dependency]
-> BuildInfo -> (BuildInfo -> [Dependency]) -> [Dependency]
forall a. a -> BuildInfo -> (BuildInfo -> a) -> a
whenBuildable [] BuildInfo
info BuildInfo -> [Dependency]
targetBuildDepends

-- | 'buildToolDepends' combined with 'buildTools', and check if this is 'buildable'.
-- Actually, we should avoid accessing these two fields directly, in in favor of 'Distribution.Simple.BuildToolDepends.getAllToolDependencies'
buildToolsAndbuildToolDependsIfBuild :: BuildInfo -> ([LegacyExeDependency], [ExeDependency])
buildToolsAndbuildToolDependsIfBuild :: BuildInfo -> ([LegacyExeDependency], [ExeDependency])
buildToolsAndbuildToolDependsIfBuild BuildInfo
info = ([LegacyExeDependency], [ExeDependency])
-> BuildInfo
-> (BuildInfo -> ([LegacyExeDependency], [ExeDependency]))
-> ([LegacyExeDependency], [ExeDependency])
forall a. a -> BuildInfo -> (BuildInfo -> a) -> a
whenBuildable ([], []) BuildInfo
info ((BuildInfo -> ([LegacyExeDependency], [ExeDependency]))
 -> ([LegacyExeDependency], [ExeDependency]))
-> (BuildInfo -> ([LegacyExeDependency], [ExeDependency]))
-> ([LegacyExeDependency], [ExeDependency])
forall a b. (a -> b) -> a -> b
$ \BuildInfo
i -> (BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
i, BuildInfo -> [ExeDependency]
buildToolDepends BuildInfo
i)

-- | 'pkgconfigDepends' combined with 'extraLibs', and check if this is 'buildable'.
pkgconfigDependsAndExtraLibsIfBuild :: BuildInfo -> ([PkgconfigDependency], [String])
pkgconfigDependsAndExtraLibsIfBuild :: BuildInfo -> ([PkgconfigDependency], [String])
pkgconfigDependsAndExtraLibsIfBuild BuildInfo
info = ([PkgconfigDependency], [String])
-> BuildInfo
-> (BuildInfo -> ([PkgconfigDependency], [String]))
-> ([PkgconfigDependency], [String])
forall a. a -> BuildInfo -> (BuildInfo -> a) -> a
whenBuildable ([], []) BuildInfo
info ((BuildInfo -> ([PkgconfigDependency], [String]))
 -> ([PkgconfigDependency], [String]))
-> (BuildInfo -> ([PkgconfigDependency], [String]))
-> ([PkgconfigDependency], [String])
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 :: 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 with prefix @[TRACE]@.
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

-- | Trace 'GHC.Stack.CallStack'.
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

-- | 'SolvedDependency' @x@' is not provided by ghc.
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

-- | 'SolvedDependency' @x@'s name is not equal to @name@.
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

-- | 'SolvedDependency' @x@' has 'DependencyKind' @k@.
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)

-- | Extract package version from epoch-version-release.
--
-- >>> extractFromEVR "8.10.2-1"
-- "8.10.2"
-- >>> extractFromEVR "3:2.4.11-19"
-- "2.4.11"
extractFromEVR :: String -> ArchLinuxVersion
extractFromEVR :: String -> String
extractFromEVR 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

-- | Whether a 'SolvedPackage' is provided
isProvided :: SolvedPackage -> Bool
isProvided :: SolvedPackage -> Bool
isProvided (ProvidedPackage PackageName
_ DependencyProvider
_) = Bool
True
isProvided SolvedPackage
_ = Bool
False

-- | Filter values from only 'First' list
filterFirstDiff :: [Diff a] -> [Diff a]
filterFirstDiff :: [Diff a] -> [Diff a]
filterFirstDiff = (Diff a -> Bool) -> [Diff a] -> [Diff a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case First a
_ -> Bool
True; Diff a
_ -> Bool
False)

-- | Filter values from only 'Second' list
filterSecondDiff :: [Diff a] -> [Diff a]
filterSecondDiff :: [Diff a] -> [Diff a]
filterSecondDiff = (Diff a -> Bool) -> [Diff a] -> [Diff a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case Second a
_ -> Bool
True; Diff a
_ -> Bool
False)

-- | Filter values from 'First' and 'Both' list
filterFirstAndBothDiff :: [Diff a] -> [Diff a]
filterFirstAndBothDiff :: [Diff a] -> [Diff a]
filterFirstAndBothDiff = (Diff a -> Bool) -> [Diff a] -> [Diff a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case Second a
_ -> Bool
False; Diff a
_ -> Bool
True)

-- | Filter values from 'Second' and 'Both' list
filterSecondAndBothDiff :: [Diff a] -> [Diff a]
filterSecondAndBothDiff :: [Diff a] -> [Diff a]
filterSecondAndBothDiff = (Diff a -> Bool) -> [Diff a] -> [Diff a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case First a
_ -> Bool
False; Diff a
_ -> Bool
True)

-- | Whether it only has 'Both'
noDiff :: [Diff a] -> Bool
noDiff :: [Diff a] -> Bool
noDiff = (Diff a -> Bool) -> [Diff a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case Both a
_ a
_ -> Bool
True; Diff a
_ -> Bool
False)

-- | Map value of diff
mapDiff :: (a -> b) -> Diff a -> Diff b
mapDiff :: (a -> b) -> Diff a -> Diff b
mapDiff a -> b
f (First a
x) = b -> Diff b
forall a b. a -> PolyDiff a b
First (b -> Diff b) -> b -> Diff b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
mapDiff a -> b
f (Second a
x) = b -> Diff b
forall a b. b -> PolyDiff a b
Second (b -> Diff b) -> b -> Diff b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
mapDiff a -> b
f (Both a
x a
y) = b -> b -> Diff b
forall a b. a -> b -> PolyDiff a b
Both (a -> b
f a
x) (a -> b
f a
y)

-- | Extract value from diff
unDiff :: Diff a -> a
unDiff :: Diff a -> a
unDiff (First a
x) = a
x
unDiff (Second a
x) = a
x
unDiff (Both a
x a
_) = a
x