{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Copyright: (c) 2020-2021 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability : portable
-- Types used in this project.
module Distribution.ArchHs.Types
  ( PkgList,
    ComponentPkgList,
    ArchLinuxName (..),
    SystemDependency (..),
    PkgDependent (..),
    PkgDependentList,
    PkgDesc (..),
    ArchLinuxVersion,
    ExtraDB,
    HackageEnv,
    ExtraEnv,
    FlagAssignmentsEnv,
    KnownGHCVersion,
    DependencyType (..),
    DependencyKind (..),
    DependencyProvider (..),
    SolvedPackage (..),
    SolvedDependency (..),
    FlagAssignments,
    depProvider,
    pkgProvider,
    pkgName,
    pkgDeps,
    depName,
    depType,
    DependencyRecord,
  )
where

import Data.Map.Strict (Map)
import Distribution.ArchHs.Internal.Prelude
import Distribution.Hackage.DB (HackageDB)
import Lens.Micro.TH (makeLenses)

-- | A list of 'PackageName'
type PkgList = [PackageName]

-- | A list of component represented by 'UnqualComponentName' and its dependencies collected in a 'PkgList'
type ComponentPkgList = [(UnqualComponentName, PkgList)]

-- | Name of packages in archlinux repo, a wrapper of 'String'.
newtype ArchLinuxName = ArchLinuxName
  { -- | Unwrap the value
    ArchLinuxName -> ArchLinuxVersion
unArchLinuxName :: String
  }
  deriving stock (Int -> ArchLinuxName -> ShowS
[ArchLinuxName] -> ShowS
ArchLinuxName -> ArchLinuxVersion
forall a.
(Int -> a -> ShowS)
-> (a -> ArchLinuxVersion) -> ([a] -> ShowS) -> Show a
showList :: [ArchLinuxName] -> ShowS
$cshowList :: [ArchLinuxName] -> ShowS
show :: ArchLinuxName -> ArchLinuxVersion
$cshow :: ArchLinuxName -> ArchLinuxVersion
showsPrec :: Int -> ArchLinuxName -> ShowS
$cshowsPrec :: Int -> ArchLinuxName -> ShowS
Show, ReadPrec [ArchLinuxName]
ReadPrec ArchLinuxName
Int -> ReadS ArchLinuxName
ReadS [ArchLinuxName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ArchLinuxName]
$creadListPrec :: ReadPrec [ArchLinuxName]
readPrec :: ReadPrec ArchLinuxName
$creadPrec :: ReadPrec ArchLinuxName
readList :: ReadS [ArchLinuxName]
$creadList :: ReadS [ArchLinuxName]
readsPrec :: Int -> ReadS ArchLinuxName
$creadsPrec :: Int -> ReadS ArchLinuxName
Read, ArchLinuxName -> ArchLinuxName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArchLinuxName -> ArchLinuxName -> Bool
$c/= :: ArchLinuxName -> ArchLinuxName -> Bool
== :: ArchLinuxName -> ArchLinuxName -> Bool
$c== :: ArchLinuxName -> ArchLinuxName -> Bool
Eq, Eq ArchLinuxName
ArchLinuxName -> ArchLinuxName -> Bool
ArchLinuxName -> ArchLinuxName -> Ordering
ArchLinuxName -> ArchLinuxName -> ArchLinuxName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArchLinuxName -> ArchLinuxName -> ArchLinuxName
$cmin :: ArchLinuxName -> ArchLinuxName -> ArchLinuxName
max :: ArchLinuxName -> ArchLinuxName -> ArchLinuxName
$cmax :: ArchLinuxName -> ArchLinuxName -> ArchLinuxName
>= :: ArchLinuxName -> ArchLinuxName -> Bool
$c>= :: ArchLinuxName -> ArchLinuxName -> Bool
> :: ArchLinuxName -> ArchLinuxName -> Bool
$c> :: ArchLinuxName -> ArchLinuxName -> Bool
<= :: ArchLinuxName -> ArchLinuxName -> Bool
$c<= :: ArchLinuxName -> ArchLinuxName -> Bool
< :: ArchLinuxName -> ArchLinuxName -> Bool
$c< :: ArchLinuxName -> ArchLinuxName -> Bool
compare :: ArchLinuxName -> ArchLinuxName -> Ordering
$ccompare :: ArchLinuxName -> ArchLinuxName -> Ordering
Ord, forall x. Rep ArchLinuxName x -> ArchLinuxName
forall x. ArchLinuxName -> Rep ArchLinuxName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArchLinuxName x -> ArchLinuxName
$cfrom :: forall x. ArchLinuxName -> Rep ArchLinuxName x
Generic)
  deriving anyclass (ArchLinuxName -> ()
forall a. (a -> ()) -> NFData a
rnf :: ArchLinuxName -> ()
$crnf :: ArchLinuxName -> ()
NFData)

-- | A external dependency provided by system,
-- which is converted from package config (.pc) or extra lib (.so).
newtype SystemDependency = SystemDependency String
  deriving stock (Int -> SystemDependency -> ShowS
[SystemDependency] -> ShowS
SystemDependency -> ArchLinuxVersion
forall a.
(Int -> a -> ShowS)
-> (a -> ArchLinuxVersion) -> ([a] -> ShowS) -> Show a
showList :: [SystemDependency] -> ShowS
$cshowList :: [SystemDependency] -> ShowS
show :: SystemDependency -> ArchLinuxVersion
$cshow :: SystemDependency -> ArchLinuxVersion
showsPrec :: Int -> SystemDependency -> ShowS
$cshowsPrec :: Int -> SystemDependency -> ShowS
Show, ReadPrec [SystemDependency]
ReadPrec SystemDependency
Int -> ReadS SystemDependency
ReadS [SystemDependency]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SystemDependency]
$creadListPrec :: ReadPrec [SystemDependency]
readPrec :: ReadPrec SystemDependency
$creadPrec :: ReadPrec SystemDependency
readList :: ReadS [SystemDependency]
$creadList :: ReadS [SystemDependency]
readsPrec :: Int -> ReadS SystemDependency
$creadsPrec :: Int -> ReadS SystemDependency
Read, SystemDependency -> SystemDependency -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemDependency -> SystemDependency -> Bool
$c/= :: SystemDependency -> SystemDependency -> Bool
== :: SystemDependency -> SystemDependency -> Bool
$c== :: SystemDependency -> SystemDependency -> Bool
Eq, Eq SystemDependency
SystemDependency -> SystemDependency -> Bool
SystemDependency -> SystemDependency -> Ordering
SystemDependency -> SystemDependency -> SystemDependency
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SystemDependency -> SystemDependency -> SystemDependency
$cmin :: SystemDependency -> SystemDependency -> SystemDependency
max :: SystemDependency -> SystemDependency -> SystemDependency
$cmax :: SystemDependency -> SystemDependency -> SystemDependency
>= :: SystemDependency -> SystemDependency -> Bool
$c>= :: SystemDependency -> SystemDependency -> Bool
> :: SystemDependency -> SystemDependency -> Bool
$c> :: SystemDependency -> SystemDependency -> Bool
<= :: SystemDependency -> SystemDependency -> Bool
$c<= :: SystemDependency -> SystemDependency -> Bool
< :: SystemDependency -> SystemDependency -> Bool
$c< :: SystemDependency -> SystemDependency -> Bool
compare :: SystemDependency -> SystemDependency -> Ordering
$ccompare :: SystemDependency -> SystemDependency -> Ordering
Ord, forall x. Rep SystemDependency x -> SystemDependency
forall x. SystemDependency -> Rep SystemDependency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SystemDependency x -> SystemDependency
$cfrom :: forall x. SystemDependency -> Rep SystemDependency x
Generic)
  deriving anyclass (SystemDependency -> ()
forall a. (a -> ()) -> NFData a
rnf :: SystemDependency -> ()
$crnf :: SystemDependency -> ()
NFData)

