From 396de9819a288bf21ff8d1f4a1bd866a276bbf4e Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic-base@sourcephile.fr>
Date: Fri, 8 Oct 2021 15:58:55 +0200
Subject: [PATCH] iface: add classes `Emptyable` and `Semigroupable`
---
.hlint.yaml | 3 +++
src/Symantic/Class.hs | 26 ++++++++++++++++++++++++++
src/Symantic/Data.hs | 28 ++++++++++++++++++++++++++++
3 files changed, 57 insertions(+)
diff --git a/.hlint.yaml b/.hlint.yaml
index a444158..f8d02d8 100644
--- a/.hlint.yaml
+++ b/.hlint.yaml
@@ -27,6 +27,9 @@
- fixity: "infixr 4 <*&>"
- fixity: "infixr 4 <+&>"
- fixity: "infixr 4 <?&>"
+- fixity: "infixr 4 `Concat`"
- fixity: "infixr 4 `Cons`"
+- fixity: "infixr 6 <>"
+- fixity: "infixr 6 `concat`"
- fixity: "infixr 8 -->"
# END: generated hints
diff --git a/src/Symantic/Class.hs b/src/Symantic/Class.hs
index e947e9e..75216a6 100644
--- a/src/Symantic/Class.hs
+++ b/src/Symantic/Class.hs
@@ -11,6 +11,7 @@ import Data.Eq (Eq)
import Data.Kind (Type)
import Data.Maybe (Maybe(..), fromJust)
import Data.Proxy (Proxy(..))
+import Data.Semigroup (Semigroup)
import GHC.Generics (Generic)
import qualified Control.Category as Cat
import qualified Data.Function as Fun
@@ -256,6 +257,16 @@ adt ::
repr adt
adt = (<%>) (Iso adtOfeot eotOfadt)
+-- * Class 'Monoidable'
+class
+ ( Emptyable repr
+ , Semigroupable repr
+ ) => Monoidable repr
+instance
+ ( Emptyable repr
+ , Semigroupable repr
+ ) => Monoidable repr
+
-- ** Class 'Emptyable'
class Emptyable repr where
empty :: repr a
@@ -264,6 +275,21 @@ class Emptyable repr where
FromDerived Emptyable repr =>
repr a
+-- ** Class 'Semigroupable'
+class Semigroupable repr where
+ concat :: Semigroup a => repr (a -> a -> a)
+ concat = liftDerived concat
+ default concat ::
+ FromDerived Semigroupable repr =>
+ Semigroup a =>
+ repr (a -> a -> a)
+
+infixr 6 `concat`, <>
+(<>) ::
+ Abstractable repr => Semigroupable repr => Semigroup a =>
+ repr a -> repr a -> repr a
+(<>) x y = concat .@ x .@ y
+
-- ** Class 'Optionable'
class Optionable repr where
option :: repr a -> repr a
diff --git a/src/Symantic/Data.hs b/src/Symantic/Data.hs
index de8b081..0b72682 100644
--- a/src/Symantic/Data.hs
+++ b/src/Symantic/Data.hs
@@ -10,6 +10,7 @@ import Data.Bool (Bool)
import Data.Either (Either)
import Data.Kind (Constraint)
import Data.Maybe (Maybe)
+import Data.Semigroup (Semigroup)
import Type.Reflection (Typeable, (:~~:)(..), eqTypeRep, typeRep)
import qualified Data.Eq as Eq
import qualified Data.Function as Fun
@@ -150,6 +151,33 @@ instance
instance Equalable (Data Equalable repr) where
equal = Equal
+-- Emptyable
+data instance Data Emptyable repr a where
+ Empty :: Data Emptyable repr a
+instance Emptyable repr => Derivable (Data Emptyable repr) where
+ derive = \case
+ Empty -> empty
+instance
+ ( Emptyable repr
+ ) => Emptyable (SomeData repr) where
+ empty = SomeData Empty
+instance Emptyable (Data Emptyable repr) where
+ empty = Empty
+
+-- Semigroupable
+data instance Data Semigroupable repr a where
+ Concat :: Semigroup a => Data Semigroupable repr (a -> a -> a)
+infixr 4 `Concat`
+instance Semigroupable repr => Derivable (Data Semigroupable repr) where
+ derive = \case
+ Concat -> concat
+instance
+ ( Semigroupable repr
+ ) => Semigroupable (SomeData repr) where
+ concat = SomeData Concat
+instance Semigroupable (Data Semigroupable repr) where
+ concat = Concat
+
-- IfThenElseable
data instance Data IfThenElseable repr a where
IfThenElse ::
--
2.47.2