ref: 4161ae98a0bd95edcd9a8f48c5daf019dd7164bb misc/reflex-gl-demo/src/Data/Wraparound.hs -rw-r--r-- 1.5 KiB View raw
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
module Data.Wraparound where

import Control.Lens (Lens')

-- $setup
-- >>> import Control.Lens ((^.), (.~))
-- >>> import Data.Function ((&))
-- >>> import Test.QuickCheck

-- | Like a 'Data.Clamped.Clamped' value, but if you go off either end
-- you wrap around and come in on the other side.
data Wraparound a = Wraparound a a a

-- | Lens into the wrapping value. Writes through the lens wrap around.
--
-- >>> :{
--   quickCheck $ \lo hi a b n -> (lo :: Int) < hi
--     ==> (mkWraparound lo hi a & wraparound .~ b) ^. wraparound
--     === (mkWraparound lo hi a & wraparound .~ (b + n * (hi - lo))) ^. wraparound
-- :}
-- +++ OK, passed 100 tests...
wraparound :: (Num a, Ord a) => Lens' (Wraparound a) a
wraparound f (Wraparound lo hi a) = Wraparound lo hi . wrap lo hi <$> f a

-- | Create a wrapping value.
--
-- Wraparounds are bounded by @lo@ and @hi@, just like 'Data.Clamped.Clamped':
-- prop> (lo :: Int) < hi ==> mkWraparound lo hi a ^. wraparound >= lo
-- prop> (lo :: Int) < hi ==> mkWraparound lo hi a ^. wraparound < hi
--
-- But they also loop around:
-- >>> :{
--   quickCheck $ \lo hi a n -> (lo :: Int) < hi
--     ==> mkWraparound lo hi a ^. wraparound
--     === mkWraparound lo hi (a + n * (hi - lo)) ^. wraparound
-- :}
-- +++ OK, passed 100 tests...
mkWraparound :: (Num a, Ord a) => a -> a -> a -> Wraparound a
mkWraparound lo hi a = Wraparound lo hi $ wrap lo hi a

wrap :: (Num a, Ord a) => a -> a -> a -> a
wrap lo hi a
  | a < lo = wrap lo hi $ a + d
  | a >= hi = wrap lo hi $ a - d
  | otherwise = a
  where
    d = hi - lo