From d251afe90256fa69686aa1b0d820de4456cd1f2d Mon Sep 17 00:00:00 2001 From: Ali Abrar Date: Thu, 21 Aug 2025 15:04:29 -0400 Subject: [PATCH] Prototype: OGPoset Diagram daa structure --- .gitignore | 3 ++ CHANGELOG.md | 5 +++ LICENSE | 29 +++++++++++++++ nix-thunk/default.nix | 2 ++ nix-thunk/github.json | 7 ++++ nix-thunk/thunk.nix | 12 +++++++ nixpkgs/default.nix | 2 ++ nixpkgs/github.json | 8 +++++ nixpkgs/thunk.nix | 12 +++++++ proto.cabal | 82 +++++++++++++++++++++++++++++++++++++++++++ shell.nix | 18 ++++++++++ src.nix | 8 +++++ src/Diagram.hs | 78 ++++++++++++++++++++++++++++++++++++++++ 13 files changed, 266 insertions(+) create mode 100644 .gitignore create mode 100644 CHANGELOG.md create mode 100644 LICENSE create mode 100644 nix-thunk/default.nix create mode 100644 nix-thunk/github.json create mode 100644 nix-thunk/thunk.nix create mode 100644 nixpkgs/default.nix create mode 100644 nixpkgs/github.json create mode 100644 nixpkgs/thunk.nix create mode 100644 proto.cabal create mode 100644 shell.nix create mode 100644 src.nix create mode 100644 src/Diagram.hs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e9f9944 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +TAGS +tags +dist-newstyle/ diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..bbc7953 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for proto + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..39b4cec --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2025, Obsidian Systems + + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/nix-thunk/default.nix b/nix-thunk/default.nix new file mode 100644 index 0000000..2b4d4ab --- /dev/null +++ b/nix-thunk/default.nix @@ -0,0 +1,2 @@ +# DO NOT HAND-EDIT THIS FILE +import (import ./thunk.nix) \ No newline at end of file diff --git a/nix-thunk/github.json b/nix-thunk/github.json new file mode 100644 index 0000000..16d1dd9 --- /dev/null +++ b/nix-thunk/github.json @@ -0,0 +1,7 @@ +{ + "owner": "obsidiansystems", + "repo": "nix-thunk", + "private": false, + "rev": "c10ac03047c88c1f2aed882d3cf2e60d0f7a0ac4", + "sha256": "1bhf9hq1wpb6qd126w6d54zbyjwggdky50ppsxlvg1fxmfd2kv67" +} diff --git a/nix-thunk/thunk.nix b/nix-thunk/thunk.nix new file mode 100644 index 0000000..20f2d28 --- /dev/null +++ b/nix-thunk/thunk.nix @@ -0,0 +1,12 @@ +# DO NOT HAND-EDIT THIS FILE +let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }: + if !fetchSubmodules && !private then builtins.fetchTarball { + url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256; + } else (import (builtins.fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/3aad50c30c826430b0270fcf8264c8c41b005403.tar.gz"; + sha256 = "0xwqsf08sywd23x0xvw4c4ghq0l28w2ki22h0bdn766i16z9q2gr"; +}) {}).fetchFromGitHub { + inherit owner repo rev sha256 fetchSubmodules private; + }; + json = builtins.fromJSON (builtins.readFile ./github.json); +in fetch json \ No newline at end of file diff --git a/nixpkgs/default.nix b/nixpkgs/default.nix new file mode 100644 index 0000000..2b4d4ab --- /dev/null +++ b/nixpkgs/default.nix @@ -0,0 +1,2 @@ +# DO NOT HAND-EDIT THIS FILE +import (import ./thunk.nix) \ No newline at end of file diff --git a/nixpkgs/github.json b/nixpkgs/github.json new file mode 100644 index 0000000..9e92377 --- /dev/null +++ b/nixpkgs/github.json @@ -0,0 +1,8 @@ +{ + "owner": "nixos", + "repo": "nixpkgs", + "branch": "nixos-25.05", + "private": false, + "rev": "ddae11e58c0c345bf66efbddbf2192ed0e58f896", + "sha256": "1g53q4i7b2qs2h1iwif9ixjlmk65mrznf322x8sl2vbjcbjq1ify" +} diff --git a/nixpkgs/thunk.nix b/nixpkgs/thunk.nix new file mode 100644 index 0000000..20f2d28 --- /dev/null +++ b/nixpkgs/thunk.nix @@ -0,0 +1,12 @@ +# DO NOT HAND-EDIT THIS FILE +let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }: + if !fetchSubmodules && !private then builtins.fetchTarball { + url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256; + } else (import (builtins.fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/3aad50c30c826430b0270fcf8264c8c41b005403.tar.gz"; + sha256 = "0xwqsf08sywd23x0xvw4c4ghq0l28w2ki22h0bdn766i16z9q2gr"; +}) {}).fetchFromGitHub { + inherit owner repo rev sha256 fetchSubmodules private; + }; + json = builtins.fromJSON (builtins.readFile ./github.json); +in fetch json \ No newline at end of file diff --git a/proto.cabal b/proto.cabal new file mode 100644 index 0000000..74f76ac --- /dev/null +++ b/proto.cabal @@ -0,0 +1,82 @@ +cabal-version: 3.0 +-- The cabal-version field refers to the version of the .cabal specification, +-- and can be different from the cabal-install (the tool) version and the +-- Cabal (the library) version you are using. As such, the Cabal (the library) +-- version used must be equal or greater than the version stated in this field. +-- Starting from the specification version 2.2, the cabal-version field must be +-- the first thing in the cabal file. + +-- Initial package description 'proto' generated by +-- 'cabal init'. For further documentation, see: +-- http://haskell.org/cabal/users-guide/ +-- +-- The name of the package. +name: proto + +-- The package version. +-- See the Haskell package versioning policy (PVP) for standards +-- guiding when and how versions should be incremented. +-- https://pvp.haskell.org +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +-- synopsis: + +-- A longer description of the package. +-- description: + +-- The license under which the package is released. +license: BSD-3-Clause + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Obsidian Systems + +-- An email address to which users can send suggestions, bug reports, and patches. +maintainer: maintainer@obsidian.systems + +-- A copyright notice. +-- copyright: +build-type: Simple + +-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README. +extra-doc-files: CHANGELOG.md + +-- Extra source files to be distributed with the package, such as examples, or a tutorial module. +-- extra-source-files: + +common warnings + ghc-options: -Wall + +library + -- Import common warning flags. + import: warnings + + -- Modules exported by the library. + exposed-modules: Diagram + + -- Modules included in this library but not exported. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + default-extensions: + ImportQualifiedPost + LambdaCase + RankNTypes + + -- Other library packages from which modules are imported. + build-depends: base ^>=4.19.2.0 + , containers + , semialign + , these + + -- Directories containing source files. + hs-source-dirs: src + + -- Base language which the package is written in. + default-language: Haskell2010 diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..cc7ba7f --- /dev/null +++ b/shell.nix @@ -0,0 +1,18 @@ +let + pkgs = import ./nixpkgs {}; + nixThunk = import ./nix-thunk {}; + haskellPackages = pkgs.haskellPackages.override { + overrides = self: super: { + }; + }; +in + pkgs.mkShell { + name = "proto"; + buildInputs = [ + pkgs.cabal-install + pkgs.ghcid + ]; + inputsFrom = [ + (haskellPackages.callCabal2nix "proto" (import ./src.nix) {}).env + ]; + } diff --git a/src.nix b/src.nix new file mode 100644 index 0000000..60039b2 --- /dev/null +++ b/src.nix @@ -0,0 +1,8 @@ +builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ + "release.nix" + ".git" + "dist" + "cabal.haskell-ci" + "cabal.project" + ".travis.yml" +])) ./. diff --git a/src/Diagram.hs b/src/Diagram.hs new file mode 100644 index 0000000..78ebe29 --- /dev/null +++ b/src/Diagram.hs @@ -0,0 +1,78 @@ +module Diagram + ( Polarity(..) + , Diagram + , empty + , insert + , InsertError(..) + ) where + +import Control.Monad +import Data.Map (Map) +import Data.Map qualified as Map +import Data.Semialign.Indexed +import Data.Set qualified as Set +import Data.Set (Set) +import Data.These + +data Polarity = Negative | Positive + deriving (Eq, Ord, Read, Show) + +-- | Diagram supporting oriented graded posets +data Diagram vtx = Diagram + { _diagram_grades :: Map vtx Int + -- ^ The grade of each vertex + , _diagram_down :: Map vtx (Map vtx Polarity) + -- ^ Only the "downward" connections. Can be thought of as "boundaries" or "faces" + , _diagram_up :: Map vtx (Map vtx Polarity) + -- ^ Only the "upward" connections. The outer vertex is what we're focused on + -- and the things in the inner map represent cells that the outer vertex is a + -- face of + } + deriving (Show, Read) + +data Direction + = Up + | Down + deriving (Eq, Ord, Read, Show) + +data InsertError vtx + = InsertError_DuplicateVertex + | InsertError_UnknownDownVertex vtx + | InsertError_DownVertexUnreachable vtx + | InsertError_DownPolarityMissing (Set Polarity) + deriving (Show, Read) + +empty :: Diagram vtx +empty = Diagram Map.empty Map.empty Map.empty + +insert + :: forall vtx. Ord vtx + => vtx + -> Int + -> Map vtx Polarity + -> Diagram vtx + -> Either (InsertError vtx) (Diagram vtx) +insert vtx grade down d = do + when (Map.member vtx $ _diagram_grades d) $ Left InsertError_DuplicateVertex + when (grade /= 0) $ do + let expectedPolarities = Set.fromList [Negative, Positive] + missingPolarities = Set.difference expectedPolarities (Set.fromList (Map.elems down)) + when (not $ Set.null missingPolarities) $ + Left $ InsertError_DownPolarityMissing missingPolarities + sequence_ $ ialignWith check (_diagram_grades d) down + let up = Map.fromList $ [ (vtx', Map.singleton vtx p) | (vtx', p) <- Map.toList down ] + return $ Diagram + { _diagram_grades = Map.insert vtx grade $ _diagram_grades d + , _diagram_down = Map.insert vtx down $ _diagram_down d + , _diagram_up = Map.unionWith Map.union up $ _diagram_up d + } + where + check + :: vtx + -> These Int Polarity + -> Either (InsertError vtx) () + check k = \case + This _ -> pure () -- Not in the down set + That _ -> Left $ InsertError_UnknownDownVertex k + These g _ | g == grade-1 -> pure () + These _ _ -> Left $ InsertError_DownVertexUnreachable k