Skip to content

Commit cd8c0d3

Browse files
JordanMartinezpaf31matthewleongarybLiamGoodacre
authored
Port Enum parts of generics-rep to this repo (#46)
* first commit * Fix instances for record fields * Break modules up * Deriving Show (#5) * Initial work on deriving Show * Add test for Show * Remove import * Travis etc. * Data.Generic.Rep.Bounded (#6) * Data.Generic.Rep.Bounded Generic implementations of Prelude.Bounded class's top and bottom. * GenericBounded - don't support product types * GenericBounded - only support NoArguments * Update for PureScript 0.11 * Add Generic instance for Maybe (#9) * Add missing Bounded instances for Argument * Add GenericEnum and GenericBoundedEnum * Add enum tests, convert existing "tests" into assertions * Product instances in Bounded and Enum * Added GenericShowFields instances for NoConstructors and NoArguments (#20) * Added Eq and Show instances to NoArguments and NoConstructors * Added GenericShowFields * Removed Show, Eq * Cleanup * Removed NoConstructors Show instance * Remove Rec and Field & update package & bower symbols * Bump deps for compiler/0.12 * Remove symbols and fix operator fixity issue * Update dependencies, license * Added HeytingAlgebra, Semiring, Ring * Fix type annotation precedence in tests * Replace monomorphic proxies by Type.Proxy.Proxy (#44) * Move Enum file to Data.Enum.Generic * Update module name to match file name for Enum * Update module path for Bounded Generic * Move test file to Data.Enum folder and rename to Generic.purs * Remove code unrelated to Enum in test file * Update Generic X module names to Data.X.Generic * Rename `main` function in test file to testGenericEnum * Update module name in test file to match file name * Remove all files in repo that are unrelated to Enum Generic * Include Enum's Generic tests in repo's tests * Remove unused logShow Co-authored-by: Phil Freeman <[email protected]> Co-authored-by: Matthew Leon <[email protected]> Co-authored-by: Gary Burgess <[email protected]> Co-authored-by: Liam Goodacre <[email protected]> Co-authored-by: Jorge Acereda <[email protected]> Co-authored-by: Kristoffer Josefsson <[email protected]> Co-authored-by: Denis Stoyanov <[email protected]> Co-authored-by: Harry Garrood <[email protected]> Co-authored-by: Cyril <[email protected]>
1 parent c8f7b75 commit cd8c0d3

File tree

3 files changed

+272
-1
lines changed

3 files changed

+272
-1
lines changed

‎src/Data/Enum/Generic.purs

Lines changed: 118 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,118 @@
1+
module Data.Enum.Generic where
2+
3+
import Prelude
4+
5+
import Data.Enum (class BoundedEnum, class Enum, Cardinality(..), cardinality, fromEnum, pred, succ, toEnum)
6+
import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), Sum(..), from, to)
7+
import Data.Bounded.Generic (class GenericBottom, class GenericTop, genericBottom', genericTop')
8+
import Data.Maybe (Maybe(..))
9+
import Data.Newtype (unwrap)
10+
11+
class GenericEnum a where
12+
genericPred' :: a -> Maybe a
13+
genericSucc' :: a -> Maybe a
14+
15+
instance genericEnumNoArguments :: GenericEnum NoArguments where
16+
genericPred' _ = Nothing
17+
genericSucc' _ = Nothing
18+
19+
instance genericEnumArgument :: Enum a => GenericEnum (Argument a) where
20+
genericPred' (Argument a) = Argument <$> pred a
21+
genericSucc' (Argument a) = Argument <$> succ a
22+
23+
instance genericEnumConstructor :: GenericEnum a => GenericEnum (Constructor name a) where
24+
genericPred' (Constructor a) = Constructor <$> genericPred' a
25+
genericSucc' (Constructor a) = Constructor <$> genericSucc' a
26+
27+
instance genericEnumSum :: (GenericEnum a, GenericTop a, GenericEnum b, GenericBottom b) => GenericEnum (Sum a b) where
28+
genericPred' = case _ of
29+
Inl a -> Inl <$> genericPred' a
30+
Inr b -> case genericPred' b of
31+
Nothing -> Just (Inl genericTop')
32+
Just b' -> Just (Inr b')
33+
genericSucc' = case _ of
34+
Inl a -> case genericSucc' a of
35+
Nothing -> Just (Inr genericBottom')
36+
Just a' -> Just (Inl a')
37+
Inr b -> Inr <$> genericSucc' b
38+
39+
instance genericEnumProduct :: (GenericEnum a, GenericTop a, GenericBottom a, GenericEnum b, GenericTop b, GenericBottom b) => GenericEnum (Product a b) where
40+
genericPred' (Product a b) = case genericPred' b of
41+
Just p -> Just $ Product a p
42+
Nothing -> flip Product genericTop' <$> genericPred' a
43+
genericSucc' (Product a b) = case genericSucc' b of
44+
Just s -> Just $ Product a s
45+
Nothing -> flip Product genericBottom' <$> genericSucc' a
46+
47+
48+
-- | A `Generic` implementation of the `pred` member from the `Enum` type class.
49+
genericPred :: forall a rep. Generic a rep => GenericEnum rep => a -> Maybe a
50+
genericPred = map to <<< genericPred' <<< from
51+
52+
-- | A `Generic` implementation of the `succ` member from the `Enum` type class.
53+
genericSucc :: forall a rep. Generic a rep => GenericEnum rep => a -> Maybe a
54+
genericSucc = map to <<< genericSucc' <<< from
55+
56+
class GenericBoundedEnum a where
57+
genericCardinality' :: Cardinality a
58+
genericToEnum' :: Int -> Maybe a
59+
genericFromEnum' :: a -> Int
60+
61+
instance genericBoundedEnumNoArguments :: GenericBoundedEnum NoArguments where
62+
genericCardinality' = Cardinality 1
63+
genericToEnum' i = if i == 0 then Just NoArguments else Nothing
64+
genericFromEnum' _ = 0
65+
66+
instance genericBoundedEnumArgument :: BoundedEnum a => GenericBoundedEnum (Argument a) where
67+
genericCardinality' = Cardinality (unwrap (cardinality :: Cardinality a))
68+
genericToEnum' i = Argument <$> toEnum i
69+
genericFromEnum' (Argument a) = fromEnum a
70+
71+
instance genericBoundedEnumConstructor :: GenericBoundedEnum a => GenericBoundedEnum (Constructor name a) where
72+
genericCardinality' = Cardinality (unwrap (genericCardinality' :: Cardinality a))
73+
genericToEnum' i = Constructor <$> genericToEnum' i
74+
genericFromEnum' (Constructor a) = genericFromEnum' a
75+
76+
instance genericBoundedEnumSum :: (GenericBoundedEnum a, GenericBoundedEnum b) => GenericBoundedEnum (Sum a b) where
77+
genericCardinality' =
78+
Cardinality
79+
$ unwrap (genericCardinality' :: Cardinality a)
80+
+ unwrap (genericCardinality' :: Cardinality b)
81+
genericToEnum' n = to genericCardinality'
82+
where
83+
to :: Cardinality a -> Maybe (Sum a b)
84+
to (Cardinality ca)
85+
| n >= 0 && n < ca = Inl <$> genericToEnum' n
86+
| otherwise = Inr <$> genericToEnum' (n - ca)
87+
genericFromEnum' = case _ of
88+
Inl a -> genericFromEnum' a
89+
Inr b -> genericFromEnum' b + unwrap (genericCardinality' :: Cardinality a)
90+
91+
92+
instance genericBoundedEnumProduct :: (GenericBoundedEnum a, GenericBoundedEnum b) => GenericBoundedEnum (Product a b) where
93+
genericCardinality' =
94+
Cardinality
95+
$ unwrap (genericCardinality' :: Cardinality a)
96+
* unwrap (genericCardinality' :: Cardinality b)
97+
genericToEnum' n = to genericCardinality'
98+
where to :: Cardinality b -> Maybe (Product a b)
99+
to (Cardinality cb) = Product <$> (genericToEnum' $ n `div` cb) <*> (genericToEnum' $ n `mod` cb)
100+
genericFromEnum' = from genericCardinality'
101+
where from :: Cardinality b -> (Product a b) -> Int
102+
from (Cardinality cb) (Product a b) = genericFromEnum' a * cb + genericFromEnum' b
103+
104+
105+
-- | A `Generic` implementation of the `cardinality` member from the
106+
-- | `BoundedEnum` type class.
107+
genericCardinality :: forall a rep. Generic a rep => GenericBoundedEnum rep => Cardinality a
108+
genericCardinality = Cardinality (unwrap (genericCardinality' :: Cardinality rep))
109+
110+
-- | A `Generic` implementation of the `toEnum` member from the `BoundedEnum`
111+
-- | type class.
112+
genericToEnum :: forall a rep. Generic a rep => GenericBoundedEnum rep => Int -> Maybe a
113+
genericToEnum = map to <<< genericToEnum'
114+
115+
-- | A `Generic` implementation of the `fromEnum` member from the `BoundedEnum`
116+
-- | type class.
117+
genericFromEnum :: forall a rep. Generic a rep => GenericBoundedEnum rep => a -> Int
118+
genericFromEnum = genericFromEnum' <<< from

‎test/Main.purs

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,9 @@ import Prelude
44

55
import Effect (Effect)
66
import Test.Data.Enum (testEnum)
7+
import Test.Data.Enum.Generic (testGenericEnum)
78

89
main :: Effect Unit
9-
main = testEnum
10+
main = do
11+
testEnum
12+
testGenericEnum

‎test/Test/Data/Enum/Generic.purs

Lines changed: 150 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,150 @@
1+
module Test.Data.Enum.Generic where
2+
3+
import Prelude
4+
5+
import Data.Enum (class BoundedEnum, class Enum, Cardinality(..), cardinality, fromEnum, pred, succ, toEnum, enumFromTo)
6+
import Data.Generic.Rep as G
7+
import Data.Bounded.Generic as GBounded
8+
import Data.Enum.Generic as GEnum
9+
import Data.Eq.Generic as GEq
10+
import Data.Ord.Generic as GOrd
11+
import Data.Show.Generic as GShow
12+
import Data.Maybe (Maybe(..))
13+
import Effect (Effect)
14+
import Effect.Console (log)
15+
import Test.Assert (assert)
16+
17+
data SimpleBounded = A | B | C | D
18+
derive instance genericSimpleBounded :: G.Generic SimpleBounded _
19+
instance eqSimpleBounded :: Eq SimpleBounded where
20+
eq x y = GEq.genericEq x y
21+
instance ordSimpleBounded :: Ord SimpleBounded where
22+
compare x y = GOrd.genericCompare x y
23+
instance showSimpleBounded :: Show SimpleBounded where
24+
show x = GShow.genericShow x
25+
instance boundedSimpleBounded :: Bounded SimpleBounded where
26+
bottom = GBounded.genericBottom
27+
top = GBounded.genericTop
28+
instance enumSimpleBounded :: Enum SimpleBounded where
29+
pred = GEnum.genericPred
30+
succ = GEnum.genericSucc
31+
instance boundedEnumSimpleBounded :: BoundedEnum SimpleBounded where
32+
cardinality = GEnum.genericCardinality
33+
toEnum = GEnum.genericToEnum
34+
fromEnum = GEnum.genericFromEnum
35+
36+
data Option a = None | Some a
37+
derive instance genericOption :: G.Generic (Option a) _
38+
instance eqOption :: Eq a => Eq (Option a) where
39+
eq x y = GEq.genericEq x y
40+
instance ordOption :: Ord a => Ord (Option a) where
41+
compare x y = GOrd.genericCompare x y
42+
instance showOption :: Show a => Show (Option a) where
43+
show x = GShow.genericShow x
44+
instance boundedOption :: Bounded a => Bounded (Option a) where
45+
bottom = GBounded.genericBottom
46+
top = GBounded.genericTop
47+
instance enumOption :: (Bounded a, Enum a) => Enum (Option a) where
48+
pred = GEnum.genericPred
49+
succ = GEnum.genericSucc
50+
instance boundedEnumOption :: BoundedEnum a => BoundedEnum (Option a) where
51+
cardinality = GEnum.genericCardinality
52+
toEnum = GEnum.genericToEnum
53+
fromEnum = GEnum.genericFromEnum
54+
55+
data Bit = Zero | One
56+
derive instance genericBit :: G.Generic Bit _
57+
instance eqBit :: Eq Bit where
58+
eq x y = GEq.genericEq x y
59+
instance ordBit :: Ord Bit where
60+
compare x y = GOrd.genericCompare x y
61+
instance showBit :: Show Bit where
62+
show x = GShow.genericShow x
63+
instance boundedBit :: Bounded Bit where
64+
bottom = GBounded.genericBottom
65+
top = GBounded.genericTop
66+
instance enumBit :: Enum Bit where
67+
pred = GEnum.genericPred
68+
succ = GEnum.genericSucc
69+
instance boundedEnumBit :: BoundedEnum Bit where
70+
cardinality = GEnum.genericCardinality
71+
toEnum = GEnum.genericToEnum
72+
fromEnum = GEnum.genericFromEnum
73+
74+
data Pair a b = Pair a b
75+
derive instance genericPair :: G.Generic (Pair a b) _
76+
instance eqPair :: (Eq a, Eq b) => Eq (Pair a b) where
77+
eq = GEq.genericEq
78+
instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where
79+
compare = GOrd.genericCompare
80+
instance showPair :: (Show a, Show b) => Show (Pair a b) where
81+
show = GShow.genericShow
82+
instance boundedPair :: (Bounded a, Bounded b) => Bounded (Pair a b) where
83+
bottom = GBounded.genericBottom
84+
top = GBounded.genericTop
85+
instance enumPair :: (Bounded a, Enum a, Bounded b, Enum b) => Enum (Pair a b) where
86+
pred = GEnum.genericPred
87+
succ = GEnum.genericSucc
88+
instance boundedEnumPair :: (BoundedEnum a, BoundedEnum b) => BoundedEnum (Pair a b) where
89+
cardinality = GEnum.genericCardinality
90+
toEnum = GEnum.genericToEnum
91+
fromEnum = GEnum.genericFromEnum
92+
93+
testGenericEnum :: Effect Unit
94+
testGenericEnum = do
95+
log "Checking simple pred bottom"
96+
assert $ pred (bottom :: SimpleBounded) == Nothing
97+
98+
log "Checking simple (pred =<< succ bottom)"
99+
assert $ (pred =<< succ bottom) == Just A
100+
101+
log "Checking simple succ top"
102+
assert $ succ (top :: SimpleBounded) == Nothing
103+
104+
log "Checking simple (succ =<< pred top)"
105+
assert $ (succ =<< pred top) == Just D
106+
107+
log "Checking composite pred bottom"
108+
assert $ pred (bottom :: Option SimpleBounded) == Nothing
109+
110+
log "Checking composite (pred =<< succ bottom)"
111+
assert $ (pred =<< succ (bottom :: Option SimpleBounded)) == Just None
112+
113+
log "Checking composite succ top"
114+
assert $ succ (top :: Option SimpleBounded) == Nothing
115+
116+
log "Checking composite (succ =<< pred top)"
117+
assert $ (succ =<< pred top) == Just (Some D)
118+
119+
log "Checking product pred bottom"
120+
assert $ pred (bottom :: Pair Bit SimpleBounded) == Nothing
121+
122+
log "Checking product (pred =<< succ bottom)"
123+
assert $ (pred =<< succ (bottom :: Pair Bit SimpleBounded)) == Just (Pair Zero A)
124+
125+
log "Checking product succ top"
126+
assert $ succ (top :: Pair Bit SimpleBounded) == Nothing
127+
128+
log "Checking product (succ =<< pred top)"
129+
assert $ (succ =<< pred top) == Just (Pair One D)
130+
131+
log "Checking simple cardinality"
132+
assert $ (cardinality :: Cardinality SimpleBounded) == Cardinality 4
133+
134+
log "Checking composite cardinality"
135+
assert $ (cardinality :: Cardinality (Option SimpleBounded)) == Cardinality 5
136+
137+
log "Checking product cardinality"
138+
assert $ (cardinality :: Cardinality (Pair Bit SimpleBounded)) == Cardinality 8
139+
140+
log "Checking simple toEnum/fromEnum roundtrip"
141+
assert $ toEnum (fromEnum A) == Just A
142+
assert $ toEnum (fromEnum B) == Just B
143+
144+
log "Checking composite toEnum/fromEnum roundtrip"
145+
assert $ toEnum (fromEnum (None :: Option SimpleBounded)) == Just (None :: Option SimpleBounded)
146+
assert $ toEnum (fromEnum (Some A)) == Just (Some A)
147+
148+
log "Checking product toEnum/fromEnum roundtrip"
149+
assert $ let allPairs = enumFromTo bottom top :: Array (Pair Bit SimpleBounded)
150+
in (toEnum <<< fromEnum <$> allPairs) == (Just <$> allPairs)

0 commit comments

Comments
 (0)