Nominals.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
-- @generated by keiro-dsl 0.8.0.0 (language keiro-dsl 4) from context workspace-nominal-proof generated nominal declarations; do not edit.
module Generated.WorkspaceNominalProof.Nominals
  ( ProjectId
  , parseProjectId
  , mkProjectId
  , projectIdText
  , ProjectIdEqualityProjection
  , projectIdEqualityWitness
  , ProjectPhase (..)
  , projectPhaseText
  , ProjectPhaseEqualityProjection
  , projectPhaseEqualityWitness
  , UnusedNominal (..)
  , unusedNominalText
  ) where

import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import GHC.Generics (Generic)
import Keiki.Shape (CanonicalTypeName)
import Generated.WorkspaceNominalProof.Nominals.Internal (ProjectId, mkProjectId, parseProjectId, projectIdText)
import Keiki.Core (ExactFieldProjection (..), FieldProjection (..), FieldWitness, exactFieldWitness, fieldWitness)
import Data.List.NonEmpty (NonEmpty (..))
import Keiki.ProjectionDomain (TextPattern, finiteProjectionDomain, textProjectionDomain)
import Keiro.Codec.IdDomain (idDomainTextPattern, typeIdV7Domain)

instance CanonicalTypeName ProjectId

data ProjectIdEqualityProjection

instance FieldProjection ProjectIdEqualityProjection where
  type FieldName ProjectIdEqualityProjection = "ProjectId"
  type FieldOwner ProjectIdEqualityProjection = ProjectId
  type FieldResult ProjectIdEqualityProjection = Text
  fieldShapeId _ = "nominal-equality|name=ProjectId|contract=keiro-dsl/nominal-equality/2|key=Text|domain=typeid-v7-text:proj:keiro-dsl/id-domain/typeid-v7/1|owner=generated"
  projectFieldValue _ = projectIdText

projectIdIdDomainPattern :: TextPattern
projectIdIdDomainPattern = either (error . show) id (idDomainTextPattern (typeIdV7Domain "proj"))

instance ExactFieldProjection ProjectIdEqualityProjection where
  fieldProjectionDomain _ = textProjectionDomain projectIdIdDomainPattern
  reconstructFieldOwner _ = either (const Nothing) Just . parseProjectId

projectIdEqualityWitness :: FieldWitness ProjectIdEqualityProjection
projectIdEqualityWitness = exactFieldWitness @ProjectIdEqualityProjection

data ProjectPhase = Draft | Active
  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)
  deriving anyclass (ToJSON, FromJSON)

instance CanonicalTypeName ProjectPhase

projectPhaseText :: ProjectPhase -> Text
projectPhaseText = \case
  Draft -> "draft"
  Active -> "active"

data ProjectPhaseEqualityProjection

instance FieldProjection ProjectPhaseEqualityProjection where
  type FieldName ProjectPhaseEqualityProjection = "ProjectPhase"
  type FieldOwner ProjectPhaseEqualityProjection = ProjectPhase
  type FieldResult ProjectPhaseEqualityProjection = Text
  fieldShapeId _ = "nominal-equality|name=ProjectPhase|contract=keiro-dsl/nominal-equality/1|key=Text|domain=finite-text:draft,active|owner=generated"
  projectFieldValue _ = projectPhaseText

instance ExactFieldProjection ProjectPhaseEqualityProjection where
  fieldProjectionDomain _ = finiteProjectionDomain ("draft" :| ["active"])
  reconstructFieldOwner _ = \case
    "draft" -> Just Draft
    "active" -> Just Active
    _ -> Nothing

projectPhaseEqualityWitness :: FieldWitness ProjectPhaseEqualityProjection
projectPhaseEqualityWitness = exactFieldWitness @ProjectPhaseEqualityProjection

data UnusedNominal = Present | Absent
  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)
  deriving anyclass (ToJSON, FromJSON)

instance CanonicalTypeName UnusedNominal

unusedNominalText :: UnusedNominal -> Text
unusedNominalText = \case
  Present -> "present"
  Absent -> "absent"