module Hix.Data.Bounds where

import Data.Aeson (FromJSON (parseJSON), ToJSON)
import Distribution.Pretty (Pretty (pretty))
import Distribution.Version (Version, VersionRange)
import GHC.Exts (IsList)

import Hix.Class.EncodeNix (EncodeNix)
import Hix.Class.Map (LookupMaybe, NMap, nPretty)
import Hix.Data.Json (jsonParsec)
import Hix.Data.PackageName (PackageName)
import Hix.Data.VersionBounds (VersionBounds)

newtype Bounds =
  Bounds (Map PackageName VersionBounds)
  deriving stock (Bounds -> Bounds -> Bool
(Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool) -> Eq Bounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bounds -> Bounds -> Bool
== :: Bounds -> Bounds -> Bool
$c/= :: Bounds -> Bounds -> Bool
/= :: Bounds -> Bounds -> Bool
Eq, Int -> Bounds -> ShowS
[Bounds] -> ShowS
Bounds -> String
(Int -> Bounds -> ShowS)
-> (Bounds -> String) -> ([Bounds] -> ShowS) -> Show Bounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bounds -> ShowS
showsPrec :: Int -> Bounds -> ShowS
$cshow :: Bounds -> String
show :: Bounds -> String
$cshowList :: [Bounds] -> ShowS
showList :: [Bounds] -> ShowS
Show, (forall x. Bounds -> Rep Bounds x)
-> (forall x. Rep Bounds x -> Bounds) -> Generic Bounds
forall x. Rep Bounds x -> Bounds
forall x. Bounds -> Rep Bounds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bounds -> Rep Bounds x
from :: forall x. Bounds -> Rep Bounds x
$cto :: forall x. Rep Bounds x -> Bounds
to :: forall x. Rep Bounds x -> Bounds
Generic)
  deriving newtype (NonEmpty Bounds -> Bounds
Bounds -> Bounds -> Bounds
(Bounds -> Bounds -> Bounds)
-> (NonEmpty Bounds -> Bounds)
-> (forall b. Integral b => b -> Bounds -> Bounds)
-> Semigroup Bounds
forall b. Integral b => b -> Bounds -> Bounds
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Bounds -> Bounds -> Bounds
<> :: Bounds -> Bounds -> Bounds
$csconcat :: NonEmpty Bounds -> Bounds
sconcat :: NonEmpty Bounds -> Bounds
$cstimes :: forall b. Integral b => b -> Bounds -> Bounds
stimes :: forall b. Integral b => b -> Bounds -> Bounds
Semigroup, Semigroup Bounds
Bounds
Semigroup Bounds =>
Bounds
-> (Bounds -> Bounds -> Bounds)
-> ([Bounds] -> Bounds)
-> Monoid Bounds
[Bounds] -> Bounds
Bounds -> Bounds -> Bounds
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Bounds
mempty :: Bounds
$cmappend :: Bounds -> Bounds -> Bounds
mappend :: Bounds -> Bounds -> Bounds
$cmconcat :: [Bounds] -> Bounds
mconcat :: [Bounds] -> Bounds
Monoid, Int -> [Item Bounds] -> Bounds
[Item Bounds] -> Bounds
Bounds -> [Item Bounds]
([Item Bounds] -> Bounds)
-> (Int -> [Item Bounds] -> Bounds)
-> (Bounds -> [Item Bounds])
-> IsList Bounds
forall l.
([Item l] -> l)
-> (Int -> [Item l] -> l) -> (l -> [Item l]) -> IsList l
$cfromList :: [Item Bounds] -> Bounds
fromList :: [Item Bounds] -> Bounds
$cfromListN :: Int -> [Item Bounds] -> Bounds
fromListN :: Int -> [Item Bounds] -> Bounds
$ctoList :: Bounds -> [Item Bounds]
toList :: Bounds -> [Item Bounds]
IsList, Bounds -> Expr
(Bounds -> Expr) -> EncodeNix Bounds
forall a. (a -> Expr) -> EncodeNix a
$cencodeNix :: Bounds -> Expr
encodeNix :: Bounds -> Expr
EncodeNix, Maybe Bounds
Value -> Parser [Bounds]
Value -> Parser Bounds
(Value -> Parser Bounds)
-> (Value -> Parser [Bounds]) -> Maybe Bounds -> FromJSON Bounds
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Bounds
parseJSON :: Value -> Parser Bounds
$cparseJSONList :: Value -> Parser [Bounds]
parseJSONList :: Value -> Parser [Bounds]
$comittedField :: Maybe Bounds
omittedField :: Maybe Bounds
FromJSON, [Bounds] -> Value
[Bounds] -> Encoding
Bounds -> Bool
Bounds -> Value
Bounds -> Encoding
(Bounds -> Value)
-> (Bounds -> Encoding)
-> ([Bounds] -> Value)
-> ([Bounds] -> Encoding)
-> (Bounds -> Bool)
-> ToJSON Bounds
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Bounds -> Value
toJSON :: Bounds -> Value
$ctoEncoding :: Bounds -> Encoding
toEncoding :: Bounds -> Encoding
$ctoJSONList :: [Bounds] -> Value
toJSONList :: [Bounds] -> Value
$ctoEncodingList :: [Bounds] -> Encoding
toEncodingList :: [Bounds] -> Encoding
$comitField :: Bounds -> Bool
omitField :: Bounds -> Bool
ToJSON)

