moonlight-algebra 0.1.0.2 → 0.1.1.0

raw patch · 4 files changed

+141/−84 lines, 4 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• moonlight-algebra.cabal +19/−1
• src-abstract/Moonlight/Algebra/Pure/Lattice.hs +7/−83
• src-join/Moonlight/Algebra/Pure/Join.hs +109/−0

@@ -1,5 +1,11 @@ # Changelog +## 0.1.1.0 - 2026-09-23++- Extract the existing join-semilattice law and standard instances into the+  dependency-light public `join` sublibrary. The full lattice tower reexports+  that exact owner rather than compiling a second class.+ ## 0.1.0.2 - 2026-08-21  - Add the public quantale tower: `Quantale`, commutative, residuated, integral,

@@ -1,6 +1,6 @@ cabal-version:       3.4 name:                moonlight-algebra-version:             0.1.0.2+version:             0.1.1.0 homepage:            https://github.com/PaleRoses/moonlight bug-reports:         https://github.com/PaleRoses/moonlight/issues synopsis:            Algebraic type class tower for Pale Meridian.@@ -23,6 +23,12 @@   location: https://github.com/PaleRoses/moonlight.git   subdir:   moonlight-algebra +source-repository this+  type:     git+  location: https://github.com/PaleRoses/moonlight.git+  tag:      moonlight-algebra-0.1.1.0+  subdir:   moonlight-algebra+ common shared-properties   default-language: GHC2024   ghc-options:@@ -37,6 +43,17 @@     TypeFamilies     UndecidableInstances +library join+  import: shared-properties+  default-language: GHC2021+  visibility: public+  hs-source-dirs: src-join+  exposed-modules:+    Moonlight.Algebra.Pure.Join+  build-depends:+    base >= 4.19 && < 5+    , containers >= 0.6 && < 0.9+ library abstract   import: shared-properties   visibility: public@@ -65,6 +82,7 @@   build-depends:     base >= 4.22 && < 5     , containers >= 0.6 && < 0.9+    , moonlight-algebra:join     , moonlight-algebra:moonlight-algebra-internal     , moonlight-core >= 0.1 && < 0.2     , vector >= 0.13 && < 0.14

