Port Enum parts of generics-rep to this repo

src/Data/Enum/Generic.purs

@@ -0,0 +1,118 @@
+module Data.Enum.Generic 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(..), Product(..), Sum(..), from, to)
+import Data.Bounded.Generic (class GenericBottom, class GenericTop, genericBottom', genericTop')
+import Data.Maybe (Maybe(..))
+import Data.Newtype (unwrap)
+
+class GenericEnum a where
+  genericPred' :: a -> Maybe a
+  genericSucc' :: a -> Maybe a
+
+instance genericEnumNoArguments :: GenericEnum NoArguments where
+  genericPred' _ = Nothing
+  genericSucc' _ = Nothing
+
+instance genericEnumArgument :: Enum a => GenericEnum (Argument a) where
+  genericPred' (Argument a) = Argument <$> pred a
+  genericSucc' (Argument a) = Argument <$> succ a
+
+instance genericEnumConstructor :: GenericEnum a => GenericEnum (Constructor name a) where
+  genericPred' (Constructor a) = Constructor <$> genericPred' a
+  genericSucc' (Constructor a) = Constructor <$> genericSucc' a
+
+instance genericEnumSum :: (GenericEnum a, GenericTop a, GenericEnum b, GenericBottom b) => GenericEnum (Sum a b) where
+  genericPred' = case _ of
+    Inl a -> Inl <$> genericPred' a
+    Inr b -> case genericPred' b of
+      Nothing -> Just (Inl genericTop')
+      Just b' -> Just (Inr b')
+  genericSucc' = case _ of
+    Inl a -> case genericSucc' a of
+      Nothing -> Just (Inr genericBottom')
+      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
+
+-- | A `Generic` implementation of the `succ` member from the `Enum` type class.
+genericSucc :: forall a rep. Generic a rep => GenericEnum rep => a -> Maybe a
+genericSucc = map to <<< genericSucc' <<< from
+
+class GenericBoundedEnum a where
+  genericCardinality' :: Cardinality a
+  genericToEnum' :: Int -> Maybe a
+  genericFromEnum' :: a -> Int
+
+instance genericBoundedEnumNoArguments :: GenericBoundedEnum NoArguments where
+  genericCardinality' = Cardinality 1
+  genericToEnum' i = if i == 0 then Just NoArguments else Nothing
+  genericFromEnum' _ = 0
+
+instance genericBoundedEnumArgument :: BoundedEnum a => GenericBoundedEnum (Argument a) where
+  genericCardinality' = Cardinality (unwrap (cardinality :: Cardinality a))
+  genericToEnum' i = Argument <$> toEnum i
+  genericFromEnum' (Argument a) = fromEnum a
+
+instance genericBoundedEnumConstructor :: GenericBoundedEnum a => GenericBoundedEnum (Constructor name a) where
+  genericCardinality' = Cardinality (unwrap (genericCardinality' :: Cardinality a))
+  genericToEnum' i = Constructor <$> genericToEnum' i
+  genericFromEnum' (Constructor a) = genericFromEnum' a
+
+instance genericBoundedEnumSum :: (GenericBoundedEnum a, GenericBoundedEnum b) => GenericBoundedEnum (Sum a b) where
+  genericCardinality' =
+    Cardinality
+      $ unwrap (genericCardinality' :: Cardinality a)
+      + unwrap (genericCardinality' :: Cardinality b)
+  genericToEnum' n = to genericCardinality'
+    where
+    to :: Cardinality a -> Maybe (Sum a b)
+    to (Cardinality ca)
+      | n >= 0 && n < ca = Inl <$> genericToEnum' n
+      | otherwise = Inr <$> genericToEnum' (n - ca)
+  genericFromEnum' = case _ of
+    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
+genericCardinality = Cardinality (unwrap (genericCardinality' :: Cardinality rep))
+
+-- | A `Generic` implementation of the `toEnum` member from the `BoundedEnum`
+-- | type class.
+genericToEnum :: forall a rep. Generic a rep => GenericBoundedEnum rep => Int -> Maybe a
+genericToEnum = map to <<< genericToEnum'
+
+-- | A `Generic` implementation of the `fromEnum` member from the `BoundedEnum`
+-- | type class.
+genericFromEnum :: forall a rep. Generic a rep => GenericBoundedEnum rep => a -> Int
+genericFromEnum = genericFromEnum' <<< from

test/Main.purs

@@ -4,6 +4,9 @@ import Prelude
 
 import Effect (Effect)
 import Test.Data.Enum (testEnum)
+import Test.Data.Enum.Generic (testGenericEnum)
 
 main :: Effect Unit
-main = testEnum
+main = do
+  testEnum
+  testGenericEnum

test/Test/Data/Enum/Generic.purs

@@ -0,0 +1,150 @@
+module Test.Data.Enum.Generic where
+
+import Prelude
+
+import Data.Enum (class BoundedEnum, class Enum, Cardinality(..), cardinality, fromEnum, pred, succ, toEnum, enumFromTo)
+import Data.Generic.Rep as G
+import Data.Bounded.Generic as GBounded
+import Data.Enum.Generic as GEnum
+import Data.Eq.Generic as GEq
+import Data.Ord.Generic as GOrd
+import Data.Show.Generic as GShow
+import Data.Maybe (Maybe(..))
+import Effect (Effect)
+import Effect.Console (log)
+import Test.Assert (assert)
+
+data SimpleBounded = A | B | C | D
+derive instance genericSimpleBounded :: G.Generic SimpleBounded _
+instance eqSimpleBounded :: Eq SimpleBounded where
+  eq x y = GEq.genericEq x y
+instance ordSimpleBounded :: Ord SimpleBounded where
+  compare x y = GOrd.genericCompare x y
+instance showSimpleBounded :: Show SimpleBounded where
+  show x = GShow.genericShow x
+instance boundedSimpleBounded :: Bounded SimpleBounded where
+  bottom = GBounded.genericBottom
+  top = GBounded.genericTop
+instance enumSimpleBounded :: Enum SimpleBounded where
+  pred = GEnum.genericPred
+  succ = GEnum.genericSucc
+instance boundedEnumSimpleBounded :: BoundedEnum SimpleBounded where
+  cardinality = GEnum.genericCardinality
+  toEnum = GEnum.genericToEnum
+  fromEnum = GEnum.genericFromEnum
+
+data Option a = None | Some a
+derive instance genericOption :: G.Generic (Option a) _
+instance eqOption :: Eq a => Eq (Option a) where
+  eq x y = GEq.genericEq x y
+instance ordOption :: Ord a => Ord (Option a) where
+  compare x y = GOrd.genericCompare x y
+instance showOption :: Show a => Show (Option a) where
+  show x = GShow.genericShow x
+instance boundedOption :: Bounded a => Bounded (Option a) where
+  bottom = GBounded.genericBottom
+  top = GBounded.genericTop
+instance enumOption :: (Bounded a, Enum a) => Enum (Option a) where
+  pred = GEnum.genericPred
+  succ = GEnum.genericSucc
+instance boundedEnumOption :: BoundedEnum a => BoundedEnum (Option a) where
+  cardinality = GEnum.genericCardinality
+  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
+
+testGenericEnum :: Effect Unit
+testGenericEnum = do
+  log "Checking simple pred bottom"
+  assert $ pred (bottom :: SimpleBounded) == Nothing
+
+  log "Checking simple (pred =<< succ bottom)"
+  assert $ (pred =<< succ bottom) == Just A
+
+  log "Checking simple succ top"
+  assert $ succ (top :: SimpleBounded) == Nothing
+
+  log "Checking simple (succ =<< pred top)"
+  assert $ (succ =<< pred top) == Just D
+
+  log "Checking composite pred bottom"
+  assert $ pred (bottom :: Option SimpleBounded) == Nothing
+
+  log "Checking composite (pred =<< succ bottom)"
+  assert $ (pred =<< succ (bottom :: Option SimpleBounded)) == Just None
+
+  log "Checking composite succ top"
+  assert $ succ (top :: Option SimpleBounded) == Nothing
+
+  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)