content: -- Needed for `deriving Arbitrary via GenericArbitrary DerivationDiff`:
  {-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-}
  -- Needed for `deriving instance Data (DerivationOutput StorePath Text)`:
  {-# OPTIONS_GHC -Wno-orphans #-}
  
  module Nix.Diff.Types where
  
  import Data.List.NonEmpty (NonEmpty(..))
  import qualified Data.List.NonEmpty as NonEmpty
  import Data.Map (Map)
  import qualified Data.Map as Map
  import Data.Set (Set)
  import Data.Text (Text)
  import Nix.Derivation (DerivationOutput (..))
  import Nix.Diff.Store ( StorePath )
  
  import qualified Patience
  import GHC.Generics (Generic)
  import Data.Foldable
  import Data.Aeson
  import Data.Aeson.Types
  import Test.QuickCheck
  import Test.QuickCheck.Instances ()
  import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
  import Data.Data (Data)
  
  {- ** NOTE: Lawless instances
     All the Arbitrary instances here are written to
     check if `decode . encode == id` rule was broken,
     so they don't respect to internal laws of these types,
     such as "Maps from `extraOutputs` must not have
     intersecting keys" and so on.
     If you want to test these invariants, you have to rewrite
     instances manually.
  -}
  
  data Changed a = Changed { before :: a, now :: a }
    deriving stock (Eq, Show, Functor, Foldable, Traversable, Generic, Data)
  
  instance (Arbitrary a) => Arbitrary (Changed a) where
    arbitrary = Changed <$> arbitrary <*> arbitrary
    shrink = genericShrink
  
  instance ToJSON a => ToJSON (Changed a) where
    toJSON = changedToJSON toJSON
  
  instance FromJSON a => FromJSON (Changed a) where
    parseJSON = changedFromJSON parseJSON
  
  newtype TextDiff = TextDiff {unTextDiff :: [Patience.Item Text]}
    deriving stock (Eq, Show, Data)
  
  instance Arbitrary TextDiff where
    arbitrary = TextDiff <$> listOf arbitraryItem
  
  instance ToJSON TextDiff where
    toJSON textDiff = listValue itemToJSON textDiff.unTextDiff
  
  instance FromJSON TextDiff where
    parseJSON v = TextDiff <$> (traverse itemFromJSON =<< parseJSON v)
  
  -- Helpful aliases
  
  type OutputHash = Text
  
  type Platform = Text
  
  type Builder = Text
  
  type Argument = Text
  
  -- | A set of Nix derivation output names.
  newtype OutputNames = OutputNames {unOutputNames :: Set Text}
    deriving newtype (Eq, Ord, ToJSON, FromJSON)
    deriving stock (Show, Generic, Data)
    deriving Arbitrary via GenericArbitrary OutputNames
  
  -- Derivation diff
  
  data DerivationDiff
    = DerivationsAreTheSame
    | AlreadyCompared
    | OnlyAlreadyComparedBelow { outputStructure :: Changed OutputStructure}
    | NamesDontMatch           { outputStructure :: Changed OutputStructure}
    | OutputsDontMatch         { outputStructure :: Changed OutputStructure}
    | DerivationDiff
        { outputStructure :: Changed OutputStructure
        , outputsDiff     :: OutputsDiff
        , platformDiff    :: Maybe (Changed Platform)
          -- ^ Will be Nothing, if Platform does not change
        , builderDiff     :: Maybe (Changed Builder)
          -- ^ Will be Nothing, if Builder does not change
        , argumentsDiff   :: Maybe ArgumentsDiff
          -- ^ Will be Nothing, if arguments are equal
        , sourcesDiff     :: SourcesDiff
        , inputsDiff      :: InputsDiff
        , envDiff         :: Maybe EnvironmentDiff
          -- ^ Will be Nothing, if environment comparison is skipped
        }
    deriving stock (Eq, Show, Generic, Data)
    deriving anyclass (ToJSON, FromJSON)
    deriving Arbitrary via GenericArbitrary DerivationDiff
  
  -- Output structure
  
  data OutputStructure = OutputStructure
    { derivationPath :: StorePath
    , derivationOutputs :: OutputNames
    }
    deriving stock (Eq, Show, Generic, Data)
    deriving anyclass (ToJSON, FromJSON)
    deriving Arbitrary via GenericArbitrary OutputStructure
  
  -- ** Outputs diff
  
  data OutputsDiff = OutputsDiff
    { extraOutputs :: Maybe (Changed (Map Text (DerivationOutput StorePath Text)))
      -- ^ Map from derivation name to its outputs.
      --   Will be Nothing, if `Data.Map.difference` gives
      --   empty Maps for both new and old outputs
    , outputHashDiff :: [OutputDiff]
      -- ^ Difference of outputs with the same name.
      --   Will be empty, if all outputs are equal.
    }
    deriving stock (Eq, Show, Data)
  
  deriving instance Data (DerivationOutput StorePath Text)
  
  instance Arbitrary OutputsDiff where
    arbitrary = OutputsDiff <$> arbitraryExtraOutputs  <*> arbitrary
      where
        arbitraryExtraOutputs =
          oneof [pure Nothing, Just <$> arbitraryChangedMap]
  
        arbitraryChangedMap =
          Changed <$> arbitraryMap <*> arbitraryMap
  
        arbitraryMap = Map.fromList <$>
          listOf ((,) <$> arbitrary <*> arbitraryDerivationOutput)
  
  instance ToJSON OutputsDiff where
    toJSON OutputsDiff{..} = object
      [ "extraOutputs" .= fmap (changedToJSON extraOutputsToJSON) extraOutputs
      , "outputHashDiff" .= outputHashDiff
      ]
      where
      extraOutputsToJSON :: Map Text (DerivationOutput StorePath Text) -> Value
      extraOutputsToJSON = toJSON . fmap derivationOutputToJSON
  
      derivationOutputToJSON :: DerivationOutput StorePath Text -> Value
      derivationOutputToJSON DerivationOutput{..} = object
        [ "path" .= path
        , "hashAlgo" .= hashAlgo
        , "hash" .= hash
        ]
  
  instance FromJSON OutputsDiff where
    parseJSON = withObject "OutputsDiff" \o -> do
      extraOutputsWithoutParsingDerivationOutputs <- o .: "extraOutputs"
      ohd <- o .: "outputHashDiff"
      eo <- (traverse . traverse . traverse)
        derivationOutputFromJSON
        extraOutputsWithoutParsingDerivationOutputs
      pure $ OutputsDiff eo ohd
      where
  
        derivationOutputFromJSON :: Value -> Parser (DerivationOutput StorePath Text)
        derivationOutputFromJSON = withObject "DerivationOutput" \o ->
          DerivationOutput <$> o .: "path" <*> o .: "hashAlgo" <*> o .: "hash"
  
  data OutputDiff = OutputDiff
    { outputName :: Text
    , hashDifference :: Changed OutputHash
    }
    deriving stock (Eq, Show, Generic, Data)
    deriving anyclass (ToJSON, FromJSON)
    deriving Arbitrary via GenericArbitrary OutputDiff
  
  -- ** Arguments diff
  
  newtype ArgumentsDiff = ArgumentsDiff
    { unArgumetsDiff :: NonEmpty (Patience.Item Argument)
    }
    deriving stock (Eq, Show, Data)
  
  instance Arbitrary ArgumentsDiff where
    arbitrary = ArgumentsDiff . NonEmpty.fromList <$> listOf1 arbitraryItem
  
  instance ToJSON ArgumentsDiff where
    toJSON argumentsDiff = listValue itemToJSON (toList argumentsDiff.unArgumetsDiff)
  
  instance FromJSON ArgumentsDiff where
    parseJSON v = ArgumentsDiff <$> (traverse itemFromJSON =<< parseJSON v)
  
  -- ** Sources diff
  
  data SourcesDiff = SourcesDiff
    { extraSrcNames :: Maybe (Changed (Set Text))
      -- ^ Will be Nothing, if there is no extra source names
    , srcFilesDiff :: [SourceFileDiff]
    }
    deriving stock (Eq, Show, Generic, Data)
    deriving anyclass (ToJSON, FromJSON)
    deriving Arbitrary via GenericArbitrary SourcesDiff
  
  data SourceFileDiff
    = OneSourceFileDiff
        { srcName :: Text
        , srcContentDiff :: Maybe TextDiff
        -- ^ Will be Nothing, if any of source files not exists
        }
    | SomeSourceFileDiff
        { srcName :: Text
        , srcFileDiff :: Changed [StorePath]
        }
    deriving stock (Eq, Show, Generic, Data)
    deriving anyclass (ToJSON, FromJSON)
    deriving Arbitrary via GenericArbitrary SourceFileDiff
  
  -- ** Inputs diff
  
  data InputsDiff = InputsDiff
    { inputExtraNames :: Maybe (Changed (Set Text))
      -- ^ Will be Nothing, if there is no extra input names
    , inputDerivationDiffs :: [InputDerivationsDiff]
    }
    deriving stock (Eq, Show, Generic, Data)
    deriving anyclass (ToJSON, FromJSON)
    deriving Arbitrary via GenericArbitrary InputsDiff
  
  data InputDerivationsDiff
    = OneDerivationDiff
        { drvName :: Text
        , drvDiff :: DerivationDiff
        }
    | SomeDerivationsDiff
        { drvName :: Text
        , extraPartsDiff :: Changed (Map StorePath OutputNames)
        }
    | -- | Many input derivations differ, but they've all already been compared.
      ManyDerivationsAlreadyComparedDiff
        { drvNames :: Set Text
        }
    deriving stock (Eq, Show, Generic, Data)
    deriving anyclass (ToJSON, FromJSON)
    deriving Arbitrary via GenericArbitrary InputDerivationsDiff
  
  -- ** Environment diff
  
  data EnvironmentDiff
    = EnvironmentsAreEqual
    | EnvironmentDiff
        { extraEnvDiff :: Changed (Map Text Text)
        , envContentDiff :: [EnvVarDiff]
        }
    deriving stock (Eq, Show, Generic, Data)
    deriving anyclass (ToJSON, FromJSON)
    deriving Arbitrary via GenericArbitrary EnvironmentDiff
  
  data EnvVarDiff = EnvVarDiff
    { envKey :: Text
    , envValueDiff :: TextDiff
    }
    deriving stock (Eq, Show, Generic, Data)
    deriving anyclass (ToJSON, FromJSON)
    deriving Arbitrary via GenericArbitrary EnvVarDiff
  
  -- ** Helpers
  
  changedToJSON :: (a -> Value) -> Changed a -> Value
  changedToJSON converter Changed{..} = object
    [ "before" .= converter before
    , "now" .= converter now
    ]
  
  changedFromJSON :: (Value -> Parser a) -> Value -> Parser (Changed a)
  changedFromJSON innerParser = withObject "Changed" \o -> do
    b <- o .: "before"
    n <- o .: "now"
    Changed <$> innerParser b <*> innerParser n
  
  itemToJSON :: ToJSON v => Patience.Item v -> Value
  itemToJSON (Patience.Old a)    = object
    [ "type" .= ("Old" :: Text), "content" .= a]
  itemToJSON (Patience.New a)    = object
    [ "type" .= ("New" :: Text), "content" .= a]
  itemToJSON (Patience.Both a _) = object
    [ "type" .= ("Both" :: Text), "content" .= a]
  
  itemFromJSON :: FromJSON v => Value -> Parser (Patience.Item v)
  itemFromJSON = withObject "Item" \o -> do
    t <- o .: "type"
    c <- o .: "content"
    case t :: Text of
      "Old" -> pure $ Patience.Old c
      "New" -> pure $ Patience.New c
      "Both" -> pure $ Patience.Both c c
      _ -> fail "Item: unexpected type"
  
  arbitraryItem :: Arbitrary a => Gen (Patience.Item a)
  arbitraryItem =  do
    t <- arbitrary
    ctr <- elements [old, new, both]
    pure (ctr t)
    where
      old = Patience.Old
      new = Patience.New
      both x = Patience.Both x x
  
  arbitraryDerivationOutput :: (Arbitrary fp, Arbitrary txt) => Gen (DerivationOutput fp txt)
  arbitraryDerivationOutput = DerivationOutput <$> arbitrary <*> arbitrary <*> arbitrary
  