StructuralProjections.hs

{-# LANGUAGE TypeFamilies #-}
-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from context checked-mapping-replay mapped structural facade; do not edit.
-- Equality witnesses are emitted for Text, Int, Bool, Natural, and UTCTime.
-- Nominal ID and enum leaves carry exact canonical-text domains.
-- Int, Natural, and UTCTime belong to Keiki's ordered subset.
module Generated.CheckedMappingReplay.StructuralProjections
  ( replayEnvelopePrimaryWitness
  , replayEnvelopePrimaryGet
  , replayEnvelopePrimaryRawGet
  ) where

import Data.Text (Text)
import Data.List.NonEmpty qualified as NonEmpty
import Keiro.Codec.IdDomain (idDomainTextPattern, typeIdV5OrV7Domain)
import Keiro.Codec.Structural (bindingToShape, bindingFromShape, fixtureCases)
import Keiki.Core (FieldProjection (..), FieldWitness, ExactFieldProjection (..), exactFieldWitness)
import Keiki.ProjectionDomain (TextPattern, textProjectionDomain)
import Generated.CheckedMappingReplay.Structural.Shape.ReplayEnvelope (ReplayEnvelopeShape(primary))
import Conformance.CheckedMappingReplay.Bindings qualified as Bindings
import Conformance.CheckedMappingReplay.Domain (ReplayEnvelope)
import Generated.CheckedMappingReplay.Nominals qualified as Nominals
import Generated.CheckedMappingReplay.Structural.Shape.ReplayEnvelope qualified as ShapeReplayEnvelope

replayEnvelopePrimaryProjectionDomainPattern :: TextPattern
replayEnvelopePrimaryProjectionDomainPattern = either (error . show) id (idDomainTextPattern (typeIdV5OrV7Domain "retained"))

data ReplayEnvelopePrimaryProjection

replayEnvelopePrimaryRawGet :: ReplayEnvelope -> Nominals.RetainedId
replayEnvelopePrimaryRawGet owner = (bindingToShape Bindings.replayEnvelopeBinding owner).primary

replayEnvelopePrimaryGet :: ReplayEnvelope -> Text
replayEnvelopePrimaryGet owner = Nominals.retainedIdText (replayEnvelopePrimaryRawGet owner)

instance FieldProjection ReplayEnvelopePrimaryProjection where
  type FieldName ReplayEnvelopePrimaryProjection = "/primary"
  type FieldOwner ReplayEnvelopePrimaryProjection = ReplayEnvelope
  type FieldResult ReplayEnvelopePrimaryProjection = Text
  fieldShapeId _ = "conformance.checked-mapping-replay.ReplayEnvelope.v1"
  projectFieldValue _ = replayEnvelopePrimaryGet

instance ExactFieldProjection ReplayEnvelopePrimaryProjection where
  fieldProjectionDomain _ = textProjectionDomain replayEnvelopePrimaryProjectionDomainPattern
  reconstructFieldOwner _ value = do
    fieldValue <- either (const Nothing) Just (Nominals.parseRetainedId value)
    let baseShape = bindingToShape Bindings.replayEnvelopeBinding (snd (NonEmpty.head (fixtureCases Bindings.replayEnvelopeFixtures)))
    pure (bindingFromShape Bindings.replayEnvelopeBinding (case baseShape of ShapeReplayEnvelope.ReplayEnvelope projectionField0_0 projectionField0_1 projectionField0_2 projectionField0_3 _ projectionField0_5 projectionField0_6 -> ShapeReplayEnvelope.ReplayEnvelope projectionField0_0 projectionField0_1 projectionField0_2 projectionField0_3 fieldValue projectionField0_5 projectionField0_6))

replayEnvelopePrimaryWitness :: FieldWitness ReplayEnvelopePrimaryProjection
replayEnvelopePrimaryWitness = exactFieldWitness @ReplayEnvelopePrimaryProjection