module Hix.Managed.Cabal.Data.SourcePackage where

import Distribution.PackageDescription (PackageDescription)
import Distribution.Pretty (Pretty (pretty))
import Distribution.Simple (Version)
import GHC.Exts (IsList)

import Hix.Class.Map (LookupMaybe, LookupMonoid, NMap, nPretty, nPretty1, nPrettyWith)
import Hix.Data.Dep (Dep)
import Hix.Data.PackageName (PackageName)
import Hix.Pretty (prettyL)

data SourcePackageId =
  SourcePackageId {
    SourcePackageId -> [Dep]
deps :: [Dep],
    SourcePackageId -> Maybe PackageDescription
description :: Maybe PackageDescription
  }
  deriving stock (SourcePackageId -> SourcePackageId -> Bool
(SourcePackageId -> SourcePackageId -> Bool)
-> (SourcePackageId -> SourcePackageId -> Bool)
-> Eq SourcePackageId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourcePackageId -> SourcePackageId -> Bool
== :: SourcePackageId -> SourcePackageId -> Bool
$c/= :: SourcePackageId -> SourcePackageId -> Bool
/= :: SourcePackageId -> SourcePackageId -> Bool
Eq, Int -> SourcePackageId -> ShowS
[SourcePackageId] -> ShowS
SourcePackageId -> String
(Int -> SourcePackageId -> ShowS)
-> (SourcePackageId -> String)
-> ([SourcePackageId] -> ShowS)
-> Show SourcePackageId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourcePackageId -> ShowS
showsPrec :: Int -> SourcePackageId -> ShowS
$cshow :: SourcePackageId -> String
show :: SourcePackageId -> String
$cshowList :: [SourcePackageId] -> ShowS
showList :: [SourcePackageId] -> ShowS
Show, (forall x. SourcePackageId -> Rep SourcePackageId x)
-> (forall x. Rep SourcePackageId x -> SourcePackageId)
-> Generic SourcePackageId
forall x. Rep SourcePackageId x -> SourcePackageId
forall x. SourcePackageId -> Rep SourcePackageId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourcePackageId -> Rep SourcePackageId x
from :: forall x. SourcePackageId -> Rep SourcePackageId x
$cto :: forall x. Rep SourcePackageId x -> SourcePackageId
to :: forall x. Rep SourcePackageId x -> SourcePackageId
Generic)

instance Pretty SourcePackageId where
  pretty :: SourcePackageId -> Doc
pretty SourcePackageId {[Dep]
deps :: SourcePackageId -> [Dep]
deps :: [Dep]
deps} = [Dep] -> Doc
forall (t :: * -> *) a. (Pretty a, Foldable t) => t a -> Doc
prettyL [Dep]
deps

