module Hix.Data.Version (
  module Hix.Data.Version,
  Version,
  VersionRange,
) where

import Data.Aeson (FromJSON (parseJSON))
import Data.Generics.Labels ()
import qualified Data.List.NonEmpty as NonEmpty
import Distribution.Pretty (Pretty (pretty))
import Distribution.Version (Version, VersionRange, anyVersion)
import Exon (exon)
import GHC.Exts (IsList)
import Text.PrettyPrint (Doc)

import Hix.Class.EncodeNix (EncodeNix)
import Hix.Class.Map (LookupMaybe, NMap, nGenWith, nPretty)
import Hix.Data.Json (jsonParsec)
import qualified Hix.Data.PackageId
import Hix.Data.PackageId (PackageId (PackageId))
import Hix.Data.PackageName (PackageName)
import Hix.Orphans.Version ()
import Hix.Pretty (prettyText)

range0 :: VersionRange
range0 :: VersionRange
range0 = VersionRange
anyVersion

newtype SourceHash =
  SourceHash Text
  deriving stock (SourceHash -> SourceHash -> Bool
(SourceHash -> SourceHash -> Bool)
-> (SourceHash -> SourceHash -> Bool) -> Eq SourceHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceHash -> SourceHash -> Bool
== :: SourceHash -> SourceHash -> Bool
$c/= :: SourceHash -> SourceHash -> Bool
/= :: SourceHash -> SourceHash -> Bool
Eq, Int -> SourceHash -> ShowS
[SourceHash] -> ShowS
SourceHash -> String
(Int -> SourceHash -> ShowS)
-> (SourceHash -> String)
-> ([SourceHash] -> ShowS)
-> Show SourceHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceHash -> ShowS
showsPrec :: Int -> SourceHash -> ShowS
$cshow :: SourceHash -> String
show :: SourceHash -> String
$cshowList :: [SourceHash] -> ShowS
showList :: [SourceHash] -> ShowS
Show, (forall x. SourceHash -> Rep SourceHash x)
-> (forall x. Rep SourceHash x -> SourceHash) -> Generic SourceHash
forall x. Rep SourceHash x -> SourceHash
forall x. SourceHash -> Rep SourceHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourceHash -> Rep SourceHash x
from :: forall x. SourceHash -> Rep SourceHash x
$cto :: forall x. Rep SourceHash x -> SourceHash
to :: forall x. Rep SourceHash x -> SourceHash
Generic)
  deriving newtype (Eq SourceHash
Eq SourceHash =>
(SourceHash -> SourceHash -> Ordering)
-> (SourceHash -> SourceHash -> Bool)
-> (SourceHash -> SourceHash -> Bool)
-> (SourceHash -> SourceHash -> Bool)
-> (SourceHash -> SourceHash -> Bool)
-> (SourceHash -> SourceHash -> SourceHash)
-> (SourceHash -> SourceHash -> SourceHash)
-> Ord SourceHash
SourceHash -> SourceHash -> Bool
SourceHash -> SourceHash -> Ordering
SourceHash -> SourceHash -> SourceHash
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
$ccompare :: SourceHash -> SourceHash -> Ordering
compare :: SourceHash -> SourceHash -> Ordering
$c< :: SourceHash -> SourceHash -> Bool
< :: SourceHash -> SourceHash -> Bool
$c<= :: SourceHash -> SourceHash -> Bool
<= :: SourceHash -> SourceHash -> Bool
$c> :: SourceHash -> SourceHash -> Bool
> :: SourceHash -> SourceHash -> Bool
$c>= :: SourceHash -> SourceHash -> Bool
>= :: SourceHash -> SourceHash -> Bool
$cmax :: SourceHash -> SourceHash -> SourceHash
max :: SourceHash -> SourceHash -> SourceHash
$cmin :: SourceHash -> SourceHash -> SourceHash
min :: SourceHash -> SourceHash -> SourceHash
Ord, Maybe SourceHash
Value -> Parser [SourceHash]
Value -> Parser SourceHash
(Value -> Parser SourceHash)
-> (Value -> Parser [SourceHash])
-> Maybe SourceHash
-> FromJSON SourceHash
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SourceHash
parseJSON :: Value -> Parser SourceHash
$cparseJSONList :: Value -> Parser [SourceHash]
parseJSONList :: Value -> Parser [SourceHash]
$comittedField :: Maybe SourceHash
omittedField :: Maybe SourceHash
FromJSON, SourceHash -> Expr
(SourceHash -> Expr) -> EncodeNix SourceHash
forall a. (a -> Expr) -> EncodeNix a
$cencodeNix :: SourceHash -> Expr
encodeNix :: SourceHash -> Expr
EncodeNix)

