diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for circular-enum +## 0.2.0.0 -- 2026-05-18 + +* Add the Circular newtype wrapper (VegOwOtenks) + ## 0.1.0.0 -- 2023-05-31 * First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2023 Mirko Westermeier +Copyright (c) 2023-2026 Mirko Westermeier Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/circular-enum.cabal b/circular-enum.cabal --- a/circular-enum.cabal +++ b/circular-enum.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: circular-enum -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Make bounded enum types circular description: Circular successor & predecessor for bounded enum types homepage: https://github.com/memowe/circular-enum @@ -9,31 +9,35 @@ license-file: LICENSE author: Mirko Westermeier maintainer: mirko@westermeier.de -copyright: (c) 2023 Mirko Westermeier +copyright: (c) 2023-2026 Mirko Westermeier category: Data build-type: Simple extra-doc-files: CHANGELOG.md source-repository head type: git branch: main - location: git://github.com/memowe/circular-enum.git + location: https://github.com/memowe/circular-enum.git common warnings ghc-options: -Wall library - import: warnings - exposed-modules: Data.Enum.Circular - build-depends: base >=4.14.0.0 && < 5 - hs-source-dirs: src - default-language: Haskell2010 + import: warnings + exposed-modules: Data.Enum.Circular + build-depends: base >=4.14.0.0 && < 5 + hs-source-dirs: src + default-language: Haskell2010 + default-extensions: InstanceSigs + , ScopedTypeVariables test-suite circular-enum-test import: warnings default-language: Haskell2010 + ghc-options: -Wno-orphans type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs build-depends: base >=4.14.0.0 , circular-enum , hspec >= 2.10 && < 3 + , QuickCheck diff --git a/src/Data/Enum/Circular.hs b/src/Data/Enum/Circular.hs --- a/src/Data/Enum/Circular.hs +++ b/src/Data/Enum/Circular.hs @@ -1,7 +1,7 @@ {-| Module : Data.Enum.Circular Description : Circular successor & predecessor for bounded enum types -Copyright : (c) 2023 Mirko Westermeier +Copyright : (c) 2023-2026 Mirko Westermeier License : MIT Sometimes, bounded enum types should be circular. Consider this enum @@ -20,16 +20,63 @@ @succ@ with @succ West = North@ again. With 'Eq' and 'Bounded' instances, the functions defined in this module act like circular versions of 'succ' and 'pred'. + +Note: this module is designed for small, finite enum types created with +@deriving Enum@. It is not suitable for types where +@fromEnum maxBound + 1@ overflows 'Int', such as 'Int' or 'Word' itself. -} -module Data.Enum.Circular (csucc, cpred) where +module Data.Enum.Circular (csucc, cpred, Circular(..)) where -- | Circular version of 'succ' csucc :: (Eq a, Enum a, Bounded a) => a -> a -csucc x | x == maxBound = minBound - | otherwise = succ x +csucc = unCircular . succ . Circular -- | Circular version of 'pred' cpred :: (Eq a, Enum a, Bounded a) => a -> a -cpred x | x == minBound = maxBound - | otherwise = pred x +cpred = unCircular . pred . Circular + + +-- | Type Alias you can use to express your intent and avoid 'Enum' +-- functions from biting you. +-- +-- Beware: unlike regular 'Enum' types, backwards enumeration via +-- @[West, South ..]@ leads to singleton results. Since the enum is +-- circular, a "backwards" step is equivalent to a large forwards step, +-- but the enumeration ends at the "to" element earlier than expected. +-- Use 'pred' or 'cpred' explicitly with 'iterate' to go backwards. +-- +-- Also assumes that the underlying 'Enum' instance is well-behaved, +-- i.e. @fromEnum minBound == 0@ and @fromEnum maxBound + 1@ does not +-- overflow 'Int'. Both hold for all types using @deriving Enum@ with a +-- small number of constructors, but /not/ for 'Int', 'Word', or similar. + +newtype Circular a = Circular {unCircular :: a} + deriving (Show, Eq) + +instance (Enum a, Bounded a) => Enum (Circular a) where + + toEnum :: Int -> Circular a + toEnum = Circular . toEnum . (`mod` len) + where len = fromEnum (maxBound :: a) + 1 + + fromEnum :: Circular a -> Int + fromEnum = fromEnum . unCircular + + enumFromTo :: Circular a -> Circular a -> [Circular a] + enumFromTo start end = map toEnum $ enumFromTo i (i + dist) + where i = fromEnum start + j = fromEnum end + dist = (j - i) `mod` len + len = fromEnum (maxBound :: a) + 1 + + enumFromThenTo :: Circular a -> Circular a -> Circular a -> [Circular a] + enumFromThenTo from next to + | step == 0 = repeat from + | otherwise = map toEnum $ enumFromThenTo i (i + step) (i + dist) + where i = fromEnum from + j = fromEnum next + k = fromEnum to + step = (j - i) `mod` len + dist = (k - i) `mod` len + len = fromEnum (maxBound :: a) + 1 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -2,25 +2,149 @@ import Data.Enum.Circular import Data.Function +import Data.List import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck -data Direction = N | E | S | W deriving (Show, Eq, Enum, Bounded) +data Dir = N | E | S | W deriving (Show, Eq, Enum, Bounded) -circularDirections :: Spec -circularDirections = describe "Circular directions" $ do +-- Enumeration of all members of the direction enum +allDirs :: [Dir] +allDirs = enumFrom minBound :: [Dir] - describe "Boundaries" $ do - it "North after West" $ csucc W `shouldBe` N - it "West before North" $ cpred N `shouldBe` W +instance Arbitrary Dir where + arbitrary = arbitraryBoundedEnum - describe "Compatible with Enum instance" $ do - it "Successors" $ - iterate csucc minBound `startShouldBe` cycle allDirs - it "Predecessors" $ - iterate cpred maxBound `startShouldBe` cycle (reverse allDirs) +instance Arbitrary a => Arbitrary (Circular a) where + arbitrary = Circular <$> arbitrary - where allDirs = enumFrom minBound :: [Direction] - startShouldBe = shouldBe `on` take (length allDirs * 2) +-- compare the first 2 times 'Dir'-Enum-Size items +startShouldBe :: (Show a, Eq a) => [a] -> [a] -> Expectation +startShouldBe = shouldBe `on` take (length allDirs * 2) main :: IO () -main = hspec circularDirections +main = hspec $ do + + describe "Circular directions" $ do + + describe "Boundaries" $ do + it "North after West" $ csucc W `shouldBe` N + it "West before North" $ cpred N `shouldBe` W + + describe "Compatible with Enum instance" $ do + it "Successors" $ + iterate csucc minBound `startShouldBe` cycle allDirs + it "Predecessors" $ + iterate cpred maxBound `startShouldBe` cycle (reverse allDirs) + + describe "Reversibility" $ do + prop "csucc . cpred = id" $ \dir -> + (csucc . cpred) (dir :: Dir) `shouldBe` dir + prop "cpred . csucc = id" $ \dir -> + (cpred . csucc) (dir :: Dir) `shouldBe` dir + + describe "Circular newtype" $ do + + describe "Boundaries" $ do + it "North after West" $ succ (Circular W) `shouldBe` Circular N + it "West before North" $ pred (Circular N) `shouldBe` Circular W + + describe "Reversibility" $ do + prop "succ o pred = id" $ \dir -> + (succ . pred) (Circular dir) `shouldBe` Circular (dir :: Dir) + prop "pred o succ = id" $ \dir -> + (pred . succ) (Circular dir) `shouldBe` Circular (dir :: Dir) + + describe "Compatible with inner Enum instance" $ do + prop "Successors" $ \dir -> dir /= (maxBound :: Dir) ==> + succ (Circular dir) `shouldBe` Circular (succ dir) + prop "Predecessors" $ \dir -> dir /= (minBound :: Dir) ==> + pred (Circular dir) `shouldBe` Circular (pred dir) + + describe "to/fromEnum" $ do + let len = length allDirs + it "Upper example" $ + toEnum 4 `shouldBe` Circular N + it "Lower example" $ + toEnum (-1) `shouldBe` Circular W + prop "Cycle down" $ \n -> n >= fromEnum (maxBound :: Dir) ==> + toEnum n `shouldBe` (toEnum (n `mod` len) :: Circular Dir) + prop "Cycle up" $ \n -> n < 0 ==> + toEnum n `shouldBe` (toEnum (n `mod` len) :: Circular Dir) + prop "toEnum Truncation" $ \n -> + fromEnum (toEnum n :: Circular Dir) `shouldBe` n `mod` len + prop "toEnum: repeating series" $ \n -> n >= 0 ==> + let toEnums = toEnum <$> [0..] + cAllDirs = Circular <$> cycle allDirs + in toEnums !! n `shouldBe` cAllDirs !! n + prop "Roundtrip toEnum . fromEnum" $ \cd -> + toEnum (fromEnum cd) `shouldBe` (cd :: Circular Dir) + prop "'Roundtrip' fromEnum . toEnum . fromEnum" $ \cd -> + let i = fromEnum (cd :: Circular Dir) + in fromEnum (toEnum i :: Circular Dir) `shouldBe` i + + describe "enum[From][Then][To] circularity" $ do + + describe "Examples" $ do + it "enumFromThen: stepped Enum iteration" $ + enumFromThen (Circular N) (Circular S) + `startShouldBe` cycle (fmap Circular [N, S]) + it "enumFromTo: enumeration wrapping" $ + enumFromTo (Circular S) (Circular E) + `shouldBe` fmap Circular [S, W, N, E] + -- forward iteration + it "enumFromTo: singleton" $ + enumFromTo (Circular N) (Circular N) + `shouldBe` [Circular N] + it "enumFromThenTo: target exactly hit" $ + enumFromThenTo (Circular N) (Circular S) (Circular S) + `shouldBe` fmap Circular [N, S] + it "enumFromThenTo: start = next -> infinite" $ + enumFromThenTo (Circular N) (Circular N) (Circular S) + `startShouldBe` repeat (Circular N) + it "enumFromThenTO: enumeration stepped wrapping" $ + enumFromThenTo (Circular N) (Circular S) (Circular E) + `shouldBe` [Circular N] + -- consistent with [1,3..2] + it "enumFrom: infinity" $ + enumFrom (Circular E) + `startShouldBe` cycle (fmap Circular [E, S, W, N]) + + describe "General properties" $ do + + describe "enumFromThen" $ do + prop "Correct start: first" $ \cd cd' -> + head (enumFromThen cd cd') `shouldBe` (cd :: Circular Dir) + prop "Correct start: second" $ \cd cd' -> + enumFromThen cd cd' !! 1 `shouldBe` (cd' :: Circular Dir) + prop "Start = next -> infinite" $ \cd -> + enumFromThen cd cd `startShouldBe` repeat (cd :: Circular Dir) + prop "Correct step size" $ \cd n -> n /= 0 ==> + let cd' = toEnum (fromEnum (cd :: Circular Dir) + n) + ds = enumFromThen cd cd' + shouldBeModLen = shouldBe `on` (`mod` length allDirs) + in forAll (sized $ \s -> choose (0, s)) $ \i -> + let cd1 = ds !! i + cd2 = ds !! (i+1) + in (fromEnum cd2 - fromEnum cd1) `shouldBeModLen` n + + describe "enumFrom: enumFromThen with succ" $ do + prop "Same infinite list start" $ \cd -> + enumFrom cd + `startShouldBe` enumFromThen (cd :: Circular Dir) (succ cd) + + describe "enumFromThenTo: finite enumFromThen" $ do + prop "Start = end -> singleton" $ \cd cd' -> cd' /= cd ==> + enumFromThenTo cd cd' cd `shouldBe` [cd :: Circular Dir] + prop "Start = next -> infinite" $ \cd target -> cd /= target ==> + enumFromThenTo cd cd target + `startShouldBe` repeat (cd :: Circular Dir) + prop "Prefix" $ \cd cd' target -> cd /= cd' ==> + enumFromThenTo cd cd' target + `isPrefixOf` enumFromThen cd (cd' :: Circular Dir) + + describe "enumFromTo: enumFromThenTo with succ" $ do + prop "Same list" $ \cd target -> + enumFromTo cd target + `shouldBe` enumFromThenTo cd (succ cd :: Circular Dir) target