Selective binds

SelectiveBinds.hs

bindIntegralS :: (Selective f, Integral a) => f a -> (a -> f b) -> f b
bindIntegralS fn k = pivot 0 (findLB (-1) 0) (findUB 0 1)
 where
  pivot !m = ifS $ fn <&> (< m)
  findLB m ub = pivot m (findLB (m * 2) m) (bs m ub)
  findUB lb m = pivot m (bs lb m) (findUB m (m * 2))
  bs lb ub
    | ub - lb <= 1 = k lb
    | otherwise    = pivot mid (bs lb mid) (bs mid ub)
   where mid = (lb + ub) `div` 2

bindBitsS
  :: forall f a b
   . (Selective f, FiniteBits a)
  => f a -> (a -> f b) -> f b
bindBitsS fn k = fill (finiteBitSize z - 1) z
 where
  z = zeroBits :: a
  fill !i bits
    | i < 0     = k bits
    | otherwise = ifS (fn <&> (`testBit` i))
      (fill (i - 1) (bits `setBit` i))
      (fill (i - 1)  bits            )