@@ -41,6 +41,13 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Map.Strict qualified as Map import Data.Set qualified as Set+import Moonlight.Algebra.Pure.Join+  ( BoundedJoinSemilattice (..)+  , Join (..)+  , JoinSemilattice (..)+  , joins+  , joins1+  ) import Moonlight.Core   ( FixpointDivergence (..),     PartialOrder,@@ -50,85 +57,10 @@   ( Natural,   ) -type Join :: Type -> Type-newtype Join a = Join {getJoin :: a}-  deriving stock (Eq, Ord, Show)- type Meet :: Type -> Type newtype Meet a = Meet {getMeet :: a}   deriving stock (Eq, Ord, Show) -type JoinSemilattice :: Type -> Constraint-class JoinSemilattice a where-  join :: a -> a -> a--instance JoinSemilattice () where-  join _ _ = ()--instance JoinSemilattice Bool where-  join = (||)--instance Ord a => JoinSemilattice (Set.Set a) where-  join = Set.union--instance JoinSemilattice IntSet.IntSet where-  join = IntSet.union--instance (Ord key, JoinSemilattice value) => JoinSemilattice (Map.Map key value) where-  join = Map.unionWith join--instance JoinSemilattice value => JoinSemilattice (IntMap.IntMap value) where-  join = IntMap.unionWith join--instance (JoinSemilattice left, JoinSemilattice right) => JoinSemilattice (left, right) where-  join (leftA, rightA) (leftB, rightB) =-    (join leftA leftB, join rightA rightB)--instance JoinSemilattice value => JoinSemilattice (key -> value) where-  join left right key =-    join (left key) (right key)--instance JoinSemilattice a => Semigroup (Join a) where-  Join left <> Join right =-    Join (join left right)--type BoundedJoinSemilattice :: Type -> Constraint-class JoinSemilattice a => BoundedJoinSemilattice a where-  bottom :: a--instance BoundedJoinSemilattice () where-  bottom = ()--instance BoundedJoinSemilattice Bool where-  bottom = False--instance Ord a => BoundedJoinSemilattice (Set.Set a) where-  bottom = Set.empty--instance BoundedJoinSemilattice IntSet.IntSet where-  bottom = IntSet.empty--instance (Ord key, JoinSemilattice value) => BoundedJoinSemilattice (Map.Map key value) where-  bottom = Map.empty--instance JoinSemilattice value => BoundedJoinSemilattice (IntMap.IntMap value) where-  bottom = IntMap.empty--instance-  (BoundedJoinSemilattice left, BoundedJoinSemilattice right) =>-  BoundedJoinSemilattice (left, right)-  where-  bottom =-    (bottom, bottom)--instance BoundedJoinSemilattice value => BoundedJoinSemilattice (key -> value) where-  bottom =-    const bottom--instance BoundedJoinSemilattice a => Monoid (Join a) where-  mempty =-    Join bottom- type MeetSemilattice :: Type -> Constraint class MeetSemilattice a where   meet :: a -> a -> a@@ -380,14 +312,6 @@ meetLeq :: (Eq a, MeetSemilattice a) => a -> a -> Bool meetLeq left right =   meet left right == left--joins :: (BoundedJoinSemilattice a, Foldable foldable) => foldable a -> a-joins =-  foldl' join bottom--joins1 :: JoinSemilattice a => NonEmpty a -> a-joins1 (first :| rest) =-  foldl' join first rest  meets :: (BoundedMeetSemilattice a, Foldable foldable) => foldable a -> a meets =

@@ -0,0 +1,109 @@+{-# LANGUAGE DerivingStrategies #-}++-- | The dependency-light join-semilattice owner.+--+-- 'join' is associative, commutative, and idempotent. 'bottom' is its+-- identity. Instances are laws, not merely binary combining strategies.+module Moonlight.Algebra.Pure.Join+  ( JoinSemilattice (..)+  , BoundedJoinSemilattice (..)+  , Join (..)+  , joins+  , joins1+  ) where++import Data.IntMap.Strict qualified as IntMap+import Data.IntSet qualified as IntSet+import Data.Foldable qualified as Foldable+import Data.Kind (Constraint, Type)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set++-- | Select the join operation as a standard 'Semigroup' or 'Monoid'.+type Join :: Type -> Type+newtype Join a = Join {getJoin :: a}+  deriving stock (Eq, Ord, Show)++type JoinSemilattice :: Type -> Constraint+-- | Values admitting a lawful least upper bound.+class JoinSemilattice a where+  -- | Associative, commutative, and idempotent join.+  join :: a -> a -> a++instance JoinSemilattice () where+  join _ _ = ()++instance JoinSemilattice Bool where+  join = (||)++instance Ord a => JoinSemilattice (Set.Set a) where+  join = Set.union++instance JoinSemilattice IntSet.IntSet where+  join = IntSet.union++instance (Ord key, JoinSemilattice value) => JoinSemilattice (Map.Map key value) where+  join = Map.unionWith join++instance JoinSemilattice value => JoinSemilattice (IntMap.IntMap value) where+  join = IntMap.unionWith join++instance (JoinSemilattice left, JoinSemilattice right) => JoinSemilattice (left, right) where+  join (leftA, rightA) (leftB, rightB) =+    (join leftA leftB, join rightA rightB)++instance JoinSemilattice value => JoinSemilattice (key -> value) where+  join left right key =+    join (left key) (right key)++instance JoinSemilattice a => Semigroup (Join a) where+  Join left <> Join right =+    Join (join left right)++type BoundedJoinSemilattice :: Type -> Constraint+-- | A join-semilattice with an identity element.+class JoinSemilattice a => BoundedJoinSemilattice a where+  -- | The least element: @join bottom value == value@.+  bottom :: a++instance BoundedJoinSemilattice () where+  bottom = ()++instance BoundedJoinSemilattice Bool where+  bottom = False++instance Ord a => BoundedJoinSemilattice (Set.Set a) where+  bottom = Set.empty++instance BoundedJoinSemilattice IntSet.IntSet where+  bottom = IntSet.empty++instance (Ord key, JoinSemilattice value) => BoundedJoinSemilattice (Map.Map key value) where+  bottom = Map.empty++instance JoinSemilattice value => BoundedJoinSemilattice (IntMap.IntMap value) where+  bottom = IntMap.empty++instance+  (BoundedJoinSemilattice left, BoundedJoinSemilattice right) =>+  BoundedJoinSemilattice (left, right)+  where+  bottom =+    (bottom, bottom)++instance BoundedJoinSemilattice value => BoundedJoinSemilattice (key -> value) where+  bottom =+    const bottom++instance BoundedJoinSemilattice a => Monoid (Join a) where+  mempty =+    Join bottom++joins :: (BoundedJoinSemilattice a, Foldable foldable) => foldable a -> a+joins =+  Foldable.foldl' join bottom++joins1 :: JoinSemilattice a => NonEmpty a -> a+joins1 (first :| rest) =+  Foldable.foldl' join first rest