From b6348eef442552aa4598118e5fc196fa8561b224 Mon Sep 17 00:00:00 2001
From: Matteo Bongiovanni <40599507+MatBon01@users.noreply.github.com>
Date: Thu, 6 Apr 2023 14:50:45 +0100
Subject: [PATCH] Create pointed set (#31)

* Define PointedSet type class

* Add PointedSet to cabal file

* Fix quantification of PointedSet module name

* Define a Bag as a PointedSet
---
 ...into-relational-algebra-by-way-of-adjunctions.cabal |  4 ++--
 src/Data/Bag.hs                                        |  9 +++++++++
 src/Data/PointedSet.hs                                 |  5 +++++
 test/Data/BagSpec.hs                                   | 10 ++++++++++
 4 files changed, 26 insertions(+), 2 deletions(-)
 create mode 100644 src/Data/PointedSet.hs

diff --git a/a-deeper-dive-into-relational-algebra-by-way-of-adjunctions.cabal b/a-deeper-dive-into-relational-algebra-by-way-of-adjunctions.cabal
index 64eedca..8c16232 100644
--- a/a-deeper-dive-into-relational-algebra-by-way-of-adjunctions.cabal
+++ b/a-deeper-dive-into-relational-algebra-by-way-of-adjunctions.cabal
@@ -22,10 +22,10 @@ extra-source-files:
     README.md
 
 library
-    exposed-modules: Data.Bag
+    exposed-modules: Data.Bag, Data.PointedSet, Data.CMonoid
 
     -- Modules included in this library but not exported.
-    other-modules: Data.CMonoid
+    -- other-modules:
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
diff --git a/src/Data/Bag.hs b/src/Data/Bag.hs
index 00668e4..ed1bcc2 100644
--- a/src/Data/Bag.hs
+++ b/src/Data/Bag.hs
@@ -1,7 +1,9 @@
+{-# LANGUAGE InstanceSigs #-}
 module Data.Bag where
 
 import Data.List
 import Data.CMonoid
+import qualified Data.PointedSet as Pointed
 
 newtype Bag a = Bag {elements :: [a]}
   deriving (Show)
@@ -34,6 +36,13 @@ instance Monoid (Bag a) where
 
 instance CMonoid (Bag a)
 
+instance Pointed.PointedSet (Bag a) where
+  null = empty
+  isNull :: Bag a -> Bool
+  -- Implement isNull with pattern matching to not require Eq a
+  isNull (Bag []) = True
+  isNull _ = False
+
 empty :: Bag a
 empty = Bag []
 
diff --git a/src/Data/PointedSet.hs b/src/Data/PointedSet.hs
new file mode 100644
index 0000000..df4d4f7
--- /dev/null
+++ b/src/Data/PointedSet.hs
@@ -0,0 +1,5 @@
+module Data.PointedSet where
+
+class PointedSet a where
+  null :: a
+  isNull :: a -> Bool
diff --git a/test/Data/BagSpec.hs b/test/Data/BagSpec.hs
index b73aca1..2dbd91b 100644
--- a/test/Data/BagSpec.hs
+++ b/test/Data/BagSpec.hs
@@ -2,6 +2,7 @@ module Data.BagSpec (spec) where
 
 import Test.Hspec
 import qualified Data.Bag as Bag
+import qualified Data.PointedSet as Pointed
 
 import Control.Applicative
 
@@ -66,6 +67,15 @@ spec = do
   describe "Data.Bag CMonoid" $ do
     it "has a commutative operator <>" $ do
       (b1 <> b2) `shouldBe` (b2 <> b1)
+  describe "Data.Bag Pointed Set" $ do
+    it "has empty as its null" $ do
+      (Pointed.null :: Bag.Bag Int) `shouldBe` (Bag.empty :: Bag.Bag Int)
+    it "has mempty as its null" $ do
+      (Pointed.null :: Bag.Bag Char) `shouldBe` (mempty :: Bag.Bag Char)
+    it "correctly identifies null" $ do
+      Pointed.isNull (Bag.empty :: Bag.Bag Int) `shouldBe` True
+    it "does not identify a non-empty Bag as null" $ do
+      Pointed.isNull (Bag.Bag [1, 2, 4]) `shouldBe` False
     where
       b1 = Bag.Bag ['a', 'b', 'c']
       b2 = Bag.Bag ['b', 'c', 'd']