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

-- | Copyright: (c) 2020 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 (..),
    ArchLinuxVersion,
    CommunityDB,
    HackageEnv,
    CommunityEnv,
    FlagAssignmentsEnv,
    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 -> String
unArchLinuxName :: String
  }
  deriving stock (Int -> ArchLinuxName -> ShowS
[ArchLinuxName] -> ShowS
ArchLinuxName -> String
(Int -> ArchLinuxName -> ShowS)
-> (ArchLinuxName -> String)
-> ([ArchLinuxName] -> ShowS)
-> Show ArchLinuxName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArchLinuxName] -> ShowS
$cshowList :: [ArchLinuxName] -> ShowS
show :: ArchLinuxName -> String
$cshow :: ArchLinuxName -> String
showsPrec :: Int -> ArchLinuxName -> ShowS
$cshowsPrec :: Int -> ArchLinuxName -> ShowS
Show, ReadPrec [ArchLinuxName]
ReadPrec ArchLinuxName
Int -> ReadS ArchLinuxName
ReadS [ArchLinuxName]
(Int -> ReadS ArchLinuxName)
-> ReadS [ArchLinuxName]
-> ReadPrec ArchLinuxName
-> ReadPrec [ArchLinuxName]
-> Read 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
(ArchLinuxName -> ArchLinuxName -> Bool)
-> (ArchLinuxName -> ArchLinuxName -> Bool) -> Eq ArchLinuxName
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
Eq ArchLinuxName
-> (ArchLinuxName -> ArchLinuxName -> Ordering)
-> (ArchLinuxName -> ArchLinuxName -> Bool)
-> (ArchLinuxName -> ArchLinuxName -> Bool)
-> (ArchLinuxName -> ArchLinuxName -> Bool)
-> (ArchLinuxName -> ArchLinuxName -> Bool)
-> (ArchLinuxName -> ArchLinuxName -> ArchLinuxName)
-> (ArchLinuxName -> ArchLinuxName -> ArchLinuxName)
-> Ord 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
$cp1Ord :: Eq ArchLinuxName
Ord, (forall x. ArchLinuxName -> Rep ArchLinuxName x)
-> (forall x. Rep ArchLinuxName x -> ArchLinuxName)
-> Generic ArchLinuxName
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 -> ()
(ArchLinuxName -> ()) -> NFData 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 -> String
(Int -> SystemDependency -> ShowS)
-> (SystemDependency -> String)
-> ([SystemDependency] -> ShowS)
-> Show SystemDependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemDependency] -> ShowS
$cshowList :: [SystemDependency] -> ShowS
show :: SystemDependency -> String
$cshow :: SystemDependency -> String
showsPrec :: Int -> SystemDependency -> ShowS
$cshowsPrec :: Int -> SystemDependency -> ShowS
Show, ReadPrec [SystemDependency]
ReadPrec SystemDependency
Int -> ReadS SystemDependency
ReadS [SystemDependency]
(Int -> ReadS SystemDependency)
-> ReadS [SystemDependency]
-> ReadPrec SystemDependency
-> ReadPrec [SystemDependency]
-> Read 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
(SystemDependency -> SystemDependency -> Bool)
-> (SystemDependency -> SystemDependency -> Bool)
-> Eq SystemDependency
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
Eq SystemDependency
-> (SystemDependency -> SystemDependency -> Ordering)
-> (SystemDependency -> SystemDependency -> Bool)
-> (SystemDependency -> SystemDependency -> Bool)
-> (SystemDependency -> SystemDependency -> Bool)
-> (SystemDependency -> SystemDependency -> Bool)
-> (SystemDependency -> SystemDependency -> SystemDependency)
-> (SystemDependency -> SystemDependency -> SystemDependency)
-> Ord 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
$cp1Ord :: Eq SystemDependency
Ord, (forall x. SystemDependency -> Rep SystemDependency x)
-> (forall x. Rep SystemDependency x -> SystemDependency)
-> Generic SystemDependency
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 -> ()
(SystemDependency -> ()) -> NFData SystemDependency
forall a. (a -> ()) -> NFData a
rnf :: SystemDependency -> ()
$crnf :: SystemDependency -> ()
NFData)

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

-- | Representation of @cummunity.db@
type CommunityDB = Map ArchLinuxName ArchLinuxVersion

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

-- | Reader effect of 'CommunityDB'
type CommunityEnv = Reader CommunityDB

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