instance Pretty SourceHash where
  pretty :: SourceHash -> Doc
pretty (SourceHash Text
h) = Text -> Doc
prettyText Text
h

data Major =
  Major {
    Major -> Version
prefix :: Version,
    Major -> NonEmpty Version
versions :: NonEmpty Version
  }
  deriving stock (Major -> Major -> Bool
(Major -> Major -> Bool) -> (Major -> Major -> Bool) -> Eq Major
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Major -> Major -> Bool
== :: Major -> Major -> Bool
$c/= :: Major -> Major -> Bool
/= :: Major -> Major -> Bool
Eq, Int -> Major -> ShowS
[Major] -> ShowS
Major -> String
(Int -> Major -> ShowS)
-> (Major -> String) -> ([Major] -> ShowS) -> Show Major
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Major -> ShowS
showsPrec :: Int -> Major -> ShowS
$cshow :: Major -> String
show :: Major -> String
$cshowList :: [Major] -> ShowS
showList :: [Major] -> ShowS
Show, (forall x. Major -> Rep Major x)
-> (forall x. Rep Major x -> Major) -> Generic Major
forall x. Rep Major x -> Major
forall x. Major -> Rep Major x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Major -> Rep Major x
from :: forall x. Major -> Rep Major x
$cto :: forall x. Rep Major x -> Major
to :: forall x. Rep Major x -> Major
Generic)

prettyMajors :: NonEmpty Major -> Doc
prettyMajors :: NonEmpty Major -> Doc
prettyMajors = \case
  [Major {Version
prefix :: Major -> Version
prefix :: Version
prefix}] -> Version -> Doc
forall a. Pretty a => a -> Doc
pretty Version
prefix Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
".*"
  NonEmpty Major
majors -> [exon|#{pretty (NonEmpty.head majors).prefix}–#{pretty (NonEmpty.last majors).prefix}|]

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

instance NMap Versions PackageName Version LookupMaybe where

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

instance FromJSON Versions where
  parseJSON :: Value -> Parser Versions
parseJSON Value
v =
    Map PackageName Version -> Versions
Versions (Map PackageName Version -> Versions)
-> (Map PackageName (JsonParsec Version)
    -> Map PackageName Version)
-> Map PackageName (JsonParsec Version)
-> Versions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JsonParsec Version -> Version)
-> Map PackageName (JsonParsec Version) -> Map PackageName Version
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 Version -> Version
forall a. JsonParsec a -> a
jsonParsec (Map PackageName (JsonParsec Version) -> Versions)
-> Parser (Map PackageName (JsonParsec Version)) -> Parser Versions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map PackageName (JsonParsec Version))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

packageIdVersions :: [PackageId] -> Versions
packageIdVersions :: [PackageId] -> Versions
packageIdVersions =
  (PackageId -> (PackageName, Version)) -> [PackageId] -> Versions
forall (t :: * -> *) map k v sort a.
(Foldable t, NMap map k v sort) =>
(a -> (k, v)) -> t a -> map
nGenWith \ PackageId {PackageName
name :: PackageName
name :: PackageId -> PackageName
name, Version
version :: Version
version :: PackageId -> Version
version} -> (PackageName
name, Version
version)