newtype SourcePackage =
  SourcePackage (Map Version SourcePackageId)
  deriving stock (SourcePackage -> SourcePackage -> Bool
(SourcePackage -> SourcePackage -> Bool)
-> (SourcePackage -> SourcePackage -> Bool) -> Eq SourcePackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourcePackage -> SourcePackage -> Bool
== :: SourcePackage -> SourcePackage -> Bool
$c/= :: SourcePackage -> SourcePackage -> Bool
/= :: SourcePackage -> SourcePackage -> Bool
Eq, Int -> SourcePackage -> ShowS
[SourcePackage] -> ShowS
SourcePackage -> String
(Int -> SourcePackage -> ShowS)
-> (SourcePackage -> String)
-> ([SourcePackage] -> ShowS)
-> Show SourcePackage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourcePackage -> ShowS
showsPrec :: Int -> SourcePackage -> ShowS
$cshow :: SourcePackage -> String
show :: SourcePackage -> String
$cshowList :: [SourcePackage] -> ShowS
showList :: [SourcePackage] -> ShowS
Show, (forall x. SourcePackage -> Rep SourcePackage x)
-> (forall x. Rep SourcePackage x -> SourcePackage)
-> Generic SourcePackage
forall x. Rep SourcePackage x -> SourcePackage
forall x. SourcePackage -> Rep SourcePackage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourcePackage -> Rep SourcePackage x
from :: forall x. SourcePackage -> Rep SourcePackage x
$cto :: forall x. Rep SourcePackage x -> SourcePackage
to :: forall x. Rep SourcePackage x -> SourcePackage
Generic)
  deriving newtype (NonEmpty SourcePackage -> SourcePackage
SourcePackage -> SourcePackage -> SourcePackage
(SourcePackage -> SourcePackage -> SourcePackage)
-> (NonEmpty SourcePackage -> SourcePackage)
-> (forall b. Integral b => b -> SourcePackage -> SourcePackage)
-> Semigroup SourcePackage
forall b. Integral b => b -> SourcePackage -> SourcePackage
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SourcePackage -> SourcePackage -> SourcePackage
<> :: SourcePackage -> SourcePackage -> SourcePackage
$csconcat :: NonEmpty SourcePackage -> SourcePackage
sconcat :: NonEmpty SourcePackage -> SourcePackage
$cstimes :: forall b. Integral b => b -> SourcePackage -> SourcePackage
stimes :: forall b. Integral b => b -> SourcePackage -> SourcePackage
Semigroup, Semigroup SourcePackage
SourcePackage
Semigroup SourcePackage =>
SourcePackage
-> (SourcePackage -> SourcePackage -> SourcePackage)
-> ([SourcePackage] -> SourcePackage)
-> Monoid SourcePackage
[SourcePackage] -> SourcePackage
SourcePackage -> SourcePackage -> SourcePackage
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: SourcePackage
mempty :: SourcePackage
$cmappend :: SourcePackage -> SourcePackage -> SourcePackage
mappend :: SourcePackage -> SourcePackage -> SourcePackage
$cmconcat :: [SourcePackage] -> SourcePackage
mconcat :: [SourcePackage] -> SourcePackage
Monoid, Int -> [Item SourcePackage] -> SourcePackage
[Item SourcePackage] -> SourcePackage
SourcePackage -> [Item SourcePackage]
([Item SourcePackage] -> SourcePackage)
-> (Int -> [Item SourcePackage] -> SourcePackage)
-> (SourcePackage -> [Item SourcePackage])
-> IsList SourcePackage
forall l.
([Item l] -> l)
-> (Int -> [Item l] -> l) -> (l -> [Item l]) -> IsList l
$cfromList :: [Item SourcePackage] -> SourcePackage
fromList :: [Item SourcePackage] -> SourcePackage
$cfromListN :: Int -> [Item SourcePackage] -> SourcePackage
fromListN :: Int -> [Item SourcePackage] -> SourcePackage
$ctoList :: SourcePackage -> [Item SourcePackage]
toList :: SourcePackage -> [Item SourcePackage]
IsList)

instance NMap SourcePackage Version SourcePackageId LookupMonoid where

instance Pretty SourcePackage where
  pretty :: SourcePackage -> Doc
pretty = SourcePackage -> Doc
forall k v map sort.
(Pretty k, Pretty v, NMap map k v sort) =>
map -> Doc
nPretty