-- | Arch Linux dependency type for @depends@, @replaces@, @conflicts@,.etc in 'PkgDesc'
data PkgDependent = PkgDependent
  { PkgDependent -> ArchLinuxName
_pdName :: ArchLinuxName,
    PkgDependent -> Maybe ArchLinuxVersion
_pdVersion :: Maybe ArchLinuxVersion
  }
  deriving stock (Int -> PkgDependent -> ShowS
PkgDependentList -> ShowS
PkgDependent -> ArchLinuxVersion
forall a.
(Int -> a -> ShowS)
-> (a -> ArchLinuxVersion) -> ([a] -> ShowS) -> Show a
showList :: PkgDependentList -> ShowS
$cshowList :: PkgDependentList -> ShowS
show :: PkgDependent -> ArchLinuxVersion
$cshow :: PkgDependent -> ArchLinuxVersion
showsPrec :: Int -> PkgDependent -> ShowS
$cshowsPrec :: Int -> PkgDependent -> ShowS
Show, PkgDependent -> PkgDependent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgDependent -> PkgDependent -> Bool
$c/= :: PkgDependent -> PkgDependent -> Bool
== :: PkgDependent -> PkgDependent -> Bool
$c== :: PkgDependent -> PkgDependent -> Bool
Eq, Eq PkgDependent
PkgDependent -> PkgDependent -> Bool
PkgDependent -> PkgDependent -> Ordering
PkgDependent -> PkgDependent -> PkgDependent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PkgDependent -> PkgDependent -> PkgDependent
$cmin :: PkgDependent -> PkgDependent -> PkgDependent
max :: PkgDependent -> PkgDependent -> PkgDependent
$cmax :: PkgDependent -> PkgDependent -> PkgDependent
>= :: PkgDependent -> PkgDependent -> Bool
$c>= :: PkgDependent -> PkgDependent -> Bool
> :: PkgDependent -> PkgDependent -> Bool
$c> :: PkgDependent -> PkgDependent -> Bool
<= :: PkgDependent -> PkgDependent -> Bool
$c<= :: PkgDependent -> PkgDependent -> Bool
< :: PkgDependent -> PkgDependent -> Bool
$c< :: PkgDependent -> PkgDependent -> Bool
compare :: PkgDependent -> PkgDependent -> Ordering
$ccompare :: PkgDependent -> PkgDependent -> Ordering
Ord, forall x. Rep PkgDependent x -> PkgDependent
forall x. PkgDependent -> Rep PkgDependent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PkgDependent x -> PkgDependent
$cfrom :: forall x. PkgDependent -> Rep PkgDependent x
Generic)
  deriving anyclass (PkgDependent -> ()
forall a. (a -> ()) -> NFData a
rnf :: PkgDependent -> ()
$crnf :: PkgDependent -> ()
NFData)

