packages feed

keiro-dsl-0.10.0.0: test/conformance-structural/Generated/StructuralConformance/Structural/CodecCompare/ArtifactInfo.hs

-- @generated by keiro-dsl codec comparison; non-production migration evidence; do not edit.
-- This module compares historical and generated codecs in consumer-owned tests only.
-- It is never a runtime fallback and never changes the generated codec's authority.
module Generated.StructuralConformance.Structural.CodecCompare.ArtifactInfo (compareWithHistorical) where

import Control.Monad (filterM)
import Data.Aeson (Value)
import Data.Aeson qualified as Aeson
import Data.List (sort)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Text (Text)
import Data.Text qualified
import Generated.StructuralConformance.ArtifactCatalog.Codec qualified as GeneratedCodec
import Keiro.Codec.Structural (FixtureCases (..))
import Keiro.Dsl.CodecCompare
import Keiro.Dsl.TypeGraph (BindingVersion (..), CanonicalTypeId (..), QualifiedValueName (..))
import System.Directory (doesFileExist, listDirectory)
import System.FilePath (takeExtension, (</>))
import Conformance.Structural.Bindings qualified as Bindings
import Conformance.Structural.Domain (ArtifactInfo)

compareWithHistorical :: HistoricalCodec ArtifactInfo -> FilePath -> IO CompareReport
compareWithHistorical historicalCodec goldenDirectory = do
  names <- sort . filter ((== ".json") . takeExtension) <$> listDirectory goldenDirectory
  files <- filterM doesFileExist [goldenDirectory </> name | name <- names]
  loaded <- traverse (loadGolden historicalCodec) files
  let inputIssues = [issue | Left issue <- loaded]
      entries = [entry | Right entry <- loaded]
      typedCases = NonEmpty.toList (fixtureCases Bindings.artifactInfoCases)
      encodeObservations =
        [ EncodeObservation label (hcEncode historicalCodec value) (GeneratedCodec.encodeArtifactInfoMapped value)
        | (label, value) <- typedCases
        ]
      decodeObservations = [observation | (observation, _) <- entries]
      typedObserved =
        concat
          [ observedBranchesFor FromBinding branchSchema (GeneratedCodec.encodeArtifactInfoMapped value)
          | (_, value) <- typedCases
          ]
      historicalObserved =
        concat [observedBranchesFor HistoricalGolden branchSchema value | (_, values) <- entries, value <- values]
      declared = declaredBranchesFor FromBinding branchSchema <> declaredBranchesFor HistoricalGolden branchSchema
      provenance =
        CompareProvenance
          { cpHistoricalCodecIdentity = hcIdentity historicalCodec
          , cpHistoricalCodecVersion = hcVersion historicalCodec
          , cpCanonicalType = CanonicalTypeId "conformance.structural.ArtifactInfo.v1"
          , cpBindingSymbol = QualifiedValueName "Conformance.Structural.Bindings.artifactInfoBinding"
          , cpBindingVersion = BindingVersion "1"
          , cpWireFingerprint = "f3b9417666fcf445"
          }
  pure (compareReport provenance inputIssues (encodeObservations <> decodeObservations) declared (typedObserved <> historicalObserved))

loadGolden :: HistoricalCodec ArtifactInfo -> FilePath -> IO (Either CompareInputIssue (CompareObservation, [Value]))
loadGolden historicalCodec path = do
  decoded <- Aeson.eitherDecodeFileStrict path
  pure $ case decoded of
    Left reason -> Left (HistoricalGoldenUnreadable path (fromString reason))
    Right inputValue ->
      let historicalDecoded = hcDecode historicalCodec inputValue
          historicalOutcome = normalizeDecode historicalDecoded
          generatedOutcome = normalizeDecode (GeneratedCodec.decodeArtifactInfoMapped inputValue)
          observation = DecodeObservation path inputValue historicalOutcome generatedOutcome
          coveredValues = case historicalDecoded of
            Right value -> [inputValue, GeneratedCodec.encodeArtifactInfoMapped value]
            Left _ -> []
       in Right (observation, coveredValues)

normalizeDecode :: Either Text ArtifactInfo -> DecodeOutcome
normalizeDecode = either DecodeFailed (DecodedShape . GeneratedCodec.encodeArtifactInfoMapped)

fromString :: String -> Text
fromString = Data.Text.pack

branchSchema :: BranchSchema
branchSchema = BranchRecord [BranchField "artifact_key" False (BranchScalar), BranchField "display_name" False (BranchScalar), BranchField "artifact_hash" True (BranchOptional (BranchScalar)), BranchField "artifact_kind" True (BranchScalar), BranchField "location" False (BranchUnion "tag" "contents" [BranchArm "local_file" (Just (BranchScalar)), BranchArm "local_dir" (Just (BranchScalar)), BranchArm "repo_path" (Just (BranchScalar)), BranchArm "url" (Just (BranchScalar)), BranchArm "canonical" Nothing]), BranchField "metadata" False (BranchRecord [BranchField "note" False (BranchOptional (BranchScalar))]), BranchField "active" True (BranchScalar), BranchField "tags" True (BranchList (BranchScalar))]