ref: 4161ae98a0bd95edcd9a8f48c5daf019dd7164bb misc/reflex-gl-demo/src/Data/Clamped.hs -rw-r--r-- 907 bytes 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
module Data.Clamped (Clamped, clamped, mkClamped) where

import Control.Lens (Lens')

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

data Clamped a = Clamped a a a

-- | Lens into the clamped value. Writes through the lens are clamped.
--
-- prop> (lo :: Int) < hi ==> (mkClamped lo hi a & clamped .~ b) ^. clamped >= lo
-- prop> (lo :: Int) < hi ==> (mkClamped lo hi a & clamped .~ b) ^. clamped <= hi
clamped :: Ord a => Lens' (Clamped a) a
clamped f (Clamped lo hi a) = Clamped lo hi . clamp lo hi <$> f a

-- | Create a clamped value.
--
-- prop> (lo :: Int) < hi ==> mkClamped lo hi a ^. clamped >= lo
-- prop> (lo :: Int) < hi ==> mkClamped lo hi a ^. clamped <= hi
mkClamped :: Ord a => a -> a -> a -> Clamped a
mkClamped lo hi a = Clamped lo hi $ clamp lo hi a

clamp :: Ord a => a -> a -> a -> a
clamp lo hi a
  | a < lo = lo
  | a > hi = hi
  | otherwise = a