-- | Copyright: (c) 2020 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <1793913507@qq.com>
-- Stability: experimental
-- Portability: portable
-- Miscellaneous functions used crossing modules.
module Distribution.ArchHs.Utils
  ( getPkgName,
    getPkgName',
    getPkgVersion,
    dependencyTypeToKind,
    unExe,
    unExeV,
    unDepV,
    getUrl,
    getTwo,
    buildDependsIfBuild,
    buildToolDependsIfBuild,
    traceCallStack,
    trace',
  )
where

import Control.Monad ((<=<))
import Distribution.ArchHs.Internal.Prelude
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 qualified Distribution.Types.PackageId as I
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 '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 (PackageName -> String) -> PackageName -> String
forall a b. (a -> b) -> a -> b
$ 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

-- | 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 = if BuildInfo -> Bool
buildable BuildInfo
info then BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
info else []

-- | Same as 'buildToolDepends', but check if this is 'buildable'.
buildToolDependsIfBuild :: BuildInfo -> [ExeDependency]
buildToolDependsIfBuild :: BuildInfo -> [ExeDependency]
buildToolDependsIfBuild BuildInfo
info = if BuildInfo -> Bool
buildable BuildInfo
info then BuildInfo -> [ExeDependency]
buildToolDepends BuildInfo
info else []

-- | 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