Merge pull request #16 from jacereda/master

Product instances in Bounded and Enum

Author: paf31

src/Data/Generic/Rep/Bounded.purs

@@ -23,6 +23,9 @@ instance genericBottomArgument :: Bounded a => GenericBottom (Argument a) where
 instance genericBottomSum :: GenericBottom a => GenericBottom (Sum a b) where
   genericBottom' = Inl genericBottom'
 
+instance genericBottomProduct :: (GenericBottom a, GenericBottom b) => GenericBottom (Product a b) where
+  genericBottom' = Product genericBottom' genericBottom'
+
 instance genericBottomConstructor :: GenericBottom a => GenericBottom (Constructor name a) where
   genericBottom' = Constructor genericBottom'
 
@@ -38,6 +41,9 @@ instance genericTopArgument :: Bounded a => GenericTop (Argument a) where
 instance genericTopSum :: GenericTop b => GenericTop (Sum a b) where
   genericTop' = Inr genericTop'
 
+instance genericTopProduct :: (GenericTop a, GenericTop b) => GenericTop (Product a b) where
+  genericTop' = Product genericTop' genericTop'
+
 instance genericTopConstructor :: GenericTop a => GenericTop (Constructor name a) where
   genericTop' = Constructor genericTop'
 

src/Data/Generic/Rep/Enum.purs

@@ -3,7 +3,7 @@ module Data.Generic.Rep.Enum where
 import Prelude
 
 import Data.Enum (class BoundedEnum, class Enum, Cardinality(..), cardinality, fromEnum, pred, succ, toEnum)
-import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Sum(..), from, to)
+import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), Sum(..), from, to)
 import Data.Generic.Rep.Bounded (class GenericBottom, class GenericTop, genericBottom', genericTop')
 import Data.Maybe (Maybe(..))
 import Data.Newtype (unwrap)
@@ -36,6 +36,15 @@ instance genericEnumSum :: (GenericEnum a, GenericTop a, GenericEnum b, GenericB
       Just a' -> Just (Inl a')
     Inr b -> Inr <$> genericSucc' b
 
+instance genericEnumProduct :: (GenericEnum a, GenericTop a, GenericBottom a, GenericEnum b, GenericTop b, GenericBottom b) => GenericEnum (Product a b) where
+  genericPred' (Product a b) = case genericPred' b of
+    Just p -> Just $ Product a p
+    Nothing -> flip Product genericTop' <$> genericPred' a
+  genericSucc' (Product a b) = case genericSucc' b of
+    Just s -> Just $ Product a s
+    Nothing -> flip Product genericBottom' <$> genericSucc' a
+
+
 -- | A `Generic` implementation of the `pred` member from the `Enum` type class.
 genericPred :: forall a rep. Generic a rep => GenericEnum rep => a -> Maybe a
 genericPred = map to <<< genericPred' <<< from
@@ -79,6 +88,20 @@ instance genericBoundedEnumSum :: (GenericBoundedEnum a, GenericBoundedEnum b) =
     Inl a -> genericFromEnum' a
     Inr b -> genericFromEnum' b + unwrap (genericCardinality' :: Cardinality a)
 
