Add withBounds helper

Author: kleinreact

src/lib/Finite.hs

@@ -29,9 +29,10 @@
 
 module Finite
   ( -- * The Finite Class
-    Finite(..)
+    FiniteBounds
+  , Finite(..)
   , GFinite(..)
-  , FiniteBounds
+  , withBounds
   , -- * Powersets
     PowerSet
   , -- * Collections
@@ -44,6 +45,7 @@ import Finite.Class
   ( FiniteBounds
   , Finite(..)
   , GFinite(..)
+  , withBounds
   )
 
 import Finite.PowerSet

src/lib/Finite/Class.hs

@@ -18,6 +18,7 @@
   , MultiParamTypeClasses
   , TypeOperators
   , ScopedTypeVariables
+  , RankNTypes
   , RequiredTypeArguments
   , ViewPatterns
 
@@ -29,6 +30,7 @@ module Finite.Class
   ( FiniteBounds
   , Finite(..)
   , GFinite(..)
+  , withBounds
   ) where
 
 -----------------------------------------------------------------------------
@@ -59,11 +61,16 @@ import qualified Data.IntSet as S
 -----------------------------------------------------------------------------
 
 -- | A better looking constraint specifier.
-
 type FiniteBounds b = (?bounds :: b)
 
 -----------------------------------------------------------------------------
 
+-- | A more ergonomic way to set the implicit parameter.
+withBounds :: b -> (FiniteBounds b => c) -> c
+withBounds b x = let ?bounds = b in x
+
+-----------------------------------------------------------------------------
+
 -- | The 'Finite' class.
 class Finite b a where
   -- | Returns the number of elements associated with the given type.
@@ -106,7 +113,6 @@ class Finite b a where
     n = elements a
     o = offset a
 
-
   -- | Complements a given list of elements of that type
   complement :: FiniteBounds b => [a] -> [a]
   complement xs = value <$> ys

src/lib/Finite/Collection.hs

@@ -29,6 +29,7 @@ import Finite.Class
   , offset
   , value
   , index
+  , withBounds
   )
 
 import Data.Array.IArray
@@ -70,9 +71,7 @@ data Collection i a = Item i a
 -- finite sized array of bounding parameters, it is guaranteed that
 -- the connected collection has a finite bound as well.
 instance (Ix i, Finite b a) => Finite (Array i b) (Collection i a) where
-  elements _ = sum $ elms . snd <$> assocs ?bounds
-   where
-    elms b = let ?bounds = b in elements a
+  elements _ = sum $ (`withBounds` elements a) . snd <$> assocs ?bounds
 
   index (Item j v) = o + idx
    where
@@ -81,23 +80,22 @@ instance (Ix i, Finite b a) => Finite (Array i b) (Collection i a) where
     -- list of indicies that appear before j
     ys = assert (inRange (l, u) j) $ init $ range (l, j)
     -- offset induces by these indices
-    o = sum $ map (elms . (?bounds !)) ys
+    o = sum $ map ((`withBounds` elements a) . (?bounds !)) ys
     -- index of v with the bounds at position j
-    idx = let ?bounds = ?bounds ! j in index v - offset a
-
-    elms b = let ?bounds = b in elements a
+    idx = withBounds (?bounds ! j) $ index v - offset a
 
   value n =
     assert (n >= 0 && n < elements (Collection i a))
-      $ let ?bounds = ?bounds ! j in Item j $ value (m + offset a)
+      $ withBounds (?bounds ! j) $ Item j $ value (m + offset a)
    where
     -- target array index and reminder used as sub-index
     (j, m) = position n $ range $ bounds ?bounds
 
     position n = \case
-      []   -> assert False undefined
-      x:xr ->
-        let m = let ?bounds = ?bounds ! x in elements a
-        in if m <= n then position (n - m) xr else (x, n)
+      []                 -> assert False undefined
+      x : xr | m <= n    -> position (n - m) xr
+             | otherwise -> (x, n)
+       where
+        m = withBounds (?bounds ! x) $ elements a
 
 -----------------------------------------------------------------------------

src/lib/Finite/TH.hs

@@ -53,6 +53,7 @@ import Data.Hashable
 import Finite.Class
   ( FiniteBounds
   , Finite(..)
+  , withBounds
   )
 
 import Data.Char
@@ -591,28 +592,24 @@ appBounds x = x ?bounds
 elementsSwitch ::
   (Finite b' a, FiniteBounds b) => (b -> b') ->
   Finite b a => forall c -> (c ~ a, FiniteBounds b) => Int
-elementsSwitch f x =
-  let ?bounds = f ?bounds
-  in elements x
+elementsSwitch f x = withBounds (f ?bounds) $ elements x
 
 -----------------------------------------------------------------------------
 
 offsetSwitch ::
   (Finite b' a, FiniteBounds b) => (b -> b') ->
   Finite b a => forall c -> (c ~ a, FiniteBounds b) => Int
-offsetSwitch f x =
-  let ?bounds = f ?bounds
-  in offset x
+offsetSwitch f x = withBounds (f ?bounds) $ offset x
 
 -----------------------------------------------------------------------------
 
 indexSwitch :: (Finite b' a, FiniteBounds b) => (b -> b') -> a -> Int
-indexSwitch f = let ?bounds = f ?bounds in index
+indexSwitch f = withBounds (f ?bounds) index
 
 -----------------------------------------------------------------------------
 
 valueSwitch :: (Finite b' a, FiniteBounds b) => (b -> b') -> Int -> a
-valueSwitch f = let ?bounds = f ?bounds in value
+valueSwitch f = withBounds (f ?bounds) value
 
 -----------------------------------------------------------------------------