diff --git a/CHANGELOG.md b/CHANGELOG.md index fefb788..c230448 100644 --- a/CHANGELOG.md +++ b/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. diff --git a/README.md b/README.md index 8496932..e941069 100644 --- a/README.md +++ b/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 diff --git a/circular-enum.cabal b/circular-enum.cabal index f413fd0..bcc4d8e 100644 --- a/circular-enum.cabal +++ b/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 diff --git a/src/Data/Enum/Circular.hs b/src/Data/Enum/Circular.hs index f9dc697..8c31983 100644 --- a/src/Data/Enum/Circular.hs +++ b/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 + diff --git a/test/Main.hs b/test/Main.hs index 5c16b18..483c6d6 100644 --- a/test/Main.hs +++ b/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