-- | A list of 'PkgDependent'
type PkgDependentList = [PkgDependent]

-- | Package description file of a installed system package, retrieved from @repo.db@ file.
data PkgDesc = PkgDesc
  { PkgDesc -> ArchLinuxName
_name :: ArchLinuxName,
    PkgDesc -> ArchLinuxVersion
_version :: ArchLinuxVersion,
    PkgDesc -> ArchLinuxVersion
_desc :: String,
    PkgDesc -> Maybe ArchLinuxVersion
_url :: Maybe String,
    PkgDesc -> PkgDependentList
_provides :: PkgDependentList,
    PkgDesc -> PkgDependentList
_optDepends :: PkgDependentList,
    PkgDesc -> PkgDependentList
_replaces :: PkgDependentList,
    PkgDesc -> PkgDependentList
_conflicts :: PkgDependentList,
    PkgDesc -> PkgDependentList
_depends :: PkgDependentList,
    PkgDesc -> PkgDependentList
_makeDepends :: PkgDependentList,
    PkgDesc -> PkgDependentList
_checkDepends :: PkgDependentList
  }
  deriving stock (Int -> PkgDesc -> ShowS
[PkgDesc] -> ShowS
PkgDesc -> ArchLinuxVersion
forall a.
(Int -> a -> ShowS)
-> (a -> ArchLinuxVersion) -> ([a] -> ShowS) -> Show a
showList :: [PkgDesc] -> ShowS
$cshowList :: [PkgDesc] -> ShowS
show :: PkgDesc -> ArchLinuxVersion
$cshow :: PkgDesc -> ArchLinuxVersion
showsPrec :: Int -> PkgDesc -> ShowS
$cshowsPrec :: Int -> PkgDesc -> ShowS
Show, PkgDesc -> PkgDesc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgDesc -> PkgDesc -> Bool
$c/= :: PkgDesc -> PkgDesc -> Bool
== :: PkgDesc -> PkgDesc -> Bool
$c== :: PkgDesc -> PkgDesc -> Bool
Eq, Eq PkgDesc
PkgDesc -> PkgDesc -> Bool
PkgDesc -> PkgDesc -> Ordering
PkgDesc -> PkgDesc -> PkgDesc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PkgDesc -> PkgDesc -> PkgDesc
$cmin :: PkgDesc -> PkgDesc -> PkgDesc
max :: PkgDesc -> PkgDesc -> PkgDesc
$cmax :: PkgDesc -> PkgDesc -> PkgDesc
>= :: PkgDesc -> PkgDesc -> Bool
$c>= :: PkgDesc -> PkgDesc -> Bool
> :: PkgDesc -> PkgDesc -> Bool
$c> :: PkgDesc -> PkgDesc -> Bool
<= :: PkgDesc -> PkgDesc -> Bool
$c<= :: PkgDesc -> PkgDesc -> Bool
< :: PkgDesc -> PkgDesc -> Bool
$c< :: PkgDesc -> PkgDesc -> Bool
compare :: PkgDesc -> PkgDesc -> Ordering
$ccompare :: PkgDesc -> PkgDesc -> Ordering
Ord, forall x. Rep PkgDesc x -> PkgDesc
forall x. PkgDesc -> Rep PkgDesc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PkgDesc x -> PkgDesc
$cfrom :: forall x. PkgDesc -> Rep PkgDesc x
Generic)
  deriving anyclass (PkgDesc -> ()
forall a. (a -> ()) -> NFData a
rnf :: PkgDesc -> ()
$crnf :: PkgDesc -> ()
NFData)