+
+instance genericBoundedEnumProduct :: (GenericBoundedEnum a, GenericBoundedEnum b) => GenericBoundedEnum (Product a b) where
+  genericCardinality' =
+    Cardinality
+      $ unwrap (genericCardinality' :: Cardinality a)
+      * unwrap (genericCardinality' :: Cardinality b)
+  genericToEnum' n = to genericCardinality'
+    where to :: Cardinality b -> Maybe (Product a b)
+          to (Cardinality cb) = Product <$> (genericToEnum' $ n `div` cb) <*> (genericToEnum' $ n `mod` cb)
+  genericFromEnum' = from genericCardinality'
+    where from :: Cardinality b -> (Product a b) -> Int
+          from (Cardinality cb) (Product a b) = genericFromEnum' a * cb + genericFromEnum' b
+
+
 -- | A `Generic` implementation of the `cardinality` member from the
 -- | `BoundedEnum` type class.
 genericCardinality :: forall a rep. Generic a rep => GenericBoundedEnum rep => Cardinality a

test/Main.purs

@@ -4,7 +4,7 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log, logShow)
-import Data.Enum (class BoundedEnum, class Enum, Cardinality(..), cardinality, fromEnum, pred, succ, toEnum)
+import Data.Enum (class BoundedEnum, class Enum, Cardinality(..), cardinality, fromEnum, pred, succ, toEnum, enumFromTo)
 import Data.Generic.Rep as G
 import Data.Generic.Rep.Bounded as GBounded
 import Data.Generic.Rep.Enum as GEnum
@@ -68,6 +68,45 @@ instance boundedEnumOption :: BoundedEnum a => BoundedEnum (Option a) where
   toEnum = GEnum.genericToEnum
   fromEnum = GEnum.genericFromEnum
 
+data Bit = Zero | One
+derive instance genericBit :: G.Generic Bit _
+instance eqBit :: Eq Bit where
+  eq x y = GEq.genericEq x y
+instance ordBit :: Ord Bit where
+  compare x y = GOrd.genericCompare x y
+instance showBit :: Show Bit where
+  show x = GShow.genericShow x
+instance boundedBit :: Bounded Bit where
+  bottom = GBounded.genericBottom
+  top = GBounded.genericTop
+instance enumBit :: Enum Bit where
+  pred = GEnum.genericPred
+  succ = GEnum.genericSucc
+instance boundedEnumBit :: BoundedEnum Bit where
+  cardinality = GEnum.genericCardinality
+  toEnum = GEnum.genericToEnum
+  fromEnum = GEnum.genericFromEnum
+
+data Pair a b = Pair a b
+derive instance genericPair :: G.Generic (Pair a b) _
+instance eqPair :: (Eq a, Eq b) => Eq (Pair a b) where
+  eq = GEq.genericEq
+instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where
+  compare = GOrd.genericCompare
+instance showPair :: (Show a, Show b) => Show (Pair a b) where
+  show = GShow.genericShow
+instance boundedPair :: (Bounded a, Bounded b) => Bounded (Pair a b) where
+  bottom = GBounded.genericBottom
+  top = GBounded.genericTop
+instance enumPair :: (Bounded a, Enum a, Bounded b, Enum b) => Enum (Pair a b) where
+  pred = GEnum.genericPred
+  succ = GEnum.genericSucc
+instance boundedEnumPair :: (BoundedEnum a, BoundedEnum b) => BoundedEnum (Pair a b) where
+  cardinality = GEnum.genericCardinality
+  toEnum = GEnum.genericToEnum
+  fromEnum = GEnum.genericFromEnum
+  
+
 main :: Eff (console :: CONSOLE, assert :: ASSERT) Unit
 main = do
   logShow (cons 1 (cons 2 Nil))
@@ -99,6 +138,12 @@ main = do
   log "Checking composite top"
   assert $ top == Some D
 
+  log "Checking product bottom"
+  assert $ bottom == Pair Zero A :: Pair Bit SimpleBounded
+
+  log "Checking product top"
+  assert $ top == Pair One D :: Pair Bit SimpleBounded
+
   log "Checking simple pred bottom"
   assert $ pred (bottom :: SimpleBounded) == Nothing
 
@@ -123,16 +168,35 @@ main = do
   log "Checking composite (succ =<< pred top)"
   assert $ (succ =<< pred top) == Just (Some D)
 
+  log "Checking product pred bottom"
+  assert $ pred (bottom :: Pair Bit SimpleBounded) == Nothing
+
+  log "Checking product (pred =<< succ bottom)"
+  assert $ (pred =<< succ (bottom :: Pair Bit SimpleBounded)) == Just (Pair Zero A)
+
+  log "Checking product succ top"
+  assert $ succ (top :: Pair Bit SimpleBounded) == Nothing
+
+  log "Checking product (succ =<< pred top)"
+  assert $ (succ =<< pred top) == Just (Pair One D)
+
   log "Checking simple cardinality"
   assert $ (cardinality :: Cardinality SimpleBounded) == Cardinality 4
 
   log "Checking composite cardinality"
   assert $ (cardinality :: Cardinality (Option SimpleBounded)) == Cardinality 5
 
+  log "Checking product cardinality"
+  assert $ (cardinality :: Cardinality (Pair Bit SimpleBounded)) == Cardinality 8
+
   log "Checking simple toEnum/fromEnum roundtrip"
   assert $ toEnum (fromEnum A) == Just A
   assert $ toEnum (fromEnum B) == Just B
 
   log "Checking composite toEnum/fromEnum roundtrip"
   assert $ toEnum (fromEnum (None :: Option SimpleBounded)) == Just (None :: Option SimpleBounded)
   assert $ toEnum (fromEnum (Some A)) == Just (Some A)
+
+  log "Checking product toEnum/fromEnum roundtrip"
+  assert $ let allPairs = enumFromTo bottom top :: Array (Pair Bit SimpleBounded)
+           in toEnum <<< fromEnum <$> allPairs == Just <$> allPairs