packages feed

gachi-schema (empty) → 0.1.0.0

raw patch · 5 files changed

+1016/−0 lines, 5 filesdep +basedep +containersdep +dhall

Dependencies added: base, containers, dhall, gachi-core, gachi-schema, hspec, polytropos-core, polytropos-dhall, text

Files

+ gachi-schema.cabal view
@@ -0,0 +1,46 @@+cabal-version: 3.0+name: gachi-schema+version: 0.1.0.0+synopsis: Declarative Dhall schemas and polytropos-dhall deserializers for Gachi+license: EUPL-1.2+author: Nadia Yvette Chambers+maintainer: nadia.yvette.chambers@ik.me+build-type: Simple+tested-with:+  GHC == 9.10.3,+  GHC == 9.12.4,+  GHC == 9.14.1++library+  exposed-modules:+    Gachi.Schema+    Gachi.Schema.Project+    Gachi.Schema.Dhall+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall -Wcompat -Wredundant-constraints+  build-depends:+    base >= 4.14 && < 5,+    gachi-core >= 0.1 && < 0.2,+    polytropos-core >= 0.1 && < 0.2,+    polytropos-dhall >= 0.1 && < 0.2,+    dhall >= 1.42 && < 1.43,+    text >= 2.0,+    containers >= 0.6++test-suite tests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test+  default-language: Haskell2010+  ghc-options: -Wall+  build-depends:+    base >= 4.14 && < 5,+    gachi-core,+    gachi-schema,+    polytropos-core,+    polytropos-dhall,+    dhall,+    text >= 2.0,+    containers >= 0.6,+    hspec >= 2.10
+ src/Gachi/Schema.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE DuplicateRecordFields #-}++-- | Module: Gachi.Schema+-- Description: Declarative project schemas, Dhall codecs, and open row representations+--+-- Front door module for the @gachi-schema@ package.+--+-- Provides strongly-typed project manifests ('Project', 'PackageSpec', 'Author', 'RemoteSpec'),+-- Dhall deserialization engines, pretty-printers, and open row isomorphisms ('ProjectRec')+-- powered by "Polytropos.Dhall".+--+-- = Architectural Overview+--+-- In the Gachi architecture, all project instantiation (@gachi init@), cross-repository+-- standardization (@gachi sync@), and retrofitting (@gachi retrofit@) operate on total,+-- deterministic Dhall schemas rather than untyped string templating (Jinja/Mustache).+--+-- Schemas are decoded through 'Polytropos.Dhall' into either nominal records or open+-- heterogeneous rows without intermediate binary tree allocations.+--+-- = When to Use This Module+--+-- * Importing all project schema types and Dhall decoders with a single module import.+-- * Authoring or validating @project.dhall@ configurations.+-- * Converting between nominal project configurations and open row representations.+--+-- = Worked Example+--+-- >>> import Gachi.Schema+-- >>> proj <- decodeProjectText exampleProjectDhall+-- >>> projectName proj+-- "gongju"+-- >>> projectLicense proj+-- "EUPL-1.2"+module Gachi.Schema+  ( -- * Note Architecture+    -- $notes++    -- * Nominal Schema Types+    Project(..)+  , Author(..)+  , PackageSpec(..)+  , RemoteSpec(..)++    -- * Projection Selectors+  , projectName+  , projectDescription+  , projectLicense+  , projectAuthor+  , projectGhcVersion+  , projectCabalVersion+  , projectPackages+  , projectRemotes+  , authorName+  , authorEmail+  , packageName+  , packageSynopsis+  , packageExposes+  , remoteName+  , remoteUrl++    -- * Open Row Types & Isomorphisms+  , ProjectRow+  , ProjectRec+  , toProjectRec+  , fromProjectRec++  , AuthorRow+  , AuthorRec+  , toAuthorRec+  , fromAuthorRec++  , PackageRow+  , PackageRec+  , toPackageRec+  , fromPackageRec++  , RemoteRow+  , RemoteRec+  , toRemoteRec+  , fromRemoteRec++    -- * Dhall Evaluation & Serialization+  , decodeProjectText+  , decodeProjectFile+  , decodeProjectEither+  , decodeProjectRecText+  , decodeProjectRecEither+  , renderProjectDhall+  , renderProjectRecDhall++    -- * Turnkey Schemas & Canonical Defaults+  , projectSchemaDhall+  , exampleProjectDhall+  , defaultProject+  , defaultPackage+  , canonicalLicense+  , canonicalGhcVersion+  , canonicalCabalVersion+  ) where++import Gachi.Schema.Project+import Gachi.Schema.Dhall++{- $notes+See Note [Dhall Parameterized Skeleton Templating] [ref:note-dhall-skeleton-templating].+-}++{- Note [Dhall Parameterized Skeleton Templating]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+[tag:note-dhall-skeleton-templating]+All project templates, multi-package layouts, and tooling manifests in Gachi are defined+as total, strongly typed Dhall schemas decoded into osteological structures.++Architectural Rationale:+  1. Determinism and Totality: Dhall expressions are guaranteed to terminate (strongly+     normalizing) and have zero access to ambient system calls, filesystems, or networks+     during evaluation. This ensures template evaluation is hermetic and reproducible.+  2. Strongly-Typed Schemas: Project metadata ('Project', 'PackageSpec', 'Author', 'RemoteSpec')+     is validated at evaluation time before directory creation, preventing partial or corrupt+     scaffolding runs.+  3. Seamless Generic & Row Decoding: By leveraging 'polytropos-dhall', schemas can be decoded+     either into nominal Haskell records via 'GenericDhall' or into open heterogeneous records+     ('Record') without intermediate AST tree allocations.+  4. Non-Destructive Extensibility: Schemas can provide default records, allowing user+     overrides for specific fields without breaking backward compatibility when new metadata+     fields are introduced.++See also:+  - Note [Ecosystem Standardization Invariants] [ref:note-ecosystem-standardization]+-}
+ src/Gachi/Schema/Dhall.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Module: Gachi.Schema.Dhall+-- Description: Dhall schema definitions, encoders, decoders, and templates+--+-- Provides turnkey encoders, decoders, and template definitions for evaluating+-- declarative Dhall project specifications into strongly typed 'Project' and 'ProjectRec'+-- structures.+--+-- All decoding operations enforce the totality and safety guarantees established in+-- Note [Dhall Parameterized Skeleton Templating] [ref:note-dhall-skeleton-templating].+--+-- = Architectural Overview & Rationale+--+-- Dhall is a programmable, strongly normalizing configuration language designed to+-- prevent unexpected failures at execution time. In Gachi, Dhall serves as the canonical+-- medium for defining project templates and configuration manifests because of its unique+-- structural characteristics:+--+-- 1. __Totality and Termination Guarantees:__+--    Dhall expressions are mathematically guaranteed to terminate. Unlike general-purpose+--    languages or Turing-complete template engines (e.g., Nix, Python scripts), a Dhall+--    template can never enter an infinite loop or deadlock the scaffolding engine.+--+-- 2. __Hermetic and Side-Effect Free:__+--    During evaluation, Dhall does not have access to ambient environment variables, arbitrary+--    filesystems, network sockets, or external process execution (unless explicit imports+--    are resolved by the host). This ensures that template instantiation is fully hermetic,+--    deterministic, and reproducible across disparate developer environments.+--+-- 3. __Strong Static Typing:__+--    Dhall configurations are statically typechecked against the expected schema before+--    any directory creation or file writing begins. Mismatched field names, missing attributes,+--    or incorrect types produce actionable, human-readable compiler diagnostics rather than+--    silent corruptions or half-initialized repositories.+--+-- == Evaluation & Codec Integration+--+-- This module leverages "Polytropos.Dhall" to bridge Dhall AST expressions ('Dhall.Core.Expr')+-- directly into high-performance Haskell structures:+--+-- * Nominal decoding ('decodeProjectText') utilizes 'Polytropos.Dhall.GenericDhall' to+--   populate 'Project' structures in a single pass.+-- * Open row decoding ('decodeProjectRecText') extracts raw fields directly into Polytropos+--   flat 'Polytropos.Core.RowRep' memory structures with zero intermediate binary tree allocations.+--+-- = When to Use This Module+--+-- * Reading and evaluating @project.dhall@ files from disk or memory.+-- * Formatting 'Project' or 'ProjectRec' records back into canonical Dhall expressions.+-- * Obtaining the canonical Dhall schema definition ('projectSchemaDhall') for tooling or LSP integration.+--+-- = Worked Example+--+-- >>> import Gachi.Schema.Dhall+-- >>> proj <- decodeProjectText exampleProjectDhall+-- >>> projectName proj+-- "gongju"+module Gachi.Schema.Dhall+  ( -- * High-Level Dhall Evaluation+    decodeProjectText+  , decodeProjectFile+  , decodeProjectEither+  , decodeProjectRecText+  , decodeProjectRecEither++    -- * Rendering & Encoding+  , renderProjectDhall+  , renderProjectRecDhall++    -- * Embedded Dhall Schemas & Turnkey Templates+  , projectSchemaDhall+  , exampleProjectDhall+  ) where++import Control.Exception (SomeException, try)+import Data.Bifunctor (first)+import Data.Text (Text)+import qualified Dhall+import qualified Dhall.Core as Core+import Gachi.Schema.Project (Project, ProjectRec)++-- | Decode a 'Project' specification from a raw Dhall text expression.+--+-- Evaluates the Dhall abstract syntax tree, verifies all expected schema fields+-- against the nominal 'Project' definition, and constructs the resulting record.+--+-- Throws a 'Dhall.Core.DhallErrors' exception if the expression fails to parse,+-- typecheck, or match the expected schema.+--+-- Time complexity: Strictly linear in the size of the Dhall input expression.+decodeProjectText :: Text -> IO Project+decodeProjectText = Dhall.input Dhall.auto++-- | Decode a 'Project' specification from a Dhall file located on disk.+--+-- Automatically resolves relative local file imports (e.g., @./Schema.dhall@)+-- relative to the target file's parent directory.+--+-- Throws an 'IOException' if the file does not exist, or a 'Dhall.Core.DhallErrors'+-- exception if evaluation fails.+decodeProjectFile :: FilePath -> IO Project+decodeProjectFile = Dhall.inputFile Dhall.auto++-- | Safely decode a 'Project' from Dhall text without throwing runtime exceptions.+--+-- Catches any 'SomeException' raised during parsing, typechecking, or normalization+-- and wraps it in a 'Left' containing the formatted diagnostic error message.+--+-- Useful for CLI validation flags, interactive wizards, and language server linting passes.+decodeProjectEither :: Text -> IO (Either String Project)+decodeProjectEither txt = first show <$> (try (decodeProjectText txt) :: IO (Either SomeException Project))++-- | Decode an open heterogeneous 'ProjectRec' row record from a Dhall text expression.+--+-- Directly unrolls Dhall record literals into Polytropos flat 'Data.Primitive.SmallArray'+-- memory slots in row order via 'Polytropos.Dhall', achieving zero intermediate binary tree+-- constructor allocations.+--+-- Throws a 'Dhall.Core.DhallErrors' exception if the input expression violates the schema.+decodeProjectRecText :: Text -> IO ProjectRec+decodeProjectRecText = Dhall.input Dhall.auto++-- | Safely decode an open heterogeneous 'ProjectRec' from Dhall text without throwing exceptions.+--+-- Wraps any caught evaluation failure in 'Left' with the descriptive error message,+-- or returns 'Right' with the parsed 'ProjectRec'.+decodeProjectRecEither :: Text -> IO (Either String ProjectRec)+decodeProjectRecEither txt = first show <$> (try (decodeProjectRecText txt) :: IO (Either SomeException ProjectRec))++-- | Render a nominal 'Project' into canonical, pretty-printed Dhall source text.+--+-- Emits a formatted Dhall record literal matching 'projectSchemaDhall'.+--+-- Time complexity: Linear in the size of the project record structure.+renderProjectDhall :: Project -> Text+renderProjectDhall = Core.pretty . Dhall.embed Dhall.inject++-- | Render an open heterogeneous 'ProjectRec' into canonical, pretty-printed Dhall source text.+--+-- Directly inspects the contiguous 'Polytropos.Core.RowRep' memory buffer and emits+-- the corresponding Dhall record literal without building intermediate nominal ASTs.+renderProjectRecDhall :: ProjectRec -> Text+renderProjectRecDhall = Core.pretty . Dhall.embed Dhall.inject++-- | The canonical Dhall schema defining 'Author', 'Package', 'Remote', and 'Project' types.+projectSchemaDhall :: Text+projectSchemaDhall =+  "let Author : Type =\n\+  \  { name : Text\n\+  \  , email : Text\n\+  \  }\n\+  \\n\+  \let Package : Type =\n\+  \  { name : Text\n\+  \  , synopsis : Text\n\+  \  , exposes : List Text\n\+  \  }\n\+  \\n\+  \let Remote : Type =\n\+  \  { name : Text\n\+  \  , url : Text\n\+  \  }\n\+  \\n\+  \let Project : Type =\n\+  \  { name : Text\n\+  \  , description : Text\n\+  \  , license : Text\n\+  \  , author : Author\n\+  \  , ghcVersion : Text\n\+  \  , cabalVersion : Text\n\+  \  , packages : List Package\n\+  \  , remotes : List Remote\n\+  \  }\n\+  \\n\+  \in  { Author = Author\n\+  \    , Package = Package\n\+  \    , Remote = Remote\n\+  \    , Project = Project\n\+  \    }\n"++-- | Turnkey sample Dhall specification for the 'gongju' crucible project.+exampleProjectDhall :: Text+exampleProjectDhall =+  "let Schema =\n\+  \  { Author = { name : Text, email : Text }\n\+  \  , Package = { name : Text, synopsis : Text, exposes : List Text }\n\+  \  , Remote = { name : Text, url : Text }\n\+  \  , Project =\n\+  \      { name : Text\n\+  \      , description : Text\n\+  \      , license : Text\n\+  \      , author : { name : Text, email : Text }\n\+  \      , ghcVersion : Text\n\+  \      , cabalVersion : Text\n\+  \      , packages : List { name : Text, synopsis : Text, exposes : List Text }\n\+  \      , remotes : List { name : Text, url : Text }\n\+  \      }\n\+  \  }\n\+  \\n\+  \let project : Schema.Project =\n\+  \  { name = \"gongju\"\n\+  \  , description = \"Type-level utility functions and Peano arithmetic crucible\"\n\+  \  , license = \"EUPL-1.2\"\n\+  \  , author =\n\+  \      { name = \"Nadia Yvette Chambers\"\n\+  \      , email = \"nadia.yvette.chambers@ik.me\"\n\+  \      }\n\+  \  , ghcVersion = \"9.14.1\"\n\+  \  , cabalVersion = \"3.18\"\n\+  \  , packages =\n\+  \      [ { name = \"gongju\"\n\+  \        , synopsis = \"Pure Peano type-level utilities and HList operations\"\n\+  \        , exposes =\n\+  \            [ \"Gongju.Peano\"\n\+  \            , \"Gongju.Composition\"\n\+  \            , \"Gongju.Positional\"\n\+  \            , \"Gongju.Permute\"\n\+  \            , \"Gongju.HList\"\n\+  \            ]\n\+  \        }\n\+  \      ]\n\+  \  , remotes =\n\+  \      [ { name = \"github\"\n\+  \        , url = \"git@github.com:NadiaYvette/gongju.git\"\n\+  \        }\n\+  \      , { name = \"gitlab\"\n\+  \        , url = \"git@gitlab.com:NadiaYvette/gongju.git\"\n\+  \        }\n\+  \      ]\n\+  \  }\n\+  \\n\+  \in  project\n"
+ src/Gachi/Schema/Project.hs view
@@ -0,0 +1,464 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++-- | Module: Gachi.Schema.Project+-- Description: Strongly-typed nominal records and open row representations for projects+--+-- Defines foundational schema types for declarative workspace and package configurations:+-- 'Author', 'PackageSpec', 'RemoteSpec', and 'Project'.+--+-- All types provide both nominal representations deriving 'FromDhall' / 'ToDhall' via+-- 'GenericDhall' and isomorphic open row representations ('ProjectRec', 'AuthorRec', etc.)+-- backed by Polytropos flat 'Record' storage.+--+-- = Architectural Overview & Rationale+--+-- In Gachi's infrastructure model, all repository scaffolding, configuration synthesis,+-- and project retrofitting operate on declarative, hermetic schemas encoded in the+-- Dhall configuration language. Rather than relying on fragile untyped string substitution+-- (such as Jinja, Mustache, or sed expressions), Gachi models repository metadata as+-- strongly-typed algebraic records.+--+-- == Duality: Nominal Records and Open Rows+--+-- This module implements a deliberate structural duality:+--+-- 1. __Nominal Representations ('Project', 'Author', etc.):__+--    Provide standard Haskell data types with 'Generic' deriving. These types interface+--    seamlessly with Dhall via 'Polytropos.Dhall.GenericDhall' through @DerivingVia@,+--    enabling automatic decoder ('FromDhall') and encoder ('ToDhall') synthesis.+--+-- 2. __Open Row Isomorphisms ('ProjectRec', 'AuthorRec', etc.):__+--    Provide isomorphic open record types backed by Polytropos contiguous+--    'Polytropos.Core.RowRep' storage. In the open row representation, field values reside in+--    contiguous 'Data.Primitive.SmallArray' slots, permitting dynamic field extension,+--    narrowing, and sub-row projection without intermediate data type declarations.+--+-- == Ecosystem Invariants & Licensing+--+-- All project skeletons generated or verified by Gachi adhere to core ecosystem policies:+--+-- * __Licensing Discipline:__ By default, all ecosystem assets are licensed under+--   the European Union Public Licence (EUPL-1.2) or Apache-2.0. The EUPL is legally+--   interoperable across 22 European languages and compatible with GPLv2/v3 while protecting+--   upstream authors against SaaS-loophole proprietary enclosure.+-- * __Toolchain Pinning:__ Projects explicitly pin GHC 9.14.1 and Cabal 3.18, enabling+--   reproducible, bit-identical build artifacts across heterogeneous development workstations+--   and automated CI matrices.+-- * __Modular Multi-Package DAGs:__ Large systems are decomposed into fine-grained packages+--   (e.g., @*-core@, @*-schema@, @*-cli@) with explicit module exposure lists, maximizing+--   compilation parallelism and enforcing clean architectural boundaries.+--+-- = When to Use This Module+--+-- * Reading, validating, or writing Dhall project manifests (@project.dhall@).+-- * Generating multi-package workspace structures in @gachi init@.+-- * Converting between nominal Haskell configurations and open row representations.+--+-- = Worked Example+--+-- >>> import Gachi.Schema.Project+-- >>> let auth = Author { name = "Nadia Yvette Chambers", email = "nadia.yvette.chambers@ik.me" }+-- >>> let proj = defaultProject "gongju" auth+-- >>> projectName proj+-- "gongju"+-- >>> projectLicense proj+-- "EUPL-1.2"+module Gachi.Schema.Project+  ( -- * Nominal Schema Data Types+    Author(..)+  , PackageSpec(..)+  , RemoteSpec(..)+  , Project(..)++    -- * Field Projection Aliases+  , authorName+  , authorEmail+  , packageName+  , packageSynopsis+  , packageExposes+  , remoteName+  , remoteUrl+  , projectName+  , projectDescription+  , projectLicense+  , projectAuthor+  , projectGhcVersion+  , projectCabalVersion+  , projectPackages+  , projectRemotes++    -- * Open Row Types+  , AuthorRow+  , AuthorRec+  , toAuthorRec+  , fromAuthorRec++  , PackageRow+  , PackageRec+  , toPackageRec+  , fromPackageRec++  , RemoteRow+  , RemoteRec+  , toRemoteRec+  , fromRemoteRec++  , ProjectRow+  , ProjectRec+  , toProjectRec+  , fromProjectRec++    -- * Defaults & Canonical Invariants+  , defaultProject+  , defaultPackage+  , canonicalLicense+  , canonicalGhcVersion+  , canonicalCabalVersion+  ) where++import Data.Text (Text)+import Data.Functor.Identity (Identity(..))+import Dhall (FromDhall, ToDhall)+import GHC.Generics (Generic)+import Polytropos+  ( Pair(..)+  , Record+  )+import Polytropos.Core+  ( RowRep(..)+  , fieldAt+  , noInlineUnsafeCo+  , productRep+  )+import Polytropos.Dhall (GenericDhall(..))++-- | Author and maintainer metadata for a project.+data Author = Author+  { name  :: !Text+    -- ^ Full personal or organizational author name.+  , email :: !Text+    -- ^ Contact email address.+  } deriving stock (Generic, Show, Eq)+    deriving (FromDhall, ToDhall) via (GenericDhall Author)++-- | Specification for an individual Cabal package within a multi-package workspace.+data PackageSpec = PackageSpec+  { name     :: !Text+    -- ^ Package name (e.g., @"gachi-core"@).+  , synopsis :: !Text+    -- ^ Short one-line synopsis of package purpose.+  , exposes  :: ![Text]+    -- ^ List of exposed top-level modules.+  } deriving stock (Generic, Show, Eq)+    deriving (FromDhall, ToDhall) via (GenericDhall PackageSpec)++-- | Remote Git repository configuration for multi-forge mirroring.+data RemoteSpec = RemoteSpec+  { name :: !Text+    -- ^ Remote identifier (e.g., @"github"@, @"gitlab"@, @"radicle"@).+  , url  :: !Text+    -- ^ Canonical fetch/push URL.+  } deriving stock (Generic, Show, Eq)+    deriving (FromDhall, ToDhall) via (GenericDhall RemoteSpec)++-- | Comprehensive declarative specification for a project workspace.+--+-- See Note [Dhall Parameterized Skeleton Templating] [ref:note-dhall-skeleton-templating].+data Project = Project+  { name         :: !Text+    -- ^ Canonical project name.+  , description  :: !Text+    -- ^ Human-readable project description and mission.+  , license      :: !Text+    -- ^ SPDX license identifier (defaults to @"EUPL-1.2"@).+  , author       :: !Author+    -- ^ Primary maintainer or author identity.+  , ghcVersion   :: !Text+    -- ^ Pinned GHC compiler release (e.g., @"9.14.1"@).+  , cabalVersion :: !Text+    -- ^ Pinned Cabal specification release (e.g., @"3.18"@).+  , packages     :: ![PackageSpec]+    -- ^ Modular package hierarchy constituting this workspace.+  , remotes      :: ![RemoteSpec]+    -- ^ Multi-forge remotes configured for replication.+  } deriving stock (Generic, Show, Eq)+    deriving (FromDhall, ToDhall) via (GenericDhall Project)++--------------------------------------------------------------------------------+-- Field Projection Aliases (disambiguating DuplicateRecordFields when needed)+--------------------------------------------------------------------------------++-- | Disambiguated projection selector for 'Author' name.+--+-- Time complexity: @O(1)@ direct pattern match.+authorName :: Author -> Text+authorName (Author n _) = n++-- | Disambiguated projection selector for 'Author' email.+--+-- Time complexity: @O(1)@ direct pattern match.+authorEmail :: Author -> Text+authorEmail (Author _ e) = e++-- | Disambiguated projection selector for 'PackageSpec' name.+--+-- Time complexity: @O(1)@ direct pattern match.+packageName :: PackageSpec -> Text+packageName (PackageSpec n _ _) = n++-- | Disambiguated projection selector for 'PackageSpec' synopsis.+--+-- Time complexity: @O(1)@ direct pattern match.+packageSynopsis :: PackageSpec -> Text+packageSynopsis (PackageSpec _ s _) = s++-- | Disambiguated projection selector for 'PackageSpec' exposed modules.+--+-- Time complexity: @O(1)@ direct pattern match.+packageExposes :: PackageSpec -> [Text]+packageExposes (PackageSpec _ _ ex) = ex++-- | Disambiguated projection selector for 'RemoteSpec' name.+--+-- Time complexity: @O(1)@ direct pattern match.+remoteName :: RemoteSpec -> Text+remoteName (RemoteSpec n _) = n++-- | Disambiguated projection selector for 'RemoteSpec' URL.+--+-- Time complexity: @O(1)@ direct pattern match.+remoteUrl :: RemoteSpec -> Text+remoteUrl (RemoteSpec _ u) = u++-- | Disambiguated projection selector for 'Project' name.+--+-- Time complexity: @O(1)@ direct pattern match.+projectName :: Project -> Text+projectName (Project n _ _ _ _ _ _ _) = n++-- | Disambiguated projection selector for 'Project' description.+--+-- Time complexity: @O(1)@ direct pattern match.+projectDescription :: Project -> Text+projectDescription (Project _ d _ _ _ _ _ _) = d++-- | Disambiguated projection selector for 'Project' license.+--+-- Time complexity: @O(1)@ direct pattern match.+projectLicense :: Project -> Text+projectLicense (Project _ _ l _ _ _ _ _) = l++-- | Disambiguated projection selector for 'Project' author.+--+-- Time complexity: @O(1)@ direct pattern match.+projectAuthor :: Project -> Author+projectAuthor (Project _ _ _ a _ _ _ _) = a++-- | Disambiguated projection selector for 'Project' GHC version.+--+-- Time complexity: @O(1)@ direct pattern match.+projectGhcVersion :: Project -> Text+projectGhcVersion (Project _ _ _ _ g _ _ _) = g++-- | Disambiguated projection selector for 'Project' Cabal version.+--+-- Time complexity: @O(1)@ direct pattern match.+projectCabalVersion :: Project -> Text+projectCabalVersion (Project _ _ _ _ _ c _ _) = c++-- | Disambiguated projection selector for 'Project' packages.+--+-- Time complexity: @O(1)@ direct pattern match.+projectPackages :: Project -> [PackageSpec]+projectPackages (Project _ _ _ _ _ _ pkgs _) = pkgs++-- | Disambiguated projection selector for 'Project' remotes.+--+-- Time complexity: @O(1)@ direct pattern match.+projectRemotes :: Project -> [RemoteSpec]+projectRemotes (Project _ _ _ _ _ _ _ rms) = rms++--------------------------------------------------------------------------------+-- Open Row Representations (Polytropos Flat Memory Records)+--------------------------------------------------------------------------------++-- | Heterogeneous type-level row for 'Author'.+type AuthorRow = '["name" ':= Text, "email" ':= Text]++-- | Open record type for 'Author'.+type AuthorRec = Record AuthorRow++-- | Convert nominal 'Author' into open 'AuthorRec'.+--+-- Packs fields into a contiguous 2-element 'Data.Primitive.SmallArray' in row order:+-- Slot 0 (@"name"@) and Slot 1 (@"email"@).+--+-- Time complexity: @O(1)@.+toAuthorRec :: Author -> AuthorRec+toAuthorRec (Author n e) =+  RowRep (productRep [Identity (noInlineUnsafeCo n), Identity (noInlineUnsafeCo e)])++-- | Convert open 'AuthorRec' into nominal 'Author'.+--+-- Dereferences contiguous array slots via 'fieldAt' with zero intermediate heap allocation.+--+-- Time complexity: @O(1)@.+fromAuthorRec :: AuthorRec -> Author+fromAuthorRec (RowRep rep) = Author+  { name  = let Identity n = fieldAt 0 rep in n+  , email = let Identity e = fieldAt 1 rep in e+  }++-- | Heterogeneous type-level row for 'PackageSpec'.+type PackageRow = '["name" ':= Text, "synopsis" ':= Text, "exposes" ':= [Text]]++-- | Open record type for 'PackageSpec'.+type PackageRec = Record PackageRow++-- | Convert nominal 'PackageSpec' into open 'PackageRec'.+--+-- Packs fields into a contiguous 3-element 'Data.Primitive.SmallArray' in row order:+-- Slot 0 (@"name"@), Slot 1 (@"synopsis"@), and Slot 2 (@"exposes"@).+--+-- Time complexity: @O(1)@.+toPackageRec :: PackageSpec -> PackageRec+toPackageRec (PackageSpec n s ex) =+  RowRep (productRep [Identity (noInlineUnsafeCo n), Identity (noInlineUnsafeCo s), Identity (noInlineUnsafeCo ex)])++-- | Convert open 'PackageRec' into nominal 'PackageSpec'.+--+-- Dereferences contiguous array slots via 'fieldAt' with zero intermediate heap allocation.+--+-- Time complexity: @O(1)@.+fromPackageRec :: PackageRec -> PackageSpec+fromPackageRec (RowRep rep) = PackageSpec+  { name     = let Identity n  = fieldAt 0 rep in n+  , synopsis = let Identity s  = fieldAt 1 rep in s+  , exposes  = let Identity ex = fieldAt 2 rep in ex+  }++-- | Heterogeneous type-level row for 'RemoteSpec'.+type RemoteRow = '["name" ':= Text, "url" ':= Text]++-- | Open record type for 'RemoteSpec'.+type RemoteRec = Record RemoteRow++-- | Convert nominal 'RemoteSpec' into open 'RemoteRec'.+--+-- Packs fields into a contiguous 2-element 'Data.Primitive.SmallArray' in row order:+-- Slot 0 (@"name"@) and Slot 1 (@"url"@).+--+-- Time complexity: @O(1)@.+toRemoteRec :: RemoteSpec -> RemoteRec+toRemoteRec (RemoteSpec n u) =+  RowRep (productRep [Identity (noInlineUnsafeCo n), Identity (noInlineUnsafeCo u)])++-- | Convert open 'RemoteRec' into nominal 'RemoteSpec'.+--+-- Dereferences contiguous array slots via 'fieldAt' with zero intermediate heap allocation.+--+-- Time complexity: @O(1)@.+fromRemoteRec :: RemoteRec -> RemoteSpec+fromRemoteRec (RowRep rep) = RemoteSpec+  { name = let Identity n = fieldAt 0 rep in n+  , url  = let Identity u = fieldAt 1 rep in u+  }++-- | Heterogeneous type-level row for 'Project'.+type ProjectRow =+  '[ "name" ':= Text+   , "description" ':= Text+   , "license" ':= Text+   , "author" ':= Author+   , "ghcVersion" ':= Text+   , "cabalVersion" ':= Text+   , "packages" ':= [PackageSpec]+   , "remotes" ':= [RemoteSpec]+   ]++-- | Open record type for 'Project'.+type ProjectRec = Record ProjectRow++-- | Convert nominal 'Project' into open 'ProjectRec'.+--+-- Packs all 8 project fields into a single contiguous 'Data.Primitive.SmallArray' in row order:+-- Slot 0 (@"name"@), Slot 1 (@"description"@), Slot 2 (@"license"@), Slot 3 (@"author"@),+-- Slot 4 (@"ghcVersion"@), Slot 5 (@"cabalVersion"@), Slot 6 (@"packages"@), and Slot 7 (@"remotes"@).+--+-- Time complexity: @O(1)@.+toProjectRec :: Project -> ProjectRec+toProjectRec (Project n d l a g c pkgs rms) =+  RowRep (productRep+    [ Identity (noInlineUnsafeCo n)+    , Identity (noInlineUnsafeCo d)+    , Identity (noInlineUnsafeCo l)+    , Identity (noInlineUnsafeCo a)+    , Identity (noInlineUnsafeCo g)+    , Identity (noInlineUnsafeCo c)+    , Identity (noInlineUnsafeCo pkgs)+    , Identity (noInlineUnsafeCo rms)+    ])++-- | Convert open 'ProjectRec' into nominal 'Project'.+--+-- Unpacks the flat contiguous array into the nominal 'Project' record in $O(1)$ time+-- with zero intermediate tree allocations.+--+-- Time complexity: @O(1)@.+fromProjectRec :: ProjectRec -> Project+fromProjectRec (RowRep rep) = Project+  { name         = let Identity n    = fieldAt 0 rep in n+  , description  = let Identity d    = fieldAt 1 rep in d+  , license      = let Identity l    = fieldAt 2 rep in l+  , author       = let Identity a    = fieldAt 3 rep in a+  , ghcVersion   = let Identity g    = fieldAt 4 rep in g+  , cabalVersion = let Identity c    = fieldAt 5 rep in c+  , packages     = let Identity pkgs = fieldAt 6 rep in pkgs+  , remotes      = let Identity rms  = fieldAt 7 rep in rms+  }++--------------------------------------------------------------------------------+-- Canonical Ecosystem Standards & Turnkey Defaults+--------------------------------------------------------------------------------++-- | Canonical default license per ecosystem policy: EUPL-1.2.+canonicalLicense :: Text+canonicalLicense = "EUPL-1.2"++-- | Canonical default GHC version: 9.14.1.+canonicalGhcVersion :: Text+canonicalGhcVersion = "9.14.1"++-- | Canonical default Cabal specification version: 3.18.+canonicalCabalVersion :: Text+canonicalCabalVersion = "3.18"++-- | Construct a default 'PackageSpec' with canonical conventions.+defaultPackage :: Text -> PackageSpec+defaultPackage pkgName = PackageSpec+  { name     = pkgName+  , synopsis = "Foundational package for " <> pkgName+  , exposes  = []+  }++-- | Construct a turnkey 'Project' with canonical defaults.+--+-- Automatically configures EUPL-1.2 license, GHC 9.14.1, Cabal 3.18, and a primary package.+defaultProject :: Text -> Author -> Project+defaultProject projName auth = Project+  { name         = projName+  , description  = "Ecosystem workspace for " <> projName+  , license      = canonicalLicense+  , author       = auth+  , ghcVersion   = canonicalGhcVersion+  , cabalVersion = canonicalCabalVersion+  , packages     = [defaultPackage projName]+  , remotes      = []+  }
+ test/Main.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Test.Hspec+import Control.Exception (SomeException, try)+import Data.Either (isLeft)+import Data.Text (Text)++import Gachi.Schema++main :: IO ()+main = hspec do+  -- Tested against Note [Dhall Parameterized Skeleton Templating] [ref:note-dhall-skeleton-templating]+  describe "Gachi.Schema Nominal Types & Invariants" do+    it "constructs turnkey default projects with canonical ecosystem standards" do+      let auth = Author { name = "Nadia Yvette Chambers", email = "nadia.yvette.chambers@ik.me" }+          proj = defaultProject "gongju" auth++      projectName proj `shouldBe` "gongju"+      projectLicense proj `shouldBe` "EUPL-1.2"+      projectGhcVersion proj `shouldBe` "9.14.1"+      projectCabalVersion proj `shouldBe` "3.18"+      authorName (projectAuthor proj) `shouldBe` "Nadia Yvette Chambers"+      authorEmail (projectAuthor proj) `shouldBe` "nadia.yvette.chambers@ik.me"+      length (projectPackages proj) `shouldBe` 1+      case projectPackages proj of+        (pkg : _) -> packageName pkg `shouldBe` "gongju"+        []        -> expectationFailure "expected at least one package"+      projectRemotes proj `shouldBe` []++    it "exposes projection helpers disambiguating DuplicateRecordFields" do+      let auth = Author { name = "Ada Lovelace", email = "ada@analytical.org" }+          pkg = PackageSpec { name = "engine-core", synopsis = "Babbage engine simulator", exposes = ["Engine.Core"] }+          remote = RemoteSpec { name = "origin", url = "git@github.com:Ada/engine.git" }+          proj = Project+            { name = "analytical-engine"+            , description = "Computational pioneer project"+            , license = canonicalLicense+            , author = auth+            , ghcVersion = canonicalGhcVersion+            , cabalVersion = canonicalCabalVersion+            , packages = [pkg]+            , remotes = [remote]+            }++      projectName proj `shouldBe` "analytical-engine"+      authorName auth `shouldBe` "Ada Lovelace"+      packageName pkg `shouldBe` "engine-core"+      packageSynopsis pkg `shouldBe` "Babbage engine simulator"+      packageExposes pkg `shouldBe` ["Engine.Core"]+      remoteName remote `shouldBe` "origin"+      remoteUrl remote `shouldBe` "git@github.com:Ada/engine.git"++  describe "Gachi.Schema Open Row Isomorphisms" do+    it "faithfully roundtrips Author <-> AuthorRec" do+      let auth = Author { name = "Charles Babbage", email = "charles@difference.org" }+          recA = toAuthorRec auth+          auth' = fromAuthorRec recA+      auth' `shouldBe` auth++    it "faithfully roundtrips PackageSpec <-> PackageRec" do+      let pkg = PackageSpec+            { name = "difference-math"+            , synopsis = "Polynomial difference computation"+            , exposes = ["Math.Difference", "Math.Gear"]+            }+          recP = toPackageRec pkg+          pkg' = fromPackageRec recP+      pkg' `shouldBe` pkg++    it "faithfully roundtrips RemoteSpec <-> RemoteRec" do+      let rm = RemoteSpec { name = "radicle", url = "rad:git:hnrk12345678" }+          recR = toRemoteRec rm+          rm' = fromRemoteRec recR+      rm' `shouldBe` rm++    it "faithfully roundtrips Project <-> ProjectRec" do+      let auth = Author { name = "Nadia Yvette Chambers", email = "nadia.yvette.chambers@ik.me" }+          proj = defaultProject "gachi" auth+          recProj = toProjectRec proj+          proj' = fromProjectRec recProj+      proj' `shouldBe` proj++  -- Tested against Note [Dhall Parameterized Skeleton Templating] [ref:note-dhall-skeleton-templating]+  describe "Gachi.Schema.Dhall Codecs & Evaluation" do+    it "decodes embedded exampleProjectDhall into strongly typed Project" do+      proj <- decodeProjectText exampleProjectDhall+      projectName proj `shouldBe` "gongju"+      projectLicense proj `shouldBe` "EUPL-1.2"+      authorName (projectAuthor proj) `shouldBe` "Nadia Yvette Chambers"+      length (projectPackages proj) `shouldBe` 1+      case projectPackages proj of+        (pkg : _) -> do+          packageName pkg `shouldBe` "gongju"+          packageExposes pkg `shouldBe`+            [ "Gongju.Peano"+            , "Gongju.Composition"+            , "Gongju.Positional"+            , "Gongju.Permute"+            , "Gongju.HList"+            ]+        [] -> expectationFailure "expected package list to be non-empty"+      length (projectRemotes proj) `shouldBe` 2+      map remoteName (projectRemotes proj) `shouldBe` ["github", "gitlab"]++    it "decodes open heterogeneous ProjectRec directly from Dhall" do+      recProj <- decodeProjectRecText exampleProjectDhall+      let proj = fromProjectRec recProj+      projectName proj `shouldBe` "gongju"+      projectLicense proj `shouldBe` "EUPL-1.2"++    it "roundtrips nominal Project through renderProjectDhall and decodeProjectText" do+      let auth = Author { name = "Nadia Yvette Chambers", email = "nadia.yvette.chambers@ik.me" }+          orig = defaultProject "polytropos" auth+          rendered = renderProjectDhall orig+      decoded <- decodeProjectText rendered+      decoded `shouldBe` orig++    it "roundtrips open ProjectRec through renderProjectRecDhall and decodeProjectRecText" do+      let auth = Author { name = "Nadia Yvette Chambers", email = "nadia.yvette.chambers@ik.me" }+          origRec = toProjectRec (defaultProject "polytropos" auth)+          rendered = renderProjectRecDhall origRec+      decodedRec <- decodeProjectRecText rendered+      fromProjectRec decodedRec `shouldBe` fromProjectRec origRec+      projectName (fromProjectRec decodedRec) `shouldBe` "polytropos"++    it "gracefully returns Left for malformed Dhall expressions" do+      let invalidDhall = "{ name = \"broken\", license = 123 }" :: Text+      res <- decodeProjectEither invalidDhall+      res `shouldSatisfy` isLeft++    it "decodes project specification from disk file" do+      res1 <- try (decodeProjectFile "dhall/example-project.dhall") :: IO (Either SomeException Project)+      proj <- case res1 of+        Right p -> pure p+        Left _  -> decodeProjectFile "packages/gachi-schema/dhall/example-project.dhall"+      projectName proj `shouldBe` "gongju"+      projectLicense proj `shouldBe` "EUPL-1.2"