keiro-dsl-0.6.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 ConsumerFixtures
import Conformance.Structural.Domain qualified as ConsumerDomain
compareWithHistorical :: HistoricalCodec ConsumerDomain.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 ConsumerFixtures.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 ConsumerDomain.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 ConsumerDomain.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))]