-- | Version of packages in archlinux extra repo
type ArchLinuxVersion = String

-- | Representation of @cummunity.db@
type ExtraDB = Map ArchLinuxName PkgDesc

-- | Reader effect of 'HackageDB'
type HackageEnv = Reader HackageDB

-- | Reader effect of 'ExtraDB'
type ExtraEnv = Reader ExtraDB

-- | A map of packages with their 'FlagAssignment'
type FlagAssignments = Map PackageName FlagAssignment

-- | Reader effect of a map, associating 'PackageName' with its 'FlagAssignment'
type FlagAssignmentsEnv = Reader FlagAssignments

-- | Unused state effect
type DependencyRecord = State (Map PackageName [VersionRange])

-- | Reader effect of GHC version in dependency resolution
type KnownGHCVersion = Reader Version

-- | The type of a dependency. Who requires this?
data DependencyType
  = -- | By a /executable/
    CExe UnqualComponentName
  | -- | By the /build tools/ of a /executable/
    CExeBuildTools UnqualComponentName
  | -- | By a /library/
    CLib
  | -- By a /custom setup/
    CSetup
  | -- | By a /test suit/
    CTest UnqualComponentName
  | -- | By a /benchmark/
    CBenchmark UnqualComponentName
  | -- | By the /build tools/ of a /library/
    CLibBuildTools
  | -- | By the /build tools/ of a /test suit/
    CTestBuildTools UnqualComponentName
  | -- | By the /build tools/ of a /benchmark/
    CBenchmarkBuildTools UnqualComponentName
  | -- |  By a /sub-library/
    CSubLibs UnqualComponentName
  | -- |  By the /build tools/ of a /sub-library/
    CSubLibsBuildTools UnqualComponentName
  deriving stock (DependencyType -> DependencyType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DependencyType -> DependencyType -> Bool
$c/= :: DependencyType -> DependencyType -> Bool
== :: DependencyType -> DependencyType -> Bool
$c== :: DependencyType -> DependencyType -> Bool
Eq, Eq DependencyType
DependencyType -> DependencyType -> Bool
DependencyType -> DependencyType -> Ordering
DependencyType -> DependencyType -> DependencyType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DependencyType -> DependencyType -> DependencyType
$cmin :: DependencyType -> DependencyType -> DependencyType
max :: DependencyType -> DependencyType -> DependencyType
$cmax :: DependencyType -> DependencyType -> DependencyType
>= :: DependencyType -> DependencyType -> Bool
$c>= :: DependencyType -> DependencyType -> Bool
> :: DependencyType -> DependencyType -> Bool
$c> :: DependencyType -> DependencyType -> Bool
<= :: DependencyType -> DependencyType -> Bool
$c<= :: DependencyType -> DependencyType -> Bool
< :: DependencyType -> DependencyType -> Bool
$c< :: DependencyType -> DependencyType -> Bool
compare :: DependencyType -> DependencyType -> Ordering
$ccompare :: DependencyType -> DependencyType -> Ordering
Ord, forall x. Rep DependencyType x -> DependencyType
forall x. DependencyType -> Rep DependencyType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DependencyType x -> DependencyType
$cfrom :: forall x. DependencyType -> Rep DependencyType x
Generic)
  deriving anyclass (DependencyType -> ()
forall a. (a -> ()) -> NFData a
rnf :: DependencyType -> ()
$crnf :: DependencyType -> ()
NFData)