instance NMap Bounds PackageName VersionBounds LookupMaybe where

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

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

instance NMap Ranges PackageName VersionRange LookupMaybe where

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

instance FromJSON Ranges where
  parseJSON :: Value -> Parser Ranges
parseJSON Value
v =
    Map PackageName VersionRange -> Ranges
Ranges (Map PackageName VersionRange -> Ranges)
-> (Map PackageName (JsonParsec VersionRange)
    -> Map PackageName VersionRange)
-> Map PackageName (JsonParsec VersionRange)
-> Ranges
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JsonParsec VersionRange -> VersionRange)
-> Map PackageName (JsonParsec VersionRange)
-> Map PackageName VersionRange
forall a b. (a -> b) -> Map PackageName a -> Map PackageName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsonParsec VersionRange -> VersionRange
forall a. JsonParsec a -> a
jsonParsec (Map PackageName (JsonParsec VersionRange) -> Ranges)
-> Parser (Map PackageName (JsonParsec VersionRange))
-> Parser Ranges
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map PackageName (JsonParsec VersionRange))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

data BoundExtension =
  LowerBoundExtension Version
  |
  UpperBoundExtension Version
  deriving stock (BoundExtension -> BoundExtension -> Bool
(BoundExtension -> BoundExtension -> Bool)
-> (BoundExtension -> BoundExtension -> Bool) -> Eq BoundExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoundExtension -> BoundExtension -> Bool
== :: BoundExtension -> BoundExtension -> Bool
$c/= :: BoundExtension -> BoundExtension -> Bool
/= :: BoundExtension -> BoundExtension -> Bool
Eq, Int -> BoundExtension -> ShowS
[BoundExtension] -> ShowS
BoundExtension -> String
(Int -> BoundExtension -> ShowS)
-> (BoundExtension -> String)
-> ([BoundExtension] -> ShowS)
-> Show BoundExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoundExtension -> ShowS
showsPrec :: Int -> BoundExtension -> ShowS
$cshow :: BoundExtension -> String
show :: BoundExtension -> String
$cshowList :: [BoundExtension] -> ShowS
showList :: [BoundExtension] -> ShowS
Show, (forall x. BoundExtension -> Rep BoundExtension x)
-> (forall x. Rep BoundExtension x -> BoundExtension)
-> Generic BoundExtension
forall x. Rep BoundExtension x -> BoundExtension
forall x. BoundExtension -> Rep BoundExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BoundExtension -> Rep BoundExtension x
from :: forall x. BoundExtension -> Rep BoundExtension x
$cto :: forall x. Rep BoundExtension x -> BoundExtension
to :: forall x. Rep BoundExtension x -> BoundExtension
Generic)

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

instance NMap BoundExtensions PackageName BoundExtension LookupMaybe where