module Hix.Managed.Data.Diff where

import Data.These (These, mergeTheseWith)
import Distribution.Pretty (Pretty (pretty))
import Text.PrettyPrint (Doc, brackets, (<+>))

import Hix.Data.Version (Version)
import Hix.Data.VersionBounds (VersionBounds)
import Hix.Pretty (prettyL)

class PrettyDiffDetail a where
  prettyDiffDetail :: a -> Maybe Doc

instance PrettyDiffDetail () where
  prettyDiffDetail :: () -> Maybe Doc
prettyDiffDetail () = Maybe Doc
forall a. Maybe a
Nothing

data Diff d a =
  DiffAdded a
  |
  DiffChanged {
    forall d a. Diff d a -> a
original :: a,
    forall d a. Diff d a -> a
new :: a,
    forall d a. Diff d a -> d
detail :: d
  }
  deriving stock (Diff d a -> Diff d a -> Bool
(Diff d a -> Diff d a -> Bool)
-> (Diff d a -> Diff d a -> Bool) -> Eq (Diff d a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall d a. (Eq a, Eq d) => Diff d a -> Diff d a -> Bool
$c== :: forall d a. (Eq a, Eq d) => Diff d a -> Diff d a -> Bool
== :: Diff d a -> Diff d a -> Bool
$c/= :: forall d a. (Eq a, Eq d) => Diff d a -> Diff d a -> Bool
/= :: Diff d a -> Diff d a -> Bool
Eq, Int -> Diff d a -> ShowS
[Diff d a] -> ShowS
Diff d a -> String
(Int -> Diff d a -> ShowS)
-> (Diff d a -> String) -> ([Diff d a] -> ShowS) -> Show (Diff d a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d a. (Show a, Show d) => Int -> Diff d a -> ShowS
forall d a. (Show a, Show d) => [Diff d a] -> ShowS
forall d a. (Show a, Show d) => Diff d a -> String
$cshowsPrec :: forall d a. (Show a, Show d) => Int -> Diff d a -> ShowS
showsPrec :: Int -> Diff d a -> ShowS
$cshow :: forall d a. (Show a, Show d) => Diff d a -> String
show :: Diff d a -> String
$cshowList :: forall d a. (Show a, Show d) => [Diff d a] -> ShowS
showList :: [Diff d a] -> ShowS
Show, (forall x. Diff d a -> Rep (Diff d a) x)
-> (forall x. Rep (Diff d a) x -> Diff d a) -> Generic (Diff d a)
forall x. Rep (Diff d a) x -> Diff d a
forall x. Diff d a -> Rep (Diff d a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d a x. Rep (Diff d a) x -> Diff d a
forall d a x. Diff d a -> Rep (Diff d a) x
$cfrom :: forall d a x. Diff d a -> Rep (Diff d a) x
from :: forall x. Diff d a -> Rep (Diff d a) x
$cto :: forall d a x. Rep (Diff d a) x -> Diff d a
to :: forall x. Rep (Diff d a) x -> Diff d a
Generic, (forall a b. (a -> b) -> Diff d a -> Diff d b)
-> (forall a b. a -> Diff d b -> Diff d a) -> Functor (Diff d)
forall a b. a -> Diff d b -> Diff d a
forall a b. (a -> b) -> Diff d a -> Diff d b
forall d a b. a -> Diff d b -> Diff d a
forall d a b. (a -> b) -> Diff d a -> Diff d b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall d a b. (a -> b) -> Diff d a -> Diff d b
fmap :: forall a b. (a -> b) -> Diff d a -> Diff d b
$c<$ :: forall d a b. a -> Diff d b -> Diff d a
<$ :: forall a b. a -> Diff d b -> Diff d a
Functor)

instance (
    Pretty a,
    PrettyDiffDetail d
  ) => Pretty (Diff d a) where
    pretty :: Diff d a -> Doc
pretty = \case
      DiffAdded a
a -> Doc
"[+]" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
a
      DiffChanged {a
original :: forall d a. Diff d a -> a
original :: a
original, a
new :: forall d a. Diff d a -> a
new :: a
new, d
detail :: forall d a. Diff d a -> d
detail :: d
detail} -> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
original Doc -> Doc -> Doc
<+> Doc
"->" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
new Doc -> Doc -> Doc
<+> Maybe Doc -> Doc
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (d -> Maybe Doc
forall a. PrettyDiffDetail a => a -> Maybe Doc
prettyDiffDetail d
detail)

type VersionDiff = Diff () Version

newtype BoundsDiffDetail =
  BoundsDiffDetail (These VersionDiff VersionDiff)
  deriving stock (BoundsDiffDetail -> BoundsDiffDetail -> Bool
(BoundsDiffDetail -> BoundsDiffDetail -> Bool)
-> (BoundsDiffDetail -> BoundsDiffDetail -> Bool)
-> Eq BoundsDiffDetail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoundsDiffDetail -> BoundsDiffDetail -> Bool
== :: BoundsDiffDetail -> BoundsDiffDetail -> Bool
$c/= :: BoundsDiffDetail -> BoundsDiffDetail -> Bool
/= :: BoundsDiffDetail -> BoundsDiffDetail -> Bool
Eq, Int -> BoundsDiffDetail -> ShowS
[BoundsDiffDetail] -> ShowS
BoundsDiffDetail -> String
(Int -> BoundsDiffDetail -> ShowS)
-> (BoundsDiffDetail -> String)
-> ([BoundsDiffDetail] -> ShowS)
-> Show BoundsDiffDetail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoundsDiffDetail -> ShowS
showsPrec :: Int -> BoundsDiffDetail -> ShowS
$cshow :: BoundsDiffDetail -> String
show :: BoundsDiffDetail -> String
$cshowList :: [BoundsDiffDetail] -> ShowS
showList :: [BoundsDiffDetail] -> ShowS
Show, (forall x. BoundsDiffDetail -> Rep BoundsDiffDetail x)
-> (forall x. Rep BoundsDiffDetail x -> BoundsDiffDetail)
-> Generic BoundsDiffDetail
forall x. Rep BoundsDiffDetail x -> BoundsDiffDetail
forall x. BoundsDiffDetail -> Rep BoundsDiffDetail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BoundsDiffDetail -> Rep BoundsDiffDetail x
from :: forall x. BoundsDiffDetail -> Rep BoundsDiffDetail x
$cto :: forall x. Rep BoundsDiffDetail x -> BoundsDiffDetail
to :: forall x. Rep BoundsDiffDetail x -> BoundsDiffDetail
Generic)

type BoundsDiff = Diff BoundsDiffDetail VersionBounds

instance PrettyDiffDetail BoundsDiffDetail where
  prettyDiffDetail :: BoundsDiffDetail -> Maybe Doc
prettyDiffDetail (BoundsDiffDetail These VersionDiff VersionDiff
detail) =
    Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Doc
brackets ((VersionDiff -> Doc)
-> (VersionDiff -> Doc)
-> (Doc -> Doc -> Doc)
-> These VersionDiff VersionDiff
-> Doc
forall a c b.
(a -> c) -> (b -> c) -> (c -> c -> c) -> These a b -> c
mergeTheseWith VersionDiff -> Doc
forall a. Pretty a => a -> Doc
pretty VersionDiff -> Doc
forall a. Pretty a => a -> Doc
pretty Doc -> Doc -> Doc
forall {a}. Pretty a => a -> a -> Doc
cat These VersionDiff VersionDiff
detail))
    where
      cat :: a -> a -> Doc
cat a
l a
u = forall (t :: * -> *) a. (Pretty a, Foldable t) => t a -> Doc
prettyL @[] [a
Item [a]
l, a
Item [a]
u]

data Change d a =
  Changed (Diff d a)
  |
  Unchanged (Maybe a)
  deriving stock (Change d a -> Change d a -> Bool
(Change d a -> Change d a -> Bool)
-> (Change d a -> Change d a -> Bool) -> Eq (Change d a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall d a. (Eq a, Eq d) => Change d a -> Change d a -> Bool
$c== :: forall d a. (Eq a, Eq d) => Change d a -> Change d a -> Bool
== :: Change d a -> Change d a -> Bool
$c/= :: forall d a. (Eq a, Eq d) => Change d a -> Change d a -> Bool
/= :: Change d a -> Change d a -> Bool
Eq, Int -> Change d a -> ShowS
[Change d a] -> ShowS
Change d a -> String
(Int -> Change d a -> ShowS)
-> (Change d a -> String)
-> ([Change d a] -> ShowS)
-> Show (Change d a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d a. (Show a, Show d) => Int -> Change d a -> ShowS
forall d a. (Show a, Show d) => [Change d a] -> ShowS
forall d a. (Show a, Show d) => Change d a -> String
$cshowsPrec :: forall d a. (Show a, Show d) => Int -> Change d a -> ShowS
showsPrec :: Int -> Change d a -> ShowS
$cshow :: forall d a. (Show a, Show d) => Change d a -> String
show :: Change d a -> String
$cshowList :: forall d a. (Show a, Show d) => [Change d a] -> ShowS
showList :: [Change d a] -> ShowS
Show, (forall x. Change d a -> Rep (Change d a) x)
-> (forall x. Rep (Change d a) x -> Change d a)
-> Generic (Change d a)
forall x. Rep (Change d a) x -> Change d a
forall x. Change d a -> Rep (Change d a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d a x. Rep (Change d a) x -> Change d a
forall d a x. Change d a -> Rep (Change d a) x
$cfrom :: forall d a x. Change d a -> Rep (Change d a) x
from :: forall x. Change d a -> Rep (Change d a) x
$cto :: forall d a x. Rep (Change d a) x -> Change d a
to :: forall x. Rep (Change d a) x -> Change d a
Generic, (forall a b. (a -> b) -> Change d a -> Change d b)
-> (forall a b. a -> Change d b -> Change d a)
-> Functor (Change d)
forall a b. a -> Change d b -> Change d a
forall a b. (a -> b) -> Change d a -> Change d b
forall d a b. a -> Change d b -> Change d a
forall d a b. (a -> b) -> Change d a -> Change d b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall d a b. (a -> b) -> Change d a -> Change d b
fmap :: forall a b. (a -> b) -> Change d a -> Change d b
$c<$ :: forall d a b. a -> Change d b -> Change d a
<$ :: forall a b. a -> Change d b -> Change d a
Functor)

instance (
    Pretty a,
    PrettyDiffDetail d
  ) => Pretty (Change d a) where
    pretty :: Change d a -> Doc
pretty = \case
      Unchanged Maybe a
Nothing -> Doc
"[0]"
      Unchanged (Just a
a) -> Doc
"[=]" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
a
      Changed Diff d a
diff -> Diff d a -> Doc
forall a. Pretty a => a -> Doc
pretty Diff d a
diff

type VersionChange = Change () Version

type BoundsChange = Change BoundsDiffDetail VersionBounds