TemplateState.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.StructuralNominalLeaves.Structural.CodecCompare.TemplateState (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.StructuralNominalLeaves.TemplateCatalog.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.StructuralNominals.Bindings qualified as Bindings
import Conformance.StructuralNominals.Domain (TemplateState)

compareWithHistorical :: HistoricalCodec TemplateState -> 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.templateStateFixtures)
      encodeObservations =
        [ EncodeObservation label (historicalCodec.encode value) (GeneratedCodec.encodeTemplateStateMapped value)
        | (label, value) <- typedCases
        ]
      decodeObservations = [observation | (observation, _) <- entries]
      typedObserved =
        concat
          [ observedBranchesFor FromBinding branchSchema (GeneratedCodec.encodeTemplateStateMapped 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.structural-nominals.TemplateState.v1"
          , bindingSymbol = QualifiedValueName "Conformance.StructuralNominals.Bindings.templateStateBinding"
          , bindingVersion = BindingVersion "1"
          , wireFingerprint = "ecd3e1365fd5975c"
          }
  pure (compareReport provenance inputIssues (encodeObservations <> decodeObservations) declared (typedObserved <> historicalObserved))

loadGolden :: HistoricalCodec TemplateState -> 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.decodeTemplateStateMapped inputValue)
          observation = DecodeObservation path inputValue historicalOutcome generatedOutcome
          coveredValues = case historicalDecoded of
            Right value -> [inputValue, GeneratedCodec.encodeTemplateStateMapped value]
            Left _ -> []
       in Right (observation, coveredValues)

normalizeDecode :: Either Text TemplateState -> DecodeOutcome
normalizeDecode = either DecodeFailed (DecodedShape . GeneratedCodec.encodeTemplateStateMapped)

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

branchSchema :: BranchSchema
branchSchema = BranchRecord [BranchField "templateId" False (BranchScalar), BranchField "holder" True (BranchOptional (BranchScalar)), BranchField "account" False (BranchScalar), BranchField "channel" False (BranchScalar), BranchField "kind" True (BranchScalar), BranchField "fallbackChannel" True (BranchScalar)]