MaybeText.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.BareContainers.Structural.CodecCompare.MaybeText (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.BareContainers.BareStore.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.BareContainers.Bindings qualified as Bindings
import Conformance.BareContainers.Domain (MaybeText)

compareWithHistorical :: HistoricalCodec MaybeText -> 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.maybeTextFixtures)
      encodeObservations =
        [ EncodeObservation label (historicalCodec.encode value) (GeneratedCodec.encodeMaybeTextMapped value)
        | (label, value) <- typedCases
        ]
      decodeObservations = [observation | (observation, _) <- entries]
      typedObserved =
        concat
          [ observedBranchesFor FromBinding branchSchema (GeneratedCodec.encodeMaybeTextMapped 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.bare-containers.MaybeText.v1"
          , bindingSymbol = QualifiedValueName "Conformance.BareContainers.Bindings.maybeTextBinding"
          , bindingVersion = BindingVersion "1"
          , wireFingerprint = "c289b01d5d2741d7"
          }
  pure (compareReport provenance inputIssues (encodeObservations <> decodeObservations) declared (typedObserved <> historicalObserved))

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

normalizeDecode :: Either Text MaybeText -> DecodeOutcome
normalizeDecode = either DecodeFailed (DecodedShape . GeneratedCodec.encodeMaybeTextMapped)

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

branchSchema :: BranchSchema
branchSchema = BranchOptional (BranchScalar)