lib/Hcompta/Lib/Foldable.hs

   1 module Hcompta.Lib.Foldable where
   2
   3 import Data.Monoid
   4 import Data.Maybe (listToMaybe, maybeToList)
   5 import Data.Foldable (Foldable, foldMap, foldr)
   6
   7 -- | Return the first non-'Nothing' returned by the given function
   8 --   applied on the elements of a 'Foldable'.
   9 find :: Foldable t => (a -> Maybe b) -> t a -> Maybe b
  10 find f = listToMaybe . Data.Foldable.foldMap (maybeToList . f)
  11
  12 -- | Like 'Data.Either.partitionEithers' but generalized
  13 --   to work on a 'Foldable' containing 'Monoid's.
  14 --
  15 -- NOTE: any lazyness on resulting 'Monoid's is preserved.
  16 partitionEithers
  17  :: (Foldable t, Monoid r, Monoid l)
  18  => t (Either l r) -> (l, r)
  19 partitionEithers m =
  20         Data.Foldable.foldr (either left right) (mempty, mempty) m
  21         where
  22                 left  a ~(l, r) = (a`mappend`l, r)
  23                 right a ~(l, r) = (l, a`mappend`r)
  24
  25 -- | Return a tuple of accumulated 'Left's and folded 'Right's
  26 --   in the given 'Foldable'.
  27 --
  28 --   * NOTE: any lazyness on resulting 'Monoid's is preserved.
  29 --   * WARNING: beware that given an infinite 'Foldable',
  30 --              the initial 'Right' accumulator will never be appended
  31 --              to the final 'Right' accumulator.
  32 accumLeftsAndFoldrRights
  33  :: (Foldable t, Monoid l)
  34  => (r -> ra -> ra) -> ra -> t (Either l r) -> (l, ra)
  35 accumLeftsAndFoldrRights f rempty m =
  36         Data.Foldable.foldr (either left right) (mempty, rempty) m
  37         where
  38                 left  a ~(l, r) = (a`mappend`l, r)
  39                 right a ~(l, r) = (l, f a r)
  40
  41 -- | Type composition.
  42 --
  43 --   NOTE: this could eventually be replaced by
  44 --   adding a dependency on
  45 --   <https://hackage.haskell.org/package/TypeCompose>
  46 newtype Composition g f a = Composition (g (f a))
  47
  48 -- | A 'Foldable' of a 'Foldable' is itself a 'Foldable'.
  49 instance (Foldable f1, Foldable f2)
  50  => Foldable (Composition f1 f2) where
  51         foldr f acc (Composition o) =
  52                 Data.Foldable.foldr
  53                  (flip $ Data.Foldable.foldr f)
  54                  acc o