-- | Tags of data constructors of 'DependencyType'
data DependencyKind
  = Exe
  | ExeBuildTools
  | Lib
  | Setup
  | Test
  | Benchmark
  | LibBuildTools
  | TestBuildTools
  | BenchmarkBuildTools
  | SubLibs
  | SubLibsBuildTools
  deriving stock (DependencyKind -> DependencyKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DependencyKind -> DependencyKind -> Bool
$c/= :: DependencyKind -> DependencyKind -> Bool
== :: DependencyKind -> DependencyKind -> Bool
$c== :: DependencyKind -> DependencyKind -> Bool
Eq)

instance Show DependencyType where
  show :: DependencyType -> ArchLinuxVersion
show (CExe UnqualComponentName
x) = UnqualComponentName -> ArchLinuxVersion
unUnqualComponentName UnqualComponentName
x forall a. Semigroup a => a -> a -> a
<> ArchLinuxVersion
" :: Exe"
  show (CExeBuildTools UnqualComponentName
x) = UnqualComponentName -> ArchLinuxVersion
unUnqualComponentName UnqualComponentName
x forall a. Semigroup a => a -> a -> a
<> ArchLinuxVersion
" :: ExeBuildTools"
  show (CTest UnqualComponentName
x) = UnqualComponentName -> ArchLinuxVersion
unUnqualComponentName UnqualComponentName
x forall a. Semigroup a => a -> a -> a
<> ArchLinuxVersion
" :: Test"
  show (CBenchmark UnqualComponentName
x) = UnqualComponentName -> ArchLinuxVersion
unUnqualComponentName UnqualComponentName
x forall a. Semigroup a => a -> a -> a
<> ArchLinuxVersion
" :: Benchmark"
  show (CTestBuildTools UnqualComponentName
x) = UnqualComponentName -> ArchLinuxVersion
unUnqualComponentName UnqualComponentName
x forall a. Semigroup a => a -> a -> a
<> ArchLinuxVersion
" :: TestBuildTools"
  show (CBenchmarkBuildTools UnqualComponentName
x) = UnqualComponentName -> ArchLinuxVersion
unUnqualComponentName UnqualComponentName
x forall a. Semigroup a => a -> a -> a
<> ArchLinuxVersion
" :: BenchmarkBuildTools"
  show (CSubLibs UnqualComponentName
x) = UnqualComponentName -> ArchLinuxVersion
unUnqualComponentName UnqualComponentName
x forall a. Semigroup a => a -> a -> a
<> ArchLinuxVersion
" :: SubLibs"
  show (CSubLibsBuildTools UnqualComponentName
x) = UnqualComponentName -> ArchLinuxVersion
unUnqualComponentName UnqualComponentName
x forall a. Semigroup a => a -> a -> a
<> ArchLinuxVersion
" :: SubLibsBuildTools"
  show DependencyType
CLib = ArchLinuxVersion
"Lib"
  show DependencyType
CLibBuildTools = ArchLinuxVersion
"LibBuildTools"
  show DependencyType
CSetup = ArchLinuxVersion
"Setup"

