src/Symantic/Compta/Utils/Foldable.hs

   1 module Symantic.Compta.Utils.Foldable where
   2
   3 import Data.Either (Either(..), either)
   4 import Data.Foldable (Foldable(..))
   5 import Data.Function ((.))
   6 import Data.Maybe (Maybe(..), listToMaybe, maybeToList)
   7 import Data.Monoid (Monoid(..))
   8
   9 -- | Return the first non-'Nothing' returned by the given function
  10 --   applied on the elements of a 'Foldable'.
  11 find :: Foldable t => (a -> Maybe b) -> t a -> Maybe b
  12 find f = listToMaybe . foldMap (maybeToList . f)
  13
  14 -- | Like 'Data.Either.partitionEithers' but generalized
  15 --   to work on a 'Foldable' containing 'Monoid's.
  16 --
  17 -- NOTE: any lazyness on resulting 'Monoid's is preserved.
  18 partitionEithers ::
  19   Foldable t => Monoid r => Monoid l =>
  20   t (Either l r) -> (l, r)
  21 partitionEithers =
  22   foldr (either left right) (mempty, mempty)
  23   where
  24   left  a ~(l, r) = (a`mappend`l, r)
  25   right a ~(l, r) = (l, a`mappend`r)
  26
  27 -- | Return a tuple of accumulated 'Left's and folded 'Right's
  28 --   in the given 'Foldable'.
  29 --
  30 --   * NOTE: any lazyness on resulting 'Monoid's is preserved.
  31 --   * WARNING: beware that given an infinite 'Foldable',
  32 --              the initial 'Right' accumulator will never be appended
  33 --              to the final 'Right' accumulator.
  34 accumLeftsAndFoldrRights ::
  35   Foldable t => Monoid l =>
  36   (r -> ra -> ra) -> ra -> t (Either l r) -> (l, ra)
  37 accumLeftsAndFoldrRights f rempty =
  38   foldr (either left right) (mempty, rempty)
  39   where
  40   left  a ~(l, r) = (a`mappend`l, r)
  41   right a ~(l, r) = (l, f a r)