ContentHash.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.RefinedBase16.Structural.CodecCompare.ContentHash (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.RefinedBase16.HashStore.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.RefinedBase16.Bindings qualified as Bindings
import Conformance.RefinedBase16.Domain (ContentHash)

compareWithHistorical :: HistoricalCodec ContentHash -> 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.contentHashFixtures)
      encodeObservations =
        [ EncodeObservation label (historicalCodec.encode value) (GeneratedCodec.encodeContentHashMapped value)
        | (label, value) <- typedCases
        ]
      decodeObservations = [observation | (observation, _) <- entries]
      typedObserved =
        concat
          [ observedBranchesFor FromBinding branchSchema (GeneratedCodec.encodeContentHashMapped value)
          | (_, value) <- typedCases
          ]
      historicalObserved =
        concat [observedBranchesFor HistoricalGolden branchSchema value | (_, values) <- entries, value <- values]
      declared = declaredBranchesFor FromBinding branchSchema <> declaredBranchesFor HistoricalGolden branchSchema
      provenance =
        CompareProvenance
          { historicalCodecIdentity = historicalCodec.identity
          , historicalCodecVersion = historicalCodec.version
          , canonicalType = CanonicalTypeId "conformance.refined-base16.ContentHash.v1"
          , bindingSymbol = QualifiedValueName "Conformance.RefinedBase16.Bindings.contentHashBinding"
          , bindingVersion = BindingVersion "1"
          , wireFingerprint = "9a76d13837d002d3"
          }
  pure (compareReport provenance inputIssues (encodeObservations <> decodeObservations) declared (typedObserved <> historicalObserved))

loadGolden :: HistoricalCodec ContentHash -> 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 = historicalCodec.decode inputValue
          historicalOutcome = normalizeDecode historicalDecoded
          generatedOutcome = normalizeDecode (GeneratedCodec.decodeContentHashMapped inputValue)
          observation = DecodeObservation path inputValue historicalOutcome generatedOutcome
          coveredValues = case historicalDecoded of
            Right value -> [inputValue, GeneratedCodec.encodeContentHashMapped value]
            Left _ -> []
       in Right (observation, coveredValues)

normalizeDecode :: Either Text ContentHash -> DecodeOutcome
normalizeDecode = either DecodeFailed (DecodedShape . GeneratedCodec.encodeContentHashMapped)

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

branchSchema :: BranchSchema
branchSchema = BranchScalar