keiro-dsl-0.17.0.0: test/conformance-structural-nominals/Generated/StructuralNominalLeaves/StructuralProjections.hs

{-# LANGUAGE TypeFamilies #-}
-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context structural-nominal-leaves 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.StructuralNominalLeaves.StructuralProjections
  ( templateLookupInputClaimIdWitness
  , templateLookupInputClaimIdGet
  , templateLookupInputClaimIdRawGet
  , templateLookupRowClaimIdWitness
  , templateLookupRowClaimIdGet
  , templateLookupRowClaimIdRawGet
  , templateLookupRowTemplateIdWitness
  , templateLookupRowTemplateIdGet
  , templateLookupRowTemplateIdRawGet
  , templateStateAccountWitness
  , templateStateAccountGet
  , templateStateAccountRawGet
  , templateStateChannelWitness
  , templateStateChannelGet
  , templateStateChannelRawGet
  , templateStateTemplateIdWitness
  , templateStateTemplateIdGet
  , templateStateTemplateIdRawGet
  ) where

import Data.Text (Text)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.KindID qualified as KindID
import Keiro.Codec.IdDomain (idDomainTextPattern, parseKindIdV7Text, typeIdV7Domain)
import Keiro.Codec.Nominal (nominalToRepresentation, nominalFromRepresentation)
import Keiro.Codec.Structural (bindingToShape, bindingFromShape, fixtureCases)
import Keiki.Core (FieldProjection (..), FieldWitness, ExactFieldProjection (..), exactFieldWitness, fieldWitness)
import Keiki.ProjectionDomain (finiteProjectionDomain, TextPattern, textProjectionDomain)
import Generated.StructuralNominalLeaves.Structural.Shape.TemplateLookupInput (TemplateLookupInputShape(claimId))
import Generated.StructuralNominalLeaves.Structural.Shape.TemplateLookupRow (TemplateLookupRowShape(claimId, templateId))
import Generated.StructuralNominalLeaves.Structural.Shape.TemplateState (TemplateStateShape(account, channel, templateId))
import Conformance.StructuralNominals.Bindings qualified as Bindings
import Conformance.StructuralNominals.Domain (AccountNumber, Channel, ClaimId, TemplateLookupInput, TemplateLookupRow, TemplateState)
import Generated.StructuralNominalLeaves.Nominal.Shape.Channel qualified as ShapeChannel
import Generated.StructuralNominalLeaves.Nominals qualified as Nominals
import Generated.StructuralNominalLeaves.Structural.Shape.TemplateLookupInput qualified as ShapeTemplateLookupInput
import Generated.StructuralNominalLeaves.Structural.Shape.TemplateLookupRow qualified as ShapeTemplateLookupRow
import Generated.StructuralNominalLeaves.Structural.Shape.TemplateState qualified as ShapeTemplateState

templateLookupInputClaimIdProjectionDomainPattern :: TextPattern
templateLookupInputClaimIdProjectionDomainPattern = either (error . show) id (idDomainTextPattern (typeIdV7Domain "claim"))

data TemplateLookupInputClaimIdProjection

templateLookupInputClaimIdRawGet :: TemplateLookupInput -> ClaimId
templateLookupInputClaimIdRawGet owner = (bindingToShape Bindings.templateLookupInputBinding owner).claimId

templateLookupInputClaimIdGet :: TemplateLookupInput -> Text
templateLookupInputClaimIdGet owner = (KindID.toText . nominalToRepresentation Bindings.claimIdBinding) (templateLookupInputClaimIdRawGet owner)

instance FieldProjection TemplateLookupInputClaimIdProjection where
  type FieldName TemplateLookupInputClaimIdProjection = "/claimId"
  type FieldOwner TemplateLookupInputClaimIdProjection = TemplateLookupInput
  type FieldResult TemplateLookupInputClaimIdProjection = Text
  fieldShapeId _ = "conformance.structural-nominals.TemplateLookupInput.v1"
  projectFieldValue _ = templateLookupInputClaimIdGet

instance ExactFieldProjection TemplateLookupInputClaimIdProjection where
  fieldProjectionDomain _ = textProjectionDomain templateLookupInputClaimIdProjectionDomainPattern
  reconstructFieldOwner _ value = do
    representation <- either (const Nothing) Just (parseKindIdV7Text @"claim" value)
    let fieldValue = nominalFromRepresentation Bindings.claimIdBinding representation
    let baseShape = bindingToShape Bindings.templateLookupInputBinding (snd (NonEmpty.head (fixtureCases Bindings.templateLookupInputFixtures)))
    pure (bindingFromShape Bindings.templateLookupInputBinding (case baseShape of ShapeTemplateLookupInput.TemplateLookupInput _ -> ShapeTemplateLookupInput.TemplateLookupInput fieldValue))

templateLookupInputClaimIdWitness :: FieldWitness TemplateLookupInputClaimIdProjection
templateLookupInputClaimIdWitness = exactFieldWitness @TemplateLookupInputClaimIdProjection

templateLookupRowClaimIdProjectionDomainPattern :: TextPattern
templateLookupRowClaimIdProjectionDomainPattern = either (error . show) id (idDomainTextPattern (typeIdV7Domain "claim"))

data TemplateLookupRowClaimIdProjection

templateLookupRowClaimIdRawGet :: TemplateLookupRow -> ClaimId
templateLookupRowClaimIdRawGet owner = (bindingToShape Bindings.templateLookupRowBinding owner).claimId

templateLookupRowClaimIdGet :: TemplateLookupRow -> Text
templateLookupRowClaimIdGet owner = (KindID.toText . nominalToRepresentation Bindings.claimIdBinding) (templateLookupRowClaimIdRawGet owner)

instance FieldProjection TemplateLookupRowClaimIdProjection where
  type FieldName TemplateLookupRowClaimIdProjection = "/claimId"
  type FieldOwner TemplateLookupRowClaimIdProjection = TemplateLookupRow
  type FieldResult TemplateLookupRowClaimIdProjection = Text
  fieldShapeId _ = "conformance.structural-nominals.TemplateLookupRow.v1"
  projectFieldValue _ = templateLookupRowClaimIdGet

instance ExactFieldProjection TemplateLookupRowClaimIdProjection where
  fieldProjectionDomain _ = textProjectionDomain templateLookupRowClaimIdProjectionDomainPattern
  reconstructFieldOwner _ value = do
    representation <- either (const Nothing) Just (parseKindIdV7Text @"claim" value)
    let fieldValue = nominalFromRepresentation Bindings.claimIdBinding representation
    let baseShape = bindingToShape Bindings.templateLookupRowBinding (snd (NonEmpty.head (fixtureCases Bindings.templateLookupRowFixtures)))
    pure (bindingFromShape Bindings.templateLookupRowBinding (case baseShape of ShapeTemplateLookupRow.TemplateLookupRow projectionField0_0 _ -> ShapeTemplateLookupRow.TemplateLookupRow projectionField0_0 fieldValue))

templateLookupRowClaimIdWitness :: FieldWitness TemplateLookupRowClaimIdProjection
templateLookupRowClaimIdWitness = exactFieldWitness @TemplateLookupRowClaimIdProjection

templateLookupRowTemplateIdProjectionDomainPattern :: TextPattern
templateLookupRowTemplateIdProjectionDomainPattern = either (error . show) id (idDomainTextPattern (typeIdV7Domain "template"))

data TemplateLookupRowTemplateIdProjection

templateLookupRowTemplateIdRawGet :: TemplateLookupRow -> Nominals.TemplateId
templateLookupRowTemplateIdRawGet owner = (bindingToShape Bindings.templateLookupRowBinding owner).templateId

templateLookupRowTemplateIdGet :: TemplateLookupRow -> Text
templateLookupRowTemplateIdGet owner = Nominals.templateIdText (templateLookupRowTemplateIdRawGet owner)

instance FieldProjection TemplateLookupRowTemplateIdProjection where
  type FieldName TemplateLookupRowTemplateIdProjection = "/templateId"
  type FieldOwner TemplateLookupRowTemplateIdProjection = TemplateLookupRow
  type FieldResult TemplateLookupRowTemplateIdProjection = Text
  fieldShapeId _ = "conformance.structural-nominals.TemplateLookupRow.v1"
  projectFieldValue _ = templateLookupRowTemplateIdGet

instance ExactFieldProjection TemplateLookupRowTemplateIdProjection where
  fieldProjectionDomain _ = textProjectionDomain templateLookupRowTemplateIdProjectionDomainPattern
  reconstructFieldOwner _ value = do
    fieldValue <- either (const Nothing) Just (Nominals.parseTemplateId value)
    let baseShape = bindingToShape Bindings.templateLookupRowBinding (snd (NonEmpty.head (fixtureCases Bindings.templateLookupRowFixtures)))
    pure (bindingFromShape Bindings.templateLookupRowBinding (case baseShape of ShapeTemplateLookupRow.TemplateLookupRow _ projectionField0_1 -> ShapeTemplateLookupRow.TemplateLookupRow fieldValue projectionField0_1))

templateLookupRowTemplateIdWitness :: FieldWitness TemplateLookupRowTemplateIdProjection
templateLookupRowTemplateIdWitness = exactFieldWitness @TemplateLookupRowTemplateIdProjection

data TemplateStateAccountProjection

templateStateAccountRawGet :: TemplateState -> AccountNumber
templateStateAccountRawGet owner = (bindingToShape Bindings.templateStateBinding owner).account

templateStateAccountGet :: TemplateState -> Text
templateStateAccountGet owner = (nominalToRepresentation Bindings.accountNumberBinding) (templateStateAccountRawGet owner)

instance FieldProjection TemplateStateAccountProjection where
  type FieldName TemplateStateAccountProjection = "/account"
  type FieldOwner TemplateStateAccountProjection = TemplateState
  type FieldResult TemplateStateAccountProjection = Text
  fieldShapeId _ = "conformance.structural-nominals.TemplateState.v1"
  projectFieldValue _ = templateStateAccountGet

templateStateAccountWitness :: FieldWitness TemplateStateAccountProjection
templateStateAccountWitness = fieldWitness @TemplateStateAccountProjection

data TemplateStateChannelProjection

templateStateChannelRawGet :: TemplateState -> Channel
templateStateChannelRawGet owner = (bindingToShape Bindings.templateStateBinding owner).channel

templateStateChannelGet :: TemplateState -> Text
templateStateChannelGet owner = (ShapeChannel.channelRepresentationText . nominalToRepresentation Bindings.channelBinding) (templateStateChannelRawGet owner)

instance FieldProjection TemplateStateChannelProjection where
  type FieldName TemplateStateChannelProjection = "/channel"
  type FieldOwner TemplateStateChannelProjection = TemplateState
  type FieldResult TemplateStateChannelProjection = Text
  fieldShapeId _ = "conformance.structural-nominals.TemplateState.v1"
  projectFieldValue _ = templateStateChannelGet

instance ExactFieldProjection TemplateStateChannelProjection where
  fieldProjectionDomain _ = finiteProjectionDomain ("email" :| ["sms"])
  reconstructFieldOwner _ value = do
    fieldValue <- case value of
      "email" -> Just (nominalFromRepresentation Bindings.channelBinding ShapeChannel.Email)
      "sms" -> Just (nominalFromRepresentation Bindings.channelBinding ShapeChannel.Sms)
      _ -> Nothing
    let baseShape = bindingToShape Bindings.templateStateBinding (snd (NonEmpty.head (fixtureCases Bindings.templateStateFixtures)))
    pure (bindingFromShape Bindings.templateStateBinding (case baseShape of ShapeTemplateState.TemplateState projectionField0_0 projectionField0_1 projectionField0_2 _ projectionField0_4 projectionField0_5 -> ShapeTemplateState.TemplateState projectionField0_0 projectionField0_1 projectionField0_2 fieldValue projectionField0_4 projectionField0_5))

templateStateChannelWitness :: FieldWitness TemplateStateChannelProjection
templateStateChannelWitness = exactFieldWitness @TemplateStateChannelProjection

templateStateTemplateIdProjectionDomainPattern :: TextPattern
templateStateTemplateIdProjectionDomainPattern = either (error . show) id (idDomainTextPattern (typeIdV7Domain "template"))

data TemplateStateTemplateIdProjection

templateStateTemplateIdRawGet :: TemplateState -> Nominals.TemplateId
templateStateTemplateIdRawGet owner = (bindingToShape Bindings.templateStateBinding owner).templateId

templateStateTemplateIdGet :: TemplateState -> Text
templateStateTemplateIdGet owner = Nominals.templateIdText (templateStateTemplateIdRawGet owner)

instance FieldProjection TemplateStateTemplateIdProjection where
  type FieldName TemplateStateTemplateIdProjection = "/templateId"
  type FieldOwner TemplateStateTemplateIdProjection = TemplateState
  type FieldResult TemplateStateTemplateIdProjection = Text
  fieldShapeId _ = "conformance.structural-nominals.TemplateState.v1"
  projectFieldValue _ = templateStateTemplateIdGet

instance ExactFieldProjection TemplateStateTemplateIdProjection where
  fieldProjectionDomain _ = textProjectionDomain templateStateTemplateIdProjectionDomainPattern
  reconstructFieldOwner _ value = do
    fieldValue <- either (const Nothing) Just (Nominals.parseTemplateId value)
    let baseShape = bindingToShape Bindings.templateStateBinding (snd (NonEmpty.head (fixtureCases Bindings.templateStateFixtures)))
    pure (bindingFromShape Bindings.templateStateBinding (case baseShape of ShapeTemplateState.TemplateState _ projectionField0_1 projectionField0_2 projectionField0_3 projectionField0_4 projectionField0_5 -> ShapeTemplateState.TemplateState fieldValue projectionField0_1 projectionField0_2 projectionField0_3 projectionField0_4 projectionField0_5))

templateStateTemplateIdWitness :: FieldWitness TemplateStateTemplateIdProjection
templateStateTemplateIdWitness = exactFieldWitness @TemplateStateTemplateIdProjection