newtype SourcePackages =
  SourcePackages (Map PackageName SourcePackage)
  deriving stock (SourcePackages -> SourcePackages -> Bool
(SourcePackages -> SourcePackages -> Bool)
-> (SourcePackages -> SourcePackages -> Bool) -> Eq SourcePackages
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourcePackages -> SourcePackages -> Bool
== :: SourcePackages -> SourcePackages -> Bool
$c/= :: SourcePackages -> SourcePackages -> Bool
/= :: SourcePackages -> SourcePackages -> Bool
Eq, Int -> SourcePackages -> ShowS
[SourcePackages] -> ShowS
SourcePackages -> String
(Int -> SourcePackages -> ShowS)
-> (SourcePackages -> String)
-> ([SourcePackages] -> ShowS)
-> Show SourcePackages
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourcePackages -> ShowS
showsPrec :: Int -> SourcePackages -> ShowS
$cshow :: SourcePackages -> String
show :: SourcePackages -> String
$cshowList :: [SourcePackages] -> ShowS
showList :: [SourcePackages] -> ShowS
Show, (forall x. SourcePackages -> Rep SourcePackages x)
-> (forall x. Rep SourcePackages x -> SourcePackages)
-> Generic SourcePackages
forall x. Rep SourcePackages x -> SourcePackages
forall x. SourcePackages -> Rep SourcePackages x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourcePackages -> Rep SourcePackages x
from :: forall x. SourcePackages -> Rep SourcePackages x
$cto :: forall x. Rep SourcePackages x -> SourcePackages
to :: forall x. Rep SourcePackages x -> SourcePackages
Generic)
  deriving newtype (NonEmpty SourcePackages -> SourcePackages
SourcePackages -> SourcePackages -> SourcePackages
(SourcePackages -> SourcePackages -> SourcePackages)
-> (NonEmpty SourcePackages -> SourcePackages)
-> (forall b. Integral b => b -> SourcePackages -> SourcePackages)
-> Semigroup SourcePackages
forall b. Integral b => b -> SourcePackages -> SourcePackages
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SourcePackages -> SourcePackages -> SourcePackages
<> :: SourcePackages -> SourcePackages -> SourcePackages
$csconcat :: NonEmpty SourcePackages -> SourcePackages
sconcat :: NonEmpty SourcePackages -> SourcePackages
$cstimes :: forall b. Integral b => b -> SourcePackages -> SourcePackages
stimes :: forall b. Integral b => b -> SourcePackages -> SourcePackages
Semigroup, Semigroup SourcePackages
SourcePackages
Semigroup SourcePackages =>
SourcePackages
-> (SourcePackages -> SourcePackages -> SourcePackages)
-> ([SourcePackages] -> SourcePackages)
-> Monoid SourcePackages
[SourcePackages] -> SourcePackages
SourcePackages -> SourcePackages -> SourcePackages
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: SourcePackages
mempty :: SourcePackages
$cmappend :: SourcePackages -> SourcePackages -> SourcePackages
mappend :: SourcePackages -> SourcePackages -> SourcePackages
$cmconcat :: [SourcePackages] -> SourcePackages
mconcat :: [SourcePackages] -> SourcePackages
Monoid, Int -> [Item SourcePackages] -> SourcePackages
[Item SourcePackages] -> SourcePackages
SourcePackages -> [Item SourcePackages]
([Item SourcePackages] -> SourcePackages)
-> (Int -> [Item SourcePackages] -> SourcePackages)
-> (SourcePackages -> [Item SourcePackages])
-> IsList SourcePackages
forall l.
([Item l] -> l)
-> (Int -> [Item l] -> l) -> (l -> [Item l]) -> IsList l
$cfromList :: [Item SourcePackages] -> SourcePackages
fromList :: [Item SourcePackages] -> SourcePackages
$cfromListN :: Int -> [Item SourcePackages] -> SourcePackages
fromListN :: Int -> [Item SourcePackages] -> SourcePackages
$ctoList :: SourcePackages -> [Item SourcePackages]
toList :: SourcePackages -> [Item SourcePackages]
IsList)

instance NMap SourcePackages PackageName SourcePackage LookupMaybe where

instance Pretty SourcePackages where
  pretty :: SourcePackages -> Doc
pretty = SourcePackages -> Doc
forall k v map sort.
(Pretty k, Pretty v, NMap map k v sort) =>
map -> Doc
nPretty1

