blob: cf1f80b82e39c893a3a87252b25b0b4763e7d137 (
plain) (
blame)
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
|
{-# LANGUAGE BangPatterns #-}
module Xanthous.Util
( EqEqProp(..)
, EqProp(..)
, foldlMapM
, foldlMapM'
, between
) where
import Xanthous.Prelude hiding (foldr)
import Test.QuickCheck.Checkers
import Data.Foldable (foldr)
newtype EqEqProp a = EqEqProp a
deriving newtype Eq
instance Eq a => EqProp (EqEqProp a) where
(=-=) = eq
foldlMapM :: forall g b a m. (Foldable g, Monoid b, Applicative m) => (a -> m b) -> g a -> m b
foldlMapM f = foldr f' (pure mempty)
where
f' :: a -> m b -> m b
f' x = liftA2 mappend (f x)
-- Strict in the monoidal accumulator. For monads strict
-- in the left argument of bind, this will run in constant
-- space.
foldlMapM' :: forall g b a m. (Foldable g, Monoid b, Monad m) => (a -> m b) -> g a -> m b
foldlMapM' f xs = foldr f' pure xs mempty
where
f' :: a -> (b -> m b) -> b -> m b
f' x k bl = do
br <- f x
let !b = mappend bl br
k b
between
:: Ord a
=> a -- ^ lower bound
-> a -- ^ upper bound
-> a -- ^ scrutinee
-> Bool
between lower upper x = x >= lower && x <= upper
|