-- | 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
(DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> Bool) -> Eq DependencyType
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
Eq DependencyType
-> (DependencyType -> DependencyType -> Ordering)
-> (DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> DependencyType)
-> (DependencyType -> DependencyType -> DependencyType)
-> Ord 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
$cp1Ord :: Eq DependencyType
Ord, (forall x. DependencyType -> Rep DependencyType x)
-> (forall x. Rep DependencyType x -> DependencyType)
-> Generic DependencyType
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 -> ()
(DependencyType -> ()) -> NFData 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
(DependencyKind -> DependencyKind -> Bool)
-> (DependencyKind -> DependencyKind -> Bool) -> Eq DependencyKind
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 -> String
show (CExe UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: Exe"
  show (CExeBuildTools UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: ExeBuildTools"
  show (CTest UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: Test"
  show (CBenchmark UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: Benchmark"
  show (CTestBuildTools UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: TestBuildTools"
  show (CBenchmarkBuildTools UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: BenchmarkBuildTools"
  show (CSubLibs UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: SubLibs"
  show (CSubLibsBuildTools UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: SubLibsBuildTools"
  show DependencyType
CLib = String
"Lib"
  show DependencyType
CLibBuildTools = String
"LibBuildTools"
  show DependencyType
CSetup = String
"Setup"

-- | Provider of a dependency.
data DependencyProvider = ByCommunity | ByAur
  deriving stock (DependencyProvider -> DependencyProvider -> Bool
(DependencyProvider -> DependencyProvider -> Bool)
-> (DependencyProvider -> DependencyProvider -> Bool)
-> Eq DependencyProvider
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
Eq DependencyProvider
-> (DependencyProvider -> DependencyProvider -> Ordering)
-> (DependencyProvider -> DependencyProvider -> Bool)
-> (DependencyProvider -> DependencyProvider -> Bool)
-> (DependencyProvider -> DependencyProvider -> Bool)
-> (DependencyProvider -> DependencyProvider -> Bool)
-> (DependencyProvider -> DependencyProvider -> DependencyProvider)
-> (DependencyProvider -> DependencyProvider -> DependencyProvider)
-> Ord 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
$cp1Ord :: Eq DependencyProvider
Ord, (forall x. DependencyProvider -> Rep DependencyProvider x)
-> (forall x. Rep DependencyProvider x -> DependencyProvider)
-> Generic DependencyProvider
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 -> ()
(DependencyProvider -> ()) -> NFData DependencyProvider
forall a. (a -> ()) -> NFData a
rnf :: DependencyProvider -> ()
$crnf :: DependencyProvider -> ()
NFData)

instance Show DependencyProvider where
  show :: DependencyProvider -> String
show DependencyProvider
ByCommunity = String
"[community]"
  show DependencyProvider
ByAur = String
"[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 -> String
(Int -> SolvedDependency -> ShowS)
-> (SolvedDependency -> String)
-> ([SolvedDependency] -> ShowS)
-> Show SolvedDependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SolvedDependency] -> ShowS
$cshowList :: [SolvedDependency] -> ShowS
show :: SolvedDependency -> String
$cshow :: SolvedDependency -> String
showsPrec :: Int -> SolvedDependency -> ShowS
$cshowsPrec :: Int -> SolvedDependency -> ShowS
Show, SolvedDependency -> SolvedDependency -> Bool
(SolvedDependency -> SolvedDependency -> Bool)
-> (SolvedDependency -> SolvedDependency -> Bool)
-> Eq SolvedDependency
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
Eq SolvedDependency
-> (SolvedDependency -> SolvedDependency -> Ordering)
-> (SolvedDependency -> SolvedDependency -> Bool)
-> (SolvedDependency -> SolvedDependency -> Bool)
-> (SolvedDependency -> SolvedDependency -> Bool)
-> (SolvedDependency -> SolvedDependency -> Bool)
-> (SolvedDependency -> SolvedDependency -> SolvedDependency)
-> (SolvedDependency -> SolvedDependency -> SolvedDependency)
-> Ord 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
$cp1Ord :: Eq SolvedDependency
Ord, (forall x. SolvedDependency -> Rep SolvedDependency x)
-> (forall x. Rep SolvedDependency x -> SolvedDependency)
-> Generic SolvedDependency
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 -> ()
(SolvedDependency -> ()) -> NFData 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 -> String
(Int -> SolvedPackage -> ShowS)
-> (SolvedPackage -> String)
-> ([SolvedPackage] -> ShowS)
-> Show SolvedPackage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SolvedPackage] -> ShowS
$cshowList :: [SolvedPackage] -> ShowS
show :: SolvedPackage -> String
$cshow :: SolvedPackage -> String
showsPrec :: Int -> SolvedPackage -> ShowS
$cshowsPrec :: Int -> SolvedPackage -> ShowS
Show, SolvedPackage -> SolvedPackage -> Bool
(SolvedPackage -> SolvedPackage -> Bool)
-> (SolvedPackage -> SolvedPackage -> Bool) -> Eq SolvedPackage
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
Eq SolvedPackage
-> (SolvedPackage -> SolvedPackage -> Ordering)
-> (SolvedPackage -> SolvedPackage -> Bool)
-> (SolvedPackage -> SolvedPackage -> Bool)
-> (SolvedPackage -> SolvedPackage -> Bool)
-> (SolvedPackage -> SolvedPackage -> Bool)
-> (SolvedPackage -> SolvedPackage -> SolvedPackage)
-> (SolvedPackage -> SolvedPackage -> SolvedPackage)
-> Ord 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
$cp1Ord :: Eq SolvedPackage
Ord, (forall x. SolvedPackage -> Rep SolvedPackage x)
-> (forall x. Rep SolvedPackage x -> SolvedPackage)
-> Generic SolvedPackage
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 -> ()
(SolvedPackage -> ()) -> NFData SolvedPackage
forall a. (a -> ()) -> NFData a
rnf :: SolvedPackage -> ()
$crnf :: SolvedPackage -> ()
NFData)

makeLenses ''SolvedDependency
makeLenses ''SolvedPackage