module Hix.Managed.Data.Mutation where

import Distribution.Pretty (Pretty (pretty))
import qualified Text.PrettyPrint as PrettyPrint
import Text.PrettyPrint (parens, (<+>))

import Hix.Data.PackageId (PackageId)
import Hix.Data.Version (Version)
import Hix.Data.VersionBounds (VersionBounds)
import Hix.Managed.Cabal.Data.SolverState (SolverState)
import Hix.Managed.Data.Mutable (MutableDep)
import Hix.Managed.Data.MutableId (MutableId)
import Hix.Managed.Data.MutationState (MutationState)
import Hix.Pretty (prettyText, showP)

data DepMutation a =
  DepMutation {
    forall a. DepMutation a -> MutableDep
package :: MutableDep,
    forall a. DepMutation a -> Bool
retract :: Bool,
    forall a. DepMutation a -> a
mutation :: a
  }
  deriving stock (DepMutation a -> DepMutation a -> Bool
(DepMutation a -> DepMutation a -> Bool)
-> (DepMutation a -> DepMutation a -> Bool) -> Eq (DepMutation a)
forall a. Eq a => DepMutation a -> DepMutation a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => DepMutation a -> DepMutation a -> Bool
== :: DepMutation a -> DepMutation a -> Bool
$c/= :: forall a. Eq a => DepMutation a -> DepMutation a -> Bool
/= :: DepMutation a -> DepMutation a -> Bool
Eq, Int -> DepMutation a -> ShowS
[DepMutation a] -> ShowS
DepMutation a -> String
(Int -> DepMutation a -> ShowS)
-> (DepMutation a -> String)
-> ([DepMutation a] -> ShowS)
-> Show (DepMutation a)
forall a. Show a => Int -> DepMutation a -> ShowS
forall a. Show a => [DepMutation a] -> ShowS
forall a. Show a => DepMutation a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> DepMutation a -> ShowS
showsPrec :: Int -> DepMutation a -> ShowS
$cshow :: forall a. Show a => DepMutation a -> String
show :: DepMutation a -> String
$cshowList :: forall a. Show a => [DepMutation a] -> ShowS
showList :: [DepMutation a] -> ShowS
Show, (forall x. DepMutation a -> Rep (DepMutation a) x)
-> (forall x. Rep (DepMutation a) x -> DepMutation a)
-> Generic (DepMutation a)
forall x. Rep (DepMutation a) x -> DepMutation a
forall x. DepMutation a -> Rep (DepMutation a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (DepMutation a) x -> DepMutation a
forall a x. DepMutation a -> Rep (DepMutation a) x
$cfrom :: forall a x. DepMutation a -> Rep (DepMutation a) x
from :: forall x. DepMutation a -> Rep (DepMutation a) x
$cto :: forall a x. Rep (DepMutation a) x -> DepMutation a
to :: forall x. Rep (DepMutation a) x -> DepMutation a
Generic)

instance Pretty a => Pretty (DepMutation a) where
  pretty :: DepMutation a -> Doc
pretty DepMutation {MutableDep
package :: forall a. DepMutation a -> MutableDep
package :: MutableDep
package, a
mutation :: forall a. DepMutation a -> a
mutation :: a
mutation, Bool
retract :: forall a. DepMutation a -> Bool
retract :: Bool
retract} =
    MutableDep -> Doc
forall a. Pretty a => a -> Doc
pretty MutableDep
package Doc -> Doc -> Doc
PrettyPrint.<> Doc
":" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
mutation Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
retext
    where
      retext :: Doc
retext | Bool
retract = Doc
"retract"
             | Bool
otherwise = Doc
"extend"

data BuildMutation =
  BuildMutation {
    BuildMutation -> Text
description :: Text,
    BuildMutation -> SolverState
solverState :: SolverState,
    BuildMutation -> Version -> VersionBounds -> VersionBounds
updateBound :: Version -> VersionBounds -> VersionBounds
  }
  deriving stock ((forall x. BuildMutation -> Rep BuildMutation x)
-> (forall x. Rep BuildMutation x -> BuildMutation)
-> Generic BuildMutation
forall x. Rep BuildMutation x -> BuildMutation
forall x. BuildMutation -> Rep BuildMutation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BuildMutation -> Rep BuildMutation x
from :: forall x. BuildMutation -> Rep BuildMutation x
$cto :: forall x. Rep BuildMutation x -> BuildMutation
to :: forall x. Rep BuildMutation x -> BuildMutation
Generic)

data MutationResult s =
  MutationSuccess {
    forall s. MutationResult s -> MutableId
candidate :: MutableId,
    forall s. MutationResult s -> Bool
changed :: Bool,
    forall s. MutationResult s -> MutationState
state :: MutationState,
    forall s. MutationResult s -> Set PackageId
revisions :: Set PackageId,
    forall s. MutationResult s -> s
ext :: s
  }
  |
  MutationKeep
  |
  MutationFailed
  deriving stock (MutationResult s -> MutationResult s -> Bool
(MutationResult s -> MutationResult s -> Bool)
-> (MutationResult s -> MutationResult s -> Bool)
-> Eq (MutationResult s)
forall s. Eq s => MutationResult s -> MutationResult s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall s. Eq s => MutationResult s -> MutationResult s -> Bool
== :: MutationResult s -> MutationResult s -> Bool
$c/= :: forall s. Eq s => MutationResult s -> MutationResult s -> Bool
/= :: MutationResult s -> MutationResult s -> Bool
Eq, Int -> MutationResult s -> ShowS
[MutationResult s] -> ShowS
MutationResult s -> String
(Int -> MutationResult s -> ShowS)
-> (MutationResult s -> String)
-> ([MutationResult s] -> ShowS)
-> Show (MutationResult s)
forall s. Show s => Int -> MutationResult s -> ShowS
forall s. Show s => [MutationResult s] -> ShowS
forall s. Show s => MutationResult s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Show s => Int -> MutationResult s -> ShowS
showsPrec :: Int -> MutationResult s -> ShowS
$cshow :: forall s. Show s => MutationResult s -> String
show :: MutationResult s -> String
$cshowList :: forall s. Show s => [MutationResult s] -> ShowS
showList :: [MutationResult s] -> ShowS
Show, (forall x. MutationResult s -> Rep (MutationResult s) x)
-> (forall x. Rep (MutationResult s) x -> MutationResult s)
-> Generic (MutationResult s)
forall x. Rep (MutationResult s) x -> MutationResult s
forall x. MutationResult s -> Rep (MutationResult s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s x. Rep (MutationResult s) x -> MutationResult s
forall s x. MutationResult s -> Rep (MutationResult s) x
$cfrom :: forall s x. MutationResult s -> Rep (MutationResult s) x
from :: forall x. MutationResult s -> Rep (MutationResult s) x
$cto :: forall s x. Rep (MutationResult s) x -> MutationResult s
to :: forall x. Rep (MutationResult s) x -> MutationResult s
Generic)

data FailedMutation =
  FailedMutation {
    FailedMutation -> MutableDep
package :: MutableDep,
    FailedMutation -> Text
mutation :: Text
  }
  deriving stock (FailedMutation -> FailedMutation -> Bool
(FailedMutation -> FailedMutation -> Bool)
-> (FailedMutation -> FailedMutation -> Bool) -> Eq FailedMutation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FailedMutation -> FailedMutation -> Bool
== :: FailedMutation -> FailedMutation -> Bool
$c/= :: FailedMutation -> FailedMutation -> Bool
/= :: FailedMutation -> FailedMutation -> Bool
Eq, Int -> FailedMutation -> ShowS
[FailedMutation] -> ShowS
FailedMutation -> String
(Int -> FailedMutation -> ShowS)
-> (FailedMutation -> String)
-> ([FailedMutation] -> ShowS)
-> Show FailedMutation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FailedMutation -> ShowS
showsPrec :: Int -> FailedMutation -> ShowS
$cshow :: FailedMutation -> String
show :: FailedMutation -> String
$cshowList :: [FailedMutation] -> ShowS
showList :: [FailedMutation] -> ShowS
Show, (forall x. FailedMutation -> Rep FailedMutation x)
-> (forall x. Rep FailedMutation x -> FailedMutation)
-> Generic FailedMutation
forall x. Rep FailedMutation x -> FailedMutation
forall x. FailedMutation -> Rep FailedMutation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FailedMutation -> Rep FailedMutation x
from :: forall x. FailedMutation -> Rep FailedMutation x
$cto :: forall x. Rep FailedMutation x -> FailedMutation
to :: forall x. Rep FailedMutation x -> FailedMutation
Generic)

instance Pretty FailedMutation where
  pretty :: FailedMutation -> Doc
pretty FailedMutation {MutableDep
package :: FailedMutation -> MutableDep
package :: MutableDep
package, Text
mutation :: FailedMutation -> Text
mutation :: Text
mutation} = MutableDep -> Doc
forall a. Pretty a => a -> Doc
pretty MutableDep
package Doc -> Doc -> Doc
<+> Text -> Doc
prettyText Text
mutation

failedMutation ::
  Pretty a =>
  DepMutation a ->
  FailedMutation
failedMutation :: forall a. Pretty a => DepMutation a -> FailedMutation
failedMutation DepMutation {MutableDep
package :: forall a. DepMutation a -> MutableDep
package :: MutableDep
package, a
mutation :: forall a. DepMutation a -> a
mutation :: a
mutation} =
  FailedMutation {MutableDep
package :: MutableDep
package :: MutableDep
package, mutation :: Text
mutation = a -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP a
mutation}