StructuralProjections.hs

{-# LANGUAGE TypeFamilies #-}
-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context workspace-nominal-proof 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.WorkspaceNominalProof.StructuralProjections
  ( artifactClaimClaimIdWitness
  , artifactClaimClaimIdGet
  , artifactClaimClaimIdRawGet
  , projectClaimClaimIdWitness
  , projectClaimClaimIdGet
  , projectClaimClaimIdRawGet
  ) where

import Data.Text (Text)
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)
import Keiki.ProjectionDomain (TextPattern, textProjectionDomain)
import Generated.WorkspaceNominalProof.Structural.Shape.ArtifactClaim (ArtifactClaimShape(claimId))
import Generated.WorkspaceNominalProof.Structural.Shape.ProjectClaim (ProjectClaimShape(claimId))
import Generated.WorkspaceNominalProof.Structural.Shape.ArtifactClaim qualified as ShapeArtifactClaim
import Generated.WorkspaceNominalProof.Structural.Shape.ProjectClaim qualified as ShapeProjectClaim
import WorkspaceNominalProof.Bindings qualified as Bindings
import WorkspaceNominalProof.Domain (ArtifactClaim, ClaimId, ProjectClaim)

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

data ArtifactClaimClaimIdProjection

artifactClaimClaimIdRawGet :: ArtifactClaim -> ClaimId
artifactClaimClaimIdRawGet owner = (bindingToShape Bindings.artifactClaimBinding owner).claimId

artifactClaimClaimIdGet :: ArtifactClaim -> Text
artifactClaimClaimIdGet owner = (KindID.toText . nominalToRepresentation Bindings.claimIdBinding) (artifactClaimClaimIdRawGet owner)

instance FieldProjection ArtifactClaimClaimIdProjection where
  type FieldName ArtifactClaimClaimIdProjection = "/claimId"
  type FieldOwner ArtifactClaimClaimIdProjection = ArtifactClaim
  type FieldResult ArtifactClaimClaimIdProjection = Text
  fieldShapeId _ = "workspace-nominal-proof.ArtifactClaim.v1"
  projectFieldValue _ = artifactClaimClaimIdGet

instance ExactFieldProjection ArtifactClaimClaimIdProjection where
  fieldProjectionDomain _ = textProjectionDomain artifactClaimClaimIdProjectionDomainPattern
  reconstructFieldOwner _ value = do
    representation <- either (const Nothing) Just (parseKindIdV7Text @"claim" value)
    let fieldValue = nominalFromRepresentation Bindings.claimIdBinding representation
    let baseShape = bindingToShape Bindings.artifactClaimBinding (snd (NonEmpty.head (fixtureCases Bindings.artifactClaimFixtures)))
    pure (bindingFromShape Bindings.artifactClaimBinding (case baseShape of ShapeArtifactClaim.ArtifactClaim _ -> ShapeArtifactClaim.ArtifactClaim fieldValue))

artifactClaimClaimIdWitness :: FieldWitness ArtifactClaimClaimIdProjection
artifactClaimClaimIdWitness = exactFieldWitness @ArtifactClaimClaimIdProjection

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

data ProjectClaimClaimIdProjection

projectClaimClaimIdRawGet :: ProjectClaim -> ClaimId
projectClaimClaimIdRawGet owner = (bindingToShape Bindings.projectClaimBinding owner).claimId

projectClaimClaimIdGet :: ProjectClaim -> Text
projectClaimClaimIdGet owner = (KindID.toText . nominalToRepresentation Bindings.claimIdBinding) (projectClaimClaimIdRawGet owner)

instance FieldProjection ProjectClaimClaimIdProjection where
  type FieldName ProjectClaimClaimIdProjection = "/claimId"
  type FieldOwner ProjectClaimClaimIdProjection = ProjectClaim
  type FieldResult ProjectClaimClaimIdProjection = Text
  fieldShapeId _ = "workspace-nominal-proof.ProjectClaim.v1"
  projectFieldValue _ = projectClaimClaimIdGet

instance ExactFieldProjection ProjectClaimClaimIdProjection where
  fieldProjectionDomain _ = textProjectionDomain projectClaimClaimIdProjectionDomainPattern
  reconstructFieldOwner _ value = do
    representation <- either (const Nothing) Just (parseKindIdV7Text @"claim" value)
    let fieldValue = nominalFromRepresentation Bindings.claimIdBinding representation
    let baseShape = bindingToShape Bindings.projectClaimBinding (snd (NonEmpty.head (fixtureCases Bindings.projectClaimFixtures)))
    pure (bindingFromShape Bindings.projectClaimBinding (case baseShape of ShapeProjectClaim.ProjectClaim _ -> ShapeProjectClaim.ProjectClaim fieldValue))

projectClaimClaimIdWitness :: FieldWitness ProjectClaimClaimIdProjection
projectClaimClaimIdWitness = exactFieldWitness @ProjectClaimClaimIdProjection