Rename functors (N, and/or) to (Word, and/or)

This highlights the fact that they represent finite sets and the value syntax
are hexadecimal unsigned integers.

examples/bit-and

-(ℕ, and)^X
+(Word, and)^X
 
 x: {x: 0xDEADFFFF, y: 0xFFFFBEEF}
 y: {x: 0xDEADBEEF, y: 0xDEADBEEF}

src/Copar/Functors/MonoidValued.hs

 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TemplateHaskell #-}
 
 -- | This module implements the @M^X@ functor, where @M@ is a monoid that
 -- doesn't have to be a group like in "Copar.Functors.GroupValued".
@@ -20,11 +19,12 @@ module Copar.Functors.MonoidValued
   )
 where
 
-import           Data.List                      ( foldl' )
+import           Data.List                      ( foldl', intersperse )
 import           Data.Semigroup                 ( Max(..), Min(..) )
 import           Data.Functor.Classes
 import           Control.Monad
 import           Data.Foldable
+import           Data.Word
 
 import qualified Data.Vector                   as V
 import           Text.Megaparsec
@@ -47,7 +47,7 @@ import qualified Data.SumBag as SumBag
 import           Data.Bits.Monoid
 
 
-data SlowMonoidValued m a = SlowMonoidValued a
+newtype SlowMonoidValued m a = SlowMonoidValued a
 
 instance Eq1 (SlowMonoidValued m) where
   liftEq f (SlowMonoidValued a1) (SlowMonoidValued a2) = f a1 a2
@@ -63,7 +63,7 @@ deriving instance Traversable (SlowMonoidValued m)
 data MonoidValuedDescription m = MonoidValued
   { mvName :: Text
   , mvDescription :: Text
-  , mvSet :: (Text, Text) -- (ascii, unicode)
+  , mvSet :: [Text] -- often [ascii, unicode]
   , mvOperation :: Text
   , mvTerm :: Text
   }
@@ -72,7 +72,7 @@ makeMonoidValued
   :: MonoidValuedDescription m -> FunctorDescription (SlowMonoidValued m)
 makeMonoidValued desc = FunctorDescription
   { name = mvName desc <> "-valued"
-  , syntaxExample = syntax fst <> " | " <> syntax snd
+  , syntaxExample = fold (intersperse " | " (map syntax (mvSet desc)))
   , description = Just (makeMVHelp desc)
   , functorExprParser =
     prefix
@@ -80,7 +80,7 @@ makeMonoidValued desc = FunctorDescription
       -- normal if they don't contain exactly (Z, max)
       (  try
           (L.parens
-            (  (L.symbol (fst (mvSet desc)) <|> L.symbol (snd (mvSet desc)))
+            ((choice (map L.symbol (mvSet desc)))
             >> L.comma
             >> L.symbol (mvOperation desc)
             )
@@ -89,7 +89,7 @@ makeMonoidValued desc = FunctorDescription
       >> pure SlowMonoidValued
       )
   }
-  where syntax f = functorSyntax (f (mvSet desc)) (mvOperation desc)
+  where syntax x = functorSyntax x (mvOperation desc)
 
 functorSyntax :: Text -> Text -> Text
 functorSyntax s o = "(" <> s <> ", " <> o <> ")^X"
@@ -104,17 +104,17 @@ makeMVHelp desc =
                 \asymptotically slower than for the others."
   <> Doc.line <> Doc.line
   <> Doc.annotate Doc.bold "Functor syntax:"
-  <+> Doc.reflow (syntax fst <> " | " <> syntax snd)
+  <+> Doc.reflow (fold (intersperse " | " (map syntax (mvSet desc))))
   <> Doc.line <> Doc.line
   <> Doc.annotate Doc.bold "Coalgebra syntax:"
   <+> Doc.reflow ("'{' X ':' " <> mvTerm desc <> ", ... '}'")
-  where syntax f = functorSyntax (f (mvSet desc)) (mvOperation desc)
+  where syntax x = functorSyntax x (mvOperation desc)
 
 -- | The @(ℤ, max)^X@ functor
 maxIntValued :: FunctorDescription (SlowMonoidValued (Max Int))
 maxIntValued = makeMonoidValued $ MonoidValued
   { mvName = "Max"
-  , mvSet = ("Z", "ℤ")
+  , mvSet = ["Z", "ℤ"]
   , mvOperation = "max"
   , mvDescription = "the monoid (Z, max)"
   , mvTerm = "int"
@@ -124,7 +124,7 @@ maxIntValued = makeMonoidValued $ MonoidValued
 minIntValued :: FunctorDescription (SlowMonoidValued (Min Int))
 minIntValued = makeMonoidValued $ MonoidValued
   { mvName = "Min"
-  , mvSet = ("Z", "ℤ")
+  , mvSet = ["Z", "ℤ"]
   , mvOperation = "min"
   , mvDescription = "the monoid (Z, min)"
   , mvTerm = "int"
@@ -135,7 +135,7 @@ minIntValued = makeMonoidValued $ MonoidValued
 maxRealValued :: FunctorDescription (SlowMonoidValued MaxDouble)
 maxRealValued = makeMonoidValued $ MonoidValued
   { mvName = "Max"
-  , mvSet = ("R", "ℝ")
+  , mvSet = ["R", "ℝ"]
   , mvOperation = "max"
   , mvDescription = "the monoid (R, max)"
   , mvTerm = "real"
@@ -146,29 +146,29 @@ maxRealValued = makeMonoidValued $ MonoidValued
 minRealValued :: FunctorDescription (SlowMonoidValued MinDouble)
 minRealValued = makeMonoidValued $ MonoidValued
   { mvName = "Min"
-  , mvSet = ("R", "ℝ")
+  , mvSet = ["R", "ℝ"]
   , mvOperation = "min"
   , mvDescription = "the monoid (R, min)"
   , mvTerm = "real"
   }
 
 
--- | The @(ℕ, and)^X@ functor
-andWordValued :: FunctorDescription (SlowMonoidValued (BitAnd Word))
+-- | The @(Word, and)^X@ functor
+andWordValued :: FunctorDescription (SlowMonoidValued (BitAnd Word64))
 andWordValued = makeMonoidValued $ MonoidValued
   { mvName = "BitAnd"
-  , mvSet = ("N", "ℕ")
+  , mvSet = ["Word"]
   , mvOperation = "and"
   , mvDescription = "bitvectors and bitwise 'and' as monoid weight"
   , mvTerm = "0xCAFE"
   }
 
 
--- | The @(ℕ, or)^X@ functor
-orWordValued :: FunctorDescription (SlowMonoidValued (BitOr Word))
+-- | The @(Word, or)^X@ functor
+orWordValued :: FunctorDescription (SlowMonoidValued (BitOr Word64))
 orWordValued = makeMonoidValued $ MonoidValued
   { mvName = "BitOr"
-  , mvSet = ("N", "ℕ")
+  , mvSet = ["Word"]
   , mvOperation = "or"
   , mvDescription = "bitvectors and bitwise 'or' as monoid weight"
   , mvTerm = "0xCAFE"
@@ -218,10 +218,10 @@ instance ParseMorphism (SlowMonoidValued MaxDouble) where
 instance ParseMorphism (SlowMonoidValued MinDouble) where
   parseMorphismPoint = parseMorphismPointHelper (MinDouble <$> L.signed L.float)
 
-instance ParseMorphism (SlowMonoidValued (BitAnd Word)) where
+instance ParseMorphism (SlowMonoidValued (BitAnd Word64)) where
   parseMorphismPoint = parseMorphismPointHelper L.hex
 
-instance ParseMorphism (SlowMonoidValued (BitOr Word)) where
+instance ParseMorphism (SlowMonoidValued (BitOr Word64)) where
   parseMorphismPoint = parseMorphismPointHelper L.hex
 
 

tests/Copar/Functors/MonoidValuedSpec.hs

@@ -14,6 +14,7 @@ import           Data.Semigroup                 ( Max(..)
 import           Control.Monad.ST
 import           Data.Proxy
 import           Data.Void
+import           Data.Word
 
 import           Test.Hspec.Megaparsec
 import           Data.Text                      ( Text )
@@ -52,7 +53,7 @@ spec = do
 
 maxIntParseSpec :: Spec
 maxIntParseSpec = describe "maxInt parsing" $ do
-  makeFunctorParseSpec maxIntValued ("Z", "ℤ") "max"
+  makeFunctorParseSpec maxIntValued ("Z", Just "ℤ") "max"
 
   let p = makeMorphParser @(Max Int)
 
@@ -69,7 +70,7 @@ maxIntParseSpec = describe "maxInt parsing" $ do
 
 minIntParseSpec :: Spec
 minIntParseSpec = describe "minIntParse" $ do
-  makeFunctorParseSpec minIntValued ("Z", "ℤ") "min"
+  makeFunctorParseSpec minIntValued ("Z", Just "ℤ") "min"
 
   let p = makeMorphParser @(Min Int)
 
@@ -119,7 +120,7 @@ minIntRefineSpec = describe "minInt refine" $ do
 
 maxRealParseSpec :: Spec
 maxRealParseSpec = describe "maxReal parsing" $ do
-  makeFunctorParseSpec maxRealValued ("R", "ℝ") "max"
+  makeFunctorParseSpec maxRealValued ("R", Just "ℝ") "max"
 
   let p = makeMorphParser @MaxDouble
 
@@ -137,7 +138,7 @@ maxRealParseSpec = describe "maxReal parsing" $ do
 
 minRealParseSpec :: Spec
 minRealParseSpec = describe "minReal parsing" $ do
-  makeFunctorParseSpec minRealValued ("R", "ℝ") "min"
+  makeFunctorParseSpec minRealValued ("R", Just "ℝ") "min"
 
   let p = makeMorphParser @MinDouble
 
@@ -187,11 +188,11 @@ minRealRefineSpec = describe "minReal refine" $ do
 
 andWordParseSpec :: Spec
 andWordParseSpec = describe "bit-and parsing" $ do
-  makeFunctorParseSpec andWordValued ("N", "ℕ") "and"
+  makeFunctorParseSpec andWordValued ("Word", Nothing) "and"
 
-  let p = makeMorphParser @(BitAnd Word)
+  let p = makeMorphParser @(BitAnd Word64)
 
-  itParsesEmpty @(BitAnd Word)
+  itParsesEmpty @(BitAnd Word64)
 
   it "parses a simple example"
     $ p "x: {x: 0xA0, y: 0x0A}\ny: {}"
@@ -203,8 +204,8 @@ andWordParseSpec = describe "bit-and parsing" $ do
 
 andWordRefineSpec :: Spec
 andWordRefineSpec = describe "andWord refine" $ do
-  let p = makeMorphParser @(BitAnd Word)
-      proxy = Proxy @(Desorted (SlowMonoidValued (BitAnd Word)))
+  let p = makeMorphParser @(BitAnd Word64)
+      proxy = Proxy @(Desorted (SlowMonoidValued (BitAnd Word64)))
 
   it "it distinguishes different meets with equal sums" $ do
     let Right enc = p "x: {x: 0xAA, y: 0xCC}\ny: {x: 0xBB, y: 0xBB}"
@@ -219,11 +220,11 @@ andWordRefineSpec = describe "andWord refine" $ do
 
 orWordParseSpec :: Spec
 orWordParseSpec = describe "bit-or parsing" $ do
-  makeFunctorParseSpec orWordValued ("N", "ℕ") "or"
+  makeFunctorParseSpec orWordValued ("Word", Nothing) "or"
 
-  let p = makeMorphParser @(BitOr Word)
+  let p = makeMorphParser @(BitOr Word64)
 
-  itParsesEmpty @(BitOr Word)
+  itParsesEmpty @(BitOr Word64)
 
   it "parses a simple example"
     $ p "x: {x: 0xA0, y: 0x0A}\ny: {}"
@@ -235,8 +236,8 @@ orWordParseSpec = describe "bit-or parsing" $ do
 
 orWordRefineSpec :: Spec
 orWordRefineSpec = describe "orWord refine" $ do
-  let p = makeMorphParser @(BitOr Word)
-      proxy = Proxy @(Desorted (SlowMonoidValued (BitOr Word)))
+  let p = makeMorphParser @(BitOr Word64)
+      proxy = Proxy @(Desorted (SlowMonoidValued (BitOr Word64)))
 
   it "it distinguishes different joins with equal sums" $ do
     let Right enc = p "x: {x: 0xAA, y: 0xCC}\ny: {x: 0xBB, y: 0xBB}"
@@ -250,7 +251,7 @@ orWordRefineSpec = describe "orWord refine" $ do
 
 
 makeFunctorParseSpec :: FunctorDescription (SlowMonoidValued m)
-                          -> (Text, Text)
+                          -> (Text, Maybe Text)
                           -> Text
                           -> Spec
 makeFunctorParseSpec functor (setAscii, setUnicode) operation = do
@@ -259,10 +260,13 @@ makeFunctorParseSpec functor (setAscii, setUnicode) operation = do
     $ parseFunctorExpression [[functorExprParser functor]] "" expr
     `shouldParse` (Functor 1 (SlowMonoidValued Variable))
 
-  let expr = syntax setUnicode operation "X"
-  it ("can parse " <> T.unpack expr <> " as functor expression")
-    $ parseFunctorExpression [[functorExprParser functor]] "" expr
-    `shouldParse` (Functor 1 (SlowMonoidValued Variable))
+  case setUnicode of
+    Nothing -> return ()
+    Just set -> do
+      let expr = syntax set operation "X"
+      it ("can parse " <> T.unpack expr <> " as functor expression")
+        $ parseFunctorExpression [[functorExprParser functor]] "" expr
+        `shouldParse` (Functor 1 (SlowMonoidValued Variable))
 
   it "nests correctly in functor expressions"
     $ parseFunctorExpression [[functorExprParser functor]]