module Hix.Managed.Data.BuildOutput where

import Data.Aeson (ToJSON (toJSON), object, (.=))
import Distribution.Pretty (Pretty (pretty))
import Text.PrettyPrint (brackets, (<+>))

import Hix.Data.Version (Version)
import Hix.Data.VersionBounds (VersionBounds)
import Hix.Managed.Data.Mutable (MutableDep)
import qualified Hix.Managed.Data.MutableId
import Hix.Managed.Data.MutableId (MutableId (MutableId))
import Hix.Pretty (showP)

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

instance Pretty ModifiedId where
  pretty :: ModifiedId -> Doc
pretty ModifiedId {Maybe VersionBounds
Version
MutableDep
$sel:package:ModifiedId :: ModifiedId -> MutableDep
$sel:version:ModifiedId :: ModifiedId -> Version
$sel:range:ModifiedId :: ModifiedId -> Maybe VersionBounds
package :: MutableDep
version :: Version
range :: Maybe VersionBounds
..} =
    MutableId -> Doc
forall a. Pretty a => a -> Doc
pretty MutableId {$sel:name:MutableId :: MutableDep
name = MutableDep
package, Version
version :: Version
$sel:version:MutableId :: Version
version} Doc -> Doc -> Doc
<+> Doc -> Doc
brackets (Doc -> (VersionBounds -> Doc) -> Maybe VersionBounds -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
"old range matches" VersionBounds -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe VersionBounds
range)

instance ToJSON ModifiedId where
  toJSON :: ModifiedId -> Value
toJSON ModifiedId {Maybe VersionBounds
Version
MutableDep
$sel:package:ModifiedId :: ModifiedId -> MutableDep
$sel:version:ModifiedId :: ModifiedId -> Version
$sel:range:ModifiedId :: ModifiedId -> Maybe VersionBounds
package :: MutableDep
version :: Version
range :: Maybe VersionBounds
..} =
    [Pair] -> Value
object [
      Key
"package" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= MutableDep -> Value
forall a. ToJSON a => a -> Value
toJSON MutableDep
package,
      Key
"version" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Version -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP Version
version :: Text),
      Key
"range" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON (VersionBounds -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP (VersionBounds -> Text) -> Maybe VersionBounds -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe VersionBounds
range :: Maybe Text)
    ]

data BuildOutput =
  BuildOutput {
    BuildOutput -> [ModifiedId]
modified :: [ModifiedId],
    BuildOutput -> [MutableDep]
unmodified :: [MutableDep],
    BuildOutput -> [MutableDep]
failed :: [MutableDep],
    BuildOutput -> Maybe Text
modifiedNames :: Maybe Text,
    BuildOutput -> Maybe Text
unmodifiedNames :: Maybe Text,
    BuildOutput -> Maybe Text
failedNames :: Maybe Text
  }
  deriving stock (BuildOutput -> BuildOutput -> Bool
(BuildOutput -> BuildOutput -> Bool)
-> (BuildOutput -> BuildOutput -> Bool) -> Eq BuildOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildOutput -> BuildOutput -> Bool
== :: BuildOutput -> BuildOutput -> Bool
$c/= :: BuildOutput -> BuildOutput -> Bool
/= :: BuildOutput -> BuildOutput -> Bool
Eq, Int -> BuildOutput -> ShowS
[BuildOutput] -> ShowS
BuildOutput -> String
(Int -> BuildOutput -> ShowS)
-> (BuildOutput -> String)
-> ([BuildOutput] -> ShowS)
-> Show BuildOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildOutput -> ShowS
showsPrec :: Int -> BuildOutput -> ShowS
$cshow :: BuildOutput -> String
show :: BuildOutput -> String
$cshowList :: [BuildOutput] -> ShowS
showList :: [BuildOutput] -> ShowS
Show, (forall x. BuildOutput -> Rep BuildOutput x)
-> (forall x. Rep BuildOutput x -> BuildOutput)
-> Generic BuildOutput
forall x. Rep BuildOutput x -> BuildOutput
forall x. BuildOutput -> Rep BuildOutput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BuildOutput -> Rep BuildOutput x
from :: forall x. BuildOutput -> Rep BuildOutput x
$cto :: forall x. Rep BuildOutput x -> BuildOutput
to :: forall x. Rep BuildOutput x -> BuildOutput
Generic)
  deriving anyclass ([BuildOutput] -> Value
[BuildOutput] -> Encoding
BuildOutput -> Value
BuildOutput -> Encoding
(BuildOutput -> Value)
-> (BuildOutput -> Encoding)
-> ([BuildOutput] -> Value)
-> ([BuildOutput] -> Encoding)
-> ToJSON BuildOutput
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: BuildOutput -> Value
toJSON :: BuildOutput -> Value
$ctoEncoding :: BuildOutput -> Encoding
toEncoding :: BuildOutput -> Encoding
$ctoJSONList :: [BuildOutput] -> Value
toJSONList :: [BuildOutput] -> Value
$ctoEncodingList :: [BuildOutput] -> Encoding
toEncodingList :: [BuildOutput] -> Encoding
ToJSON)