newtype SourcePackageVersions =
  SourcePackageVersions (Map PackageName [Version])
  deriving stock (SourcePackageVersions -> SourcePackageVersions -> Bool
(SourcePackageVersions -> SourcePackageVersions -> Bool)
-> (SourcePackageVersions -> SourcePackageVersions -> Bool)
-> Eq SourcePackageVersions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourcePackageVersions -> SourcePackageVersions -> Bool
== :: SourcePackageVersions -> SourcePackageVersions -> Bool
$c/= :: SourcePackageVersions -> SourcePackageVersions -> Bool
/= :: SourcePackageVersions -> SourcePackageVersions -> Bool
Eq, Int -> SourcePackageVersions -> ShowS
[SourcePackageVersions] -> ShowS
SourcePackageVersions -> String
(Int -> SourcePackageVersions -> ShowS)
-> (SourcePackageVersions -> String)
-> ([SourcePackageVersions] -> ShowS)
-> Show SourcePackageVersions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourcePackageVersions -> ShowS
showsPrec :: Int -> SourcePackageVersions -> ShowS
$cshow :: SourcePackageVersions -> String
show :: SourcePackageVersions -> String
$cshowList :: [SourcePackageVersions] -> ShowS
showList :: [SourcePackageVersions] -> ShowS
Show, (forall x. SourcePackageVersions -> Rep SourcePackageVersions x)
-> (forall x. Rep SourcePackageVersions x -> SourcePackageVersions)
-> Generic SourcePackageVersions
forall x. Rep SourcePackageVersions x -> SourcePackageVersions
forall x. SourcePackageVersions -> Rep SourcePackageVersions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourcePackageVersions -> Rep SourcePackageVersions x
from :: forall x. SourcePackageVersions -> Rep SourcePackageVersions x
$cto :: forall x. Rep SourcePackageVersions x -> SourcePackageVersions
to :: forall x. Rep SourcePackageVersions x -> SourcePackageVersions
Generic)
  deriving newtype (NonEmpty SourcePackageVersions -> SourcePackageVersions
SourcePackageVersions
-> SourcePackageVersions -> SourcePackageVersions
(SourcePackageVersions
 -> SourcePackageVersions -> SourcePackageVersions)
-> (NonEmpty SourcePackageVersions -> SourcePackageVersions)
-> (forall b.
    Integral b =>
    b -> SourcePackageVersions -> SourcePackageVersions)
-> Semigroup SourcePackageVersions
forall b.
Integral b =>
b -> SourcePackageVersions -> SourcePackageVersions
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SourcePackageVersions
-> SourcePackageVersions -> SourcePackageVersions
<> :: SourcePackageVersions
-> SourcePackageVersions -> SourcePackageVersions
$csconcat :: NonEmpty SourcePackageVersions -> SourcePackageVersions
sconcat :: NonEmpty SourcePackageVersions -> SourcePackageVersions
$cstimes :: forall b.
Integral b =>
b -> SourcePackageVersions -> SourcePackageVersions
stimes :: forall b.
Integral b =>
b -> SourcePackageVersions -> SourcePackageVersions
Semigroup, Semigroup SourcePackageVersions
SourcePackageVersions
Semigroup SourcePackageVersions =>
SourcePackageVersions
-> (SourcePackageVersions
    -> SourcePackageVersions -> SourcePackageVersions)
-> ([SourcePackageVersions] -> SourcePackageVersions)
-> Monoid SourcePackageVersions
[SourcePackageVersions] -> SourcePackageVersions
SourcePackageVersions
-> SourcePackageVersions -> SourcePackageVersions
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: SourcePackageVersions
mempty :: SourcePackageVersions
$cmappend :: SourcePackageVersions
-> SourcePackageVersions -> SourcePackageVersions
mappend :: SourcePackageVersions
-> SourcePackageVersions -> SourcePackageVersions
$cmconcat :: [SourcePackageVersions] -> SourcePackageVersions
mconcat :: [SourcePackageVersions] -> SourcePackageVersions
Monoid, Int -> [Item SourcePackageVersions] -> SourcePackageVersions
[Item SourcePackageVersions] -> SourcePackageVersions
SourcePackageVersions -> [Item SourcePackageVersions]
([Item SourcePackageVersions] -> SourcePackageVersions)
-> (Int -> [Item SourcePackageVersions] -> SourcePackageVersions)
-> (SourcePackageVersions -> [Item SourcePackageVersions])
-> IsList SourcePackageVersions
forall l.
([Item l] -> l)
-> (Int -> [Item l] -> l) -> (l -> [Item l]) -> IsList l
$cfromList :: [Item SourcePackageVersions] -> SourcePackageVersions
fromList :: [Item SourcePackageVersions] -> SourcePackageVersions
$cfromListN :: Int -> [Item SourcePackageVersions] -> SourcePackageVersions
fromListN :: Int -> [Item SourcePackageVersions] -> SourcePackageVersions
$ctoList :: SourcePackageVersions -> [Item SourcePackageVersions]
toList :: SourcePackageVersions -> [Item SourcePackageVersions]
IsList)

instance NMap SourcePackageVersions PackageName [Version] LookupMaybe where

instance Pretty SourcePackageVersions where
  pretty :: SourcePackageVersions -> Doc
pretty = ([Version] -> Doc) -> SourcePackageVersions -> Doc
forall k map v sort.
(Pretty k, NMap map k v sort) =>
(v -> Doc) -> map -> Doc
nPrettyWith [Version] -> Doc
forall (t :: * -> *) a. (Pretty a, Foldable t) => t a -> Doc
prettyL