packages feed

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

{-# LANGUAGE TypeFamilies #-}
-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context structural-nominal-leaves nominal scalar projection facade; do not edit.
module Generated.StructuralNominalLeaves.NominalProjections where

import Data.KindID qualified as KindID
import Data.Text (Text)
import Keiki.Core (FieldProjection (..), FieldWitness, ExactFieldProjection (..), exactFieldWitness)
import Keiki.ProjectionDomain (TextPattern, matchesTextPattern, textProjectionDomain)
import Keiro.Codec.IdDomain (idDomainTextPattern, typeIdV7Domain, validateIdDomainText)
import Keiro.Codec.Nominal (nominalToRepresentation, nominalFromRepresentation)
import Conformance.StructuralNominals.Bindings qualified as Bindings
import Conformance.StructuralNominals.Domain (ClaimId)

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

data ClaimIdEqualityProjection

instance FieldProjection ClaimIdEqualityProjection where
  type FieldName ClaimIdEqualityProjection = "ClaimId"
  type FieldOwner ClaimIdEqualityProjection = ClaimId
  type FieldResult ClaimIdEqualityProjection = Text
  fieldShapeId _ = "nominal-equality|name=ClaimId|contract=keiro-dsl/nominal-equality/2|key=Text|domain=typeid-v7-text:claim:keiro-dsl/id-domain/typeid-v7/1|owner=consumer;canonical=conformance.structural-nominals.ClaimId.v1;binding=Conformance.StructuralNominals.Bindings.claimIdBinding;binding-version=1"
  projectFieldValue _ = KindID.toText . nominalToRepresentation Bindings.claimIdBinding

instance ExactFieldProjection ClaimIdEqualityProjection where
  fieldProjectionDomain _ = textProjectionDomain claimIdEqualityPattern
  reconstructFieldOwner _ value
    | Left _ <- validateIdDomainText (typeIdV7Domain "claim") value = Nothing
    | not (matchesTextPattern claimIdEqualityPattern value) = Nothing
    | otherwise = case KindID.parseText @"claim" value of
        Left _ -> Nothing
        Right representation -> Just (nominalFromRepresentation Bindings.claimIdBinding representation)

claimIdEqualityWitness :: FieldWitness ClaimIdEqualityProjection
claimIdEqualityWitness = exactFieldWitness @ClaimIdEqualityProjection