module Hix.Managed.Data.MutationState where

import Data.Map.Merge.Strict (dropMissing, mapMaybeMissing, zipWithMatched)
import Distribution.Pretty (Pretty (pretty))
import GHC.Generics (Generically (Generically))
import Text.PrettyPrint (hang, ($+$))

import Hix.Class.Map (nMerge)
import Hix.Data.Overrides (Overrides)
import Hix.Data.Version (Version)
import Hix.Data.VersionBounds (VersionBounds)
import Hix.Managed.Data.Mutable (MutableBounds, MutableVersions)

data MutationState =
  MutationState {
    MutationState -> MutableBounds
bounds :: MutableBounds,
    MutationState -> MutableVersions
versions :: MutableVersions,
    MutationState -> Overrides
overrides :: Overrides,
    MutationState -> MutableVersions
initial :: MutableVersions
  }
  deriving stock (MutationState -> MutationState -> Bool
(MutationState -> MutationState -> Bool)
-> (MutationState -> MutationState -> Bool) -> Eq MutationState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MutationState -> MutationState -> Bool
== :: MutationState -> MutationState -> Bool
$c/= :: MutationState -> MutationState -> Bool
/= :: MutationState -> MutationState -> Bool
Eq, Int -> MutationState -> ShowS
[MutationState] -> ShowS
MutationState -> String
(Int -> MutationState -> ShowS)
-> (MutationState -> String)
-> ([MutationState] -> ShowS)
-> Show MutationState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MutationState -> ShowS
showsPrec :: Int -> MutationState -> ShowS
$cshow :: MutationState -> String
show :: MutationState -> String
$cshowList :: [MutationState] -> ShowS
showList :: [MutationState] -> ShowS
Show, (forall x. MutationState -> Rep MutationState x)
-> (forall x. Rep MutationState x -> MutationState)
-> Generic MutationState
forall x. Rep MutationState x -> MutationState
forall x. MutationState -> Rep MutationState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MutationState -> Rep MutationState x
from :: forall x. MutationState -> Rep MutationState x
$cto :: forall x. Rep MutationState x -> MutationState
to :: forall x. Rep MutationState x -> MutationState
Generic)
  deriving (NonEmpty MutationState -> MutationState
MutationState -> MutationState -> MutationState
(MutationState -> MutationState -> MutationState)
-> (NonEmpty MutationState -> MutationState)
-> (forall b. Integral b => b -> MutationState -> MutationState)
-> Semigroup MutationState
forall b. Integral b => b -> MutationState -> MutationState
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: MutationState -> MutationState -> MutationState
<> :: MutationState -> MutationState -> MutationState
$csconcat :: NonEmpty MutationState -> MutationState
sconcat :: NonEmpty MutationState -> MutationState
$cstimes :: forall b. Integral b => b -> MutationState -> MutationState
stimes :: forall b. Integral b => b -> MutationState -> MutationState
Semigroup, Semigroup MutationState
MutationState
Semigroup MutationState =>
MutationState
-> (MutationState -> MutationState -> MutationState)
-> ([MutationState] -> MutationState)
-> Monoid MutationState
[MutationState] -> MutationState
MutationState -> MutationState -> MutationState
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: MutationState
mempty :: MutationState
$cmappend :: MutationState -> MutationState -> MutationState
mappend :: MutationState -> MutationState -> MutationState
$cmconcat :: [MutationState] -> MutationState
mconcat :: [MutationState] -> MutationState
Monoid) via (Generically MutationState)

instance Pretty MutationState where
  pretty :: MutationState -> Doc
pretty MutationState {Overrides
MutableBounds
MutableVersions
bounds :: MutationState -> MutableBounds
versions :: MutationState -> MutableVersions
overrides :: MutationState -> Overrides
initial :: MutationState -> MutableVersions
bounds :: MutableBounds
versions :: MutableVersions
overrides :: Overrides
initial :: MutableVersions
..} =
    Doc -> Int -> Doc -> Doc
hang Doc
"bounds:" Int
2 (MutableBounds -> Doc
forall a. Pretty a => a -> Doc
pretty MutableBounds
bounds) Doc -> Doc -> Doc
$+$
    Doc -> Int -> Doc -> Doc