-- | Provider of a dependency.
data DependencyProvider = ByExtra | ByAur
  deriving stock (DependencyProvider -> DependencyProvider -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DependencyProvider -> DependencyProvider -> Bool
$c/= :: DependencyProvider -> DependencyProvider -> Bool
== :: DependencyProvider -> DependencyProvider -> Bool
$c== :: DependencyProvider -> DependencyProvider -> Bool
Eq, Eq DependencyProvider
DependencyProvider -> DependencyProvider -> Bool
DependencyProvider -> DependencyProvider -> Ordering
DependencyProvider -> DependencyProvider -> DependencyProvider
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DependencyProvider -> DependencyProvider -> DependencyProvider
$cmin :: DependencyProvider -> DependencyProvider -> DependencyProvider
max :: DependencyProvider -> DependencyProvider -> DependencyProvider
$cmax :: DependencyProvider -> DependencyProvider -> DependencyProvider
>= :: DependencyProvider -> DependencyProvider -> Bool
$c>= :: DependencyProvider -> DependencyProvider -> Bool
> :: DependencyProvider -> DependencyProvider -> Bool
$c> :: DependencyProvider -> DependencyProvider -> Bool
<= :: DependencyProvider -> DependencyProvider -> Bool
$c<= :: DependencyProvider -> DependencyProvider -> Bool
< :: DependencyProvider -> DependencyProvider -> Bool
$c< :: DependencyProvider -> DependencyProvider -> Bool
compare :: DependencyProvider -> DependencyProvider -> Ordering
$ccompare :: DependencyProvider -> DependencyProvider -> Ordering
Ord, forall x. Rep DependencyProvider x -> DependencyProvider
forall x. DependencyProvider -> Rep DependencyProvider x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DependencyProvider x -> DependencyProvider
$cfrom :: forall x. DependencyProvider -> Rep DependencyProvider x
Generic)
  deriving anyclass (DependencyProvider -> ()
forall a. (a -> ()) -> NFData a
rnf :: DependencyProvider -> ()
$crnf :: DependencyProvider -> ()
NFData)

instance Show DependencyProvider where
  show :: DependencyProvider -> ArchLinuxVersion
show DependencyProvider
ByExtra = ArchLinuxVersion
"[extra]"
  show DependencyProvider
ByAur = ArchLinuxVersion
"[aur]"

-- | A solved dependency, holden by 'SolvedPackage'
data SolvedDependency = SolvedDependency
  { -- | Provider of this dependency
    SolvedDependency -> Maybe DependencyProvider
_depProvider :: Maybe DependencyProvider,
    -- | Name of the dependency
    SolvedDependency -> PackageName
_depName :: PackageName,
    -- | Types of the dependency
    SolvedDependency -> [DependencyType]
_depType :: [DependencyType]
  }
  deriving stock (Int -> SolvedDependency -> ShowS
[SolvedDependency] -> ShowS
SolvedDependency -> ArchLinuxVersion
forall a.
(Int -> a -> ShowS)
-> (a -> ArchLinuxVersion) -> ([a] -> ShowS) -> Show a
showList :: [SolvedDependency] -> ShowS
$cshowList :: [SolvedDependency] -> ShowS
show :: SolvedDependency -> ArchLinuxVersion
$cshow :: SolvedDependency -> ArchLinuxVersion
showsPrec :: Int -> SolvedDependency -> ShowS
$cshowsPrec :: Int -> SolvedDependency -> ShowS
Show, SolvedDependency -> SolvedDependency -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolvedDependency -> SolvedDependency -> Bool
$c/= :: SolvedDependency -> SolvedDependency -> Bool
== :: SolvedDependency -> SolvedDependency -> Bool
$c== :: SolvedDependency -> SolvedDependency -> Bool
Eq, Eq SolvedDependency
SolvedDependency -> SolvedDependency -> Bool
SolvedDependency -> SolvedDependency -> Ordering
SolvedDependency -> SolvedDependency -> SolvedDependency
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SolvedDependency -> SolvedDependency -> SolvedDependency
$cmin :: SolvedDependency -> SolvedDependency -> SolvedDependency
max :: SolvedDependency -> SolvedDependency -> SolvedDependency
$cmax :: SolvedDependency -> SolvedDependency -> SolvedDependency
>= :: SolvedDependency -> SolvedDependency -> Bool
$c>= :: SolvedDependency -> SolvedDependency -> Bool
> :: SolvedDependency -> SolvedDependency -> Bool
$c> :: SolvedDependency -> SolvedDependency -> Bool
<= :: SolvedDependency -> SolvedDependency -> Bool
$c<= :: SolvedDependency -> SolvedDependency -> Bool
< :: SolvedDependency -> SolvedDependency -> Bool
$c< :: SolvedDependency -> SolvedDependency -> Bool
compare :: SolvedDependency -> SolvedDependency -> Ordering
$ccompare :: SolvedDependency -> SolvedDependency -> Ordering
Ord, forall x. Rep SolvedDependency x -> SolvedDependency
forall x. SolvedDependency -> Rep SolvedDependency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SolvedDependency x -> SolvedDependency
$cfrom :: forall x. SolvedDependency -> Rep SolvedDependency x
Generic)
  deriving anyclass (SolvedDependency -> ()
forall a. (a -> ()) -> NFData a
rnf :: SolvedDependency -> ()
$crnf :: SolvedDependency -> ()
NFData)

-- | A solved package collected from dgraph. This data type is not designed to be recursively,
-- thus the element type of '_pkgDeps' is 'SolvedDependency', rather than another 'SolvedPackage'.
data SolvedPackage
  = -- | A package which has been provided by somebody, so there is no need to expand its dependencies
    ProvidedPackage
      { -- | Package name
        SolvedPackage -> PackageName
_pkgName :: PackageName,
        -- | Package provider. (The name of 'DependencyProvider' may be confusing...)
        SolvedPackage -> DependencyProvider
_pkgProvider :: DependencyProvider
      }
  | -- | A package with its dependencies
    SolvedPackage
      { -- | Package name
        _pkgName :: PackageName,
        -- | Package dependencies
        SolvedPackage -> [SolvedDependency]
_pkgDeps :: [SolvedDependency]
      }
  deriving stock (Int -> SolvedPackage -> ShowS
[SolvedPackage] -> ShowS
SolvedPackage -> ArchLinuxVersion
forall a.
(Int -> a -> ShowS)
-> (a -> ArchLinuxVersion) -> ([a] -> ShowS) -> Show a
showList :: [SolvedPackage] -> ShowS
$cshowList :: [SolvedPackage] -> ShowS
show :: SolvedPackage -> ArchLinuxVersion
$cshow :: SolvedPackage -> ArchLinuxVersion
showsPrec :: Int -> SolvedPackage -> ShowS
$cshowsPrec :: Int -> SolvedPackage -> ShowS
Show, SolvedPackage -> SolvedPackage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolvedPackage -> SolvedPackage -> Bool
$c/= :: SolvedPackage -> SolvedPackage -> Bool
== :: SolvedPackage -> SolvedPackage -> Bool
$c== :: SolvedPackage -> SolvedPackage -> Bool
Eq, Eq SolvedPackage
SolvedPackage -> SolvedPackage -> Bool
SolvedPackage -> SolvedPackage -> Ordering
SolvedPackage -> SolvedPackage -> SolvedPackage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SolvedPackage -> SolvedPackage -> SolvedPackage
$cmin :: SolvedPackage -> SolvedPackage -> SolvedPackage
max :: SolvedPackage -> SolvedPackage -> SolvedPackage
$cmax :: SolvedPackage -> SolvedPackage -> SolvedPackage
>= :: SolvedPackage -> SolvedPackage -> Bool
$c>= :: SolvedPackage -> SolvedPackage -> Bool
> :: SolvedPackage -> SolvedPackage -> Bool
$c> :: SolvedPackage -> SolvedPackage -> Bool
<= :: SolvedPackage -> SolvedPackage -> Bool
$c<= :: SolvedPackage -> SolvedPackage -> Bool
< :: SolvedPackage -> SolvedPackage -> Bool
$c< :: SolvedPackage -> SolvedPackage -> Bool
compare :: SolvedPackage -> SolvedPackage -> Ordering
$ccompare :: SolvedPackage -> SolvedPackage -> Ordering
Ord, forall x. Rep SolvedPackage x -> SolvedPackage
forall x. SolvedPackage -> Rep SolvedPackage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SolvedPackage x -> SolvedPackage
$cfrom :: forall x. SolvedPackage -> Rep SolvedPackage x
Generic)
  deriving anyclass (SolvedPackage -> ()
forall a. (a -> ()) -> NFData a
rnf :: SolvedPackage -> ()
$crnf :: SolvedPackage -> ()
NFData)

makeLenses ''SolvedDependency
makeLenses ''SolvedPackage