Circular newtype wrapper: Enables all enum methods

CHANGELOG.md

@@ -1,5 +1,9 @@
 # Revision history for circular-enum
 
+## 0.2.0.0 -- TODO
+
+* Add the Circular newtype wrapper (VegOwOtenks)
+
 ## 0.1.0.0 -- 2023-05-31
 
 * First version. Released on an unsuspecting world.

README.md

@@ -17,7 +17,7 @@
 [hackage]: https://hackage.haskell.org/package/circular-enum
 
 ```haskell
-import Data.Enum.Circular (csucc, cpred)
+import Data.Enum.Circular
 
 data Direction = N | E | S | W deriving (Show, Eq, Enum, Bounded)
 
@@ -27,11 +27,20 @@ show $ take 6 (iterate csucc N)
 
 `csucc` and `cpred` are compatible with `succ` and `pred`, but they behave circular on the type boundaries. Requires `Eq`, `Enum` and `Bounded` instances.
 
+You can also use the `Circular` newtype:
+
+```haskell
+type CDirection = Circular Direction
+
+show $ take 6 (iterate succ (Circular N))
+```
+
 ## Contributors
 
 [![Contributor Covenant 2.0][coc-img]][coc]
 
 - Mirko Westermeier ([@memowe][memowe-gh])
+- VegOwOtenks ([@Hyalunar][Hyalunar-gh])
 
 ## Author and License
 
@@ -42,3 +51,4 @@ Released under the MIT license. See [LICENSE](LICENSE) for details.
 [coc]: CODE_OF_CONDUCT.md
 [coc-img]: https://img.shields.io/badge/Code%20of%20Conduct-Contributor%20Covenant%202.0-8f761b.svg?style=flat&logo=adguard&logoColor=lightgray
 [memowe-gh]: https://github.com/memowe
+[Hyalunar-gh]: https://github.com/Hyalunar

circular-enum.cabal

@@ -27,6 +27,8 @@ library
     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

src/Data/Enum/Circular.hs

@@ -22,14 +22,71 @@ the functions defined in this module act like circular versions of 'succ'
 and 'pred'.
 -}
 
-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: this alters the behaviour of some functions, producing infinite lists (because of circularity)
+
+newtype Circular a = Circular {unCircular :: a}
+  deriving (Show, Eq, Ord)
+
+instance (Eq a, Enum a, Bounded a) => Enum (Circular a) where
+  succ :: Circular a -> Circular a
+  succ (Circular x) | x == maxBound = Circular minBound
+                    | otherwise     = Circular (succ x)
+
+  pred :: Circular a -> Circular a
+  pred (Circular x) | x == minBound = Circular maxBound
+                    | otherwise     = Circular (pred x)
+
+  toEnum :: Int -> Circular a
+  toEnum index = let
+    maxBoundIndex = fromEnum (maxBound :: a) -- relies on the fact that toEnum starts at zero
+    truncatedIndex = index `mod` (maxBoundIndex + 1)
+    in Circular (toEnum truncatedIndex)
+
+  fromEnum :: Circular a -> Int
+  fromEnum (Circular inner) = fromEnum inner
+
+  enumFrom :: Circular a -> [Circular a]
+  enumFrom start = cycle $ enumFromTo start (pred start)
+
+  enumFromThen :: (Eq a, Enum a, Bounded a) => Circular a -> Circular a -> [Circular a]
+  enumFromThen lower higher = let
+    lowerIndex = fromEnum lower
+    higherIndex = fromEnum higher
+    stepSize = abs $ higherIndex - lowerIndex -- absolute step size: wraps around
+    stepList i = let
+      current   = toEnum i
+      nextIndex = fromEnum current + stepSize
+      in current : stepList nextIndex
+    in stepList lowerIndex
+
+  enumFromTo :: (Eq a, Enum a, Bounded a) => Circular a -> Circular a -> [Circular a]
+  enumFromTo current target = current : if current == target
+    then []
+    else enumFromTo (succ current) target
+
+  enumFromThenTo :: (Eq a, Enum a, Bounded a) => Circular a -> Circular a -> Circular a -> [Circular a]
+  enumFromThenTo lower higher target = let
+    lowerIndex = fromEnum lower
+    higherIndex = fromEnum higher
+    stepSize = abs $ higherIndex - lowerIndex -- absolute step size: wraps around
+    stepListTo i = let
+      current = toEnum i
+      nextIndex = fromEnum current + stepSize
+      in if current == target
+        then []
+        else current : stepListTo nextIndex
+    in stepListTo lowerIndex
+

test/Main.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Redundant where" #-}
 module Main (main) where
 
 import Data.Enum.Circular
@@ -6,6 +8,15 @@ import Test.Hspec
 
 data Direction = N | E | S | W deriving (Show, Eq, Enum, Bounded)
 
+-- Enumeration of all members of the direction enum
+
+allDirs :: [Direction]
+allDirs = enumFrom minBound :: [Direction]
+
+-- compare the first 2 times 'Direction'-Enum-Size items
+startShouldBe :: (Show a, Eq a) => [a] -> [a] -> Expectation
+startShouldBe = shouldBe `on` take (length allDirs * 2)
+
 circularDirections :: Spec
 circularDirections = describe "Circular directions" $ do
 
@@ -19,8 +30,46 @@ circularDirections = describe "Circular directions" $ do
     it "Predecessors" $
       iterate cpred maxBound `startShouldBe` cycle (reverse allDirs)
 
-  where allDirs         = enumFrom minBound :: [Direction]
-        startShouldBe   = shouldBe `on` take (length allDirs * 2)
+circularNewtype :: Spec
+circularNewtype = describe "Circular newtype" $ do
+
+  describe "Boundaries" $ do
+    it "North after West" 
+      $ succ (Circular W) `shouldBe` Circular N
+
+  describe "Compatible with inner Enum instance" $ do
+    it "Successors" 
+      $ iterate succ (Circular minBound) `startShouldBe` fmap Circular (cycle allDirs)
+
+    it "Predecessors"
+      $ iterate pred (Circular maxBound) `startShouldBe` fmap Circular (cycle $ reverse allDirs)
+
+  describe "Out of Bounds" $ do
+    it "fromEnum Boundary"
+      $ toEnum 4 `shouldBe` Circular N
+
+    it "toEnum Truncation"
+      $ fromEnum (toEnum 4 :: Circular Direction) `shouldBe` 0
+
+    it "toEnum: repeating series"
+      $ fmap toEnum [0..] `startShouldBe` fmap Circular (cycle allDirs)
+
+  describe "enum[From][Then][To] circularity" $ do
+    it "Stepped Enum Iteration"
+      $ enumFromThen (Circular N) (Circular S) `startShouldBe` cycle (fmap Circular [N, S])
+
+    it "enumeration Wrapping"
+      $ enumFromTo (Circular S) (Circular E) `shouldBe` fmap Circular [S, W, N, E]
+      -- forward iteration
+
+    it "enumeration stepped wrapping"
+      $ enumFromThenTo (Circular N) (Circular S) (Circular E) `startShouldBe` cycle (fmap Circular [N, S])
+      -- produces an infinite list because 'E' can never be reached
+
+    it "enumFrom infinity"
+      $ enumFrom (Circular E) `startShouldBe` cycle (fmap Circular [E, S, W, N])
 
 main :: IO ()
-main = hspec circularDirections
+main = hspec $ do
+  circularDirections
+  circularNewtype