hang Doc
"versions:" Int
2 (MutableVersions -> Doc
forall a. Pretty a => a -> Doc
pretty MutableVersions
versions) Doc -> Doc -> Doc
$+$
    Doc -> Int -> Doc -> Doc
hang Doc
"overrides:" Int
2 (Overrides -> Doc
forall a. Pretty a => a -> Doc
pretty Overrides
overrides) Doc -> Doc -> Doc
$+$
    Doc -> Int -> Doc -> Doc
hang Doc
"initial:" Int
2 (MutableVersions -> Doc
forall a. Pretty a => a -> Doc
pretty MutableVersions
initial)

updateBoundsWith :: (Version -> VersionBounds -> VersionBounds) -> MutationState -> MutationState
updateBoundsWith :: (Version -> VersionBounds -> VersionBounds)
-> MutationState -> MutationState
updateBoundsWith Version -> VersionBounds -> VersionBounds
update MutationState {MutableBounds
bounds :: MutationState -> MutableBounds
bounds :: MutableBounds
bounds, MutableVersions
versions :: MutationState -> MutableVersions
versions :: MutableVersions
versions, Overrides
MutableVersions
overrides :: MutationState -> Overrides
initial :: MutationState -> MutableVersions
overrides :: Overrides
initial :: MutableVersions
..} =
  MutationState {
    bounds :: MutableBounds
bounds = SimpleWhenMissing MutableDep (Maybe Version) VersionBounds
-> SimpleWhenMissing MutableDep VersionBounds VersionBounds
-> SimpleWhenMatched
     MutableDep (Maybe Version) VersionBounds VersionBounds
-> MutableVersions
-> MutableBounds
-> MutableBounds
forall map1 map2 map3 k v1 v2 v3 s1 s2 s3.
(NMap map1 k v1 s1, NMap map2 k v2 s2, NMap map3 k v3 s3) =>
SimpleWhenMissing k v1 v3
-> SimpleWhenMissing k v2 v3
-> SimpleWhenMatched k v1 v2 v3
-> map1
-> map2
-> map3
nMerge SimpleWhenMissing MutableDep (Maybe Version) VersionBounds
addBound SimpleWhenMissing MutableDep VersionBounds VersionBounds
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
dropMissing SimpleWhenMatched
  MutableDep (Maybe Version) VersionBounds VersionBounds
updateBound MutableVersions
versions MutableBounds
bounds,
    MutableVersions
versions :: MutableVersions
versions :: MutableVersions
versions,
    Overrides
MutableVersions
overrides :: Overrides
initial :: MutableVersions
overrides :: Overrides
initial :: MutableVersions
..
  }
  where
    addBound :: SimpleWhenMissing MutableDep (Maybe Version) VersionBounds
addBound = (MutableDep -> Maybe Version -> Maybe VersionBounds)
-> SimpleWhenMissing MutableDep (Maybe Version) VersionBounds
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> Maybe y) -> WhenMissing f k x y
mapMaybeMissing \ MutableDep
_ -> (Version -> VersionBounds) -> Maybe Version -> Maybe VersionBounds
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Version -> VersionBounds -> VersionBounds)
-> VersionBounds -> Version -> VersionBounds
forall a b c. (a -> b -> c) -> b -> a -> c
flip Version -> VersionBounds -> VersionBounds
update VersionBounds
forall a. Monoid a => a
mempty)
    updateBound :: SimpleWhenMatched
  MutableDep (Maybe Version) VersionBounds VersionBounds
updateBound = (MutableDep -> Maybe Version -> VersionBounds -> VersionBounds)
-> SimpleWhenMatched
     MutableDep (Maybe Version) VersionBounds VersionBounds
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched \ MutableDep
_ -> (VersionBounds -> VersionBounds)
-> (Version -> VersionBounds -> VersionBounds)
-> Maybe Version
-> VersionBounds
-> VersionBounds
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VersionBounds -> VersionBounds
forall a. a -> a
id Version -> VersionBounds -> VersionBounds
update