1{-# LANGUAGE FlexibleContexts #-}
2
3
4{-
5Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>
6
7All rights reserved.
8
9For license and copyright information, see the file COPYRIGHT
10
11-}
12
13{- |
14   Module     : Data.ListLike.Utils
15   Copyright  : Copyright (C) 2007 John Goerzen
16   License    : BSD3
17
18   Maintainer : John Lato <jwlato@gmail.com>
19   Stability  : provisional
20   Portability: portable
21
22Utilities for 'Data.ListLike.ListLike' and friends.  More functions
23similar to 'Data.List' but not part of the main typeclass.
24
25Written by John Goerzen, jgoerzen\@complete.org
26-}
27
28module Data.ListLike.Utils
29    (and, or, sum, product, zip, zipWith, unzip, sequence_, toMonadPlus, list,
30     intercalate
31    ) where
32import Prelude hiding (length, head, last, null, tail, map, filter, concat,
33                       any, lookup, init, all, foldl, foldr, foldl1, foldr1,
34                       maximum, minimum, iterate, span, break, takeWhile,
35                       dropWhile, reverse, zip, zipWith, sequence,
36                       sequence_, mapM, mapM_, concatMap, and, or, sum,
37                       product, repeat, replicate, cycle, take, drop,
38                       splitAt, elem, notElem, unzip, lines, words,
39                       unlines, unwords, foldMap)
40import Control.Monad (MonadPlus(..))
41import Data.ListLike.Base
42import Data.ListLike.FoldableLL
43import Data.Maybe (maybe)
44import Data.Monoid
45
46-- | Returns True if all elements are True
47and :: ListLike full Bool => full -> Bool
48and = all (== True)
49
50-- | Returns True if any element is True
51or :: ListLike full Bool => full -> Bool
52or = any (== True)
53
54-- | The sum of the list
55sum :: (Num a, ListLike full a) => full -> a
56sum = getSum . foldMap Sum
57
58-- | The product of the list
59product :: (Num a, ListLike full a) => full -> a
60product = getProduct . foldMap Product
61
62------------------------------ Zipping
63-- zip, zipWith  in Base
64{- | Converts a list of pairs into two separate lists of elements -}
65unzip :: (ListLike full (itema, itemb),
66          ListLike ra itema,
67          ListLike rb itemb) => full -> (ra, rb)
68unzip inp = foldr convert (empty, empty) inp
69    where convert (a, b) (as, bs) = ((cons a as), (cons b bs))
70
71-- | Converts to a MonadPlus instance
72toMonadPlus :: (MonadPlus m, ListLike full a) => full -> m (a, full)
73toMonadPlus = maybe mzero return . uncons
74
75-- | List-like destructor (like Data.Maybe.maybe)
76list :: ListLike full a => b -> (a -> full -> b) -> full -> b
77list d f = maybe d (uncurry f) . toMonadPlus
78
79-- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse'
80-- xs xss))@.  It inserts the list @xs@ in between the lists in @xss@
81-- and concatenates the result.
82intercalate :: (ListLike a item, ListLike b a)
83            => a -> b -> a
84intercalate x = concat . intersperse x
85