1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE ConstraintKinds  #-}
3{- |
4'Foldable' functions, with wrappers like the "Safe" module.
5-}
6module Safe.Foldable(
7    -- * New functions
8    findJust,
9    -- * Safe wrappers
10    foldl1May, foldl1Def, foldl1Note,
11    foldr1May, foldr1Def, foldr1Note,
12    findJustDef, findJustNote,
13    minimumMay, minimumNote,
14    maximumMay, maximumNote,
15    minimumByMay, minimumByNote,
16    maximumByMay, maximumByNote,
17    maximumBoundBy, minimumBoundBy,
18    maximumBounded, maximumBound,
19    minimumBounded, minimumBound,
20    -- * Discouraged
21    minimumDef, maximumDef, minimumByDef, maximumByDef,
22    -- * Deprecated
23    foldl1Safe, foldr1Safe, findJustSafe,
24    ) where
25
26import Safe.Util
27import Data.Foldable as F
28import Data.Maybe
29import Data.Monoid
30import Prelude
31import Safe.Partial
32
33
34---------------------------------------------------------------------
35-- UTILITIES
36
37fromNote :: Partial => String -> String -> Maybe a -> a
38fromNote = fromNoteModule "Safe.Foldable"
39
40
41---------------------------------------------------------------------
42-- WRAPPERS
43
44foldl1May, foldr1May :: Foldable t => (a -> a -> a) -> t a -> Maybe a
45foldl1May = liftMay F.null . F.foldl1
46foldr1May = liftMay F.null . F.foldr1
47
48foldl1Note, foldr1Note :: (Partial, Foldable t) => String -> (a -> a -> a) -> t a -> a
49foldl1Note note f x = withFrozenCallStack $ fromNote note "foldl1Note on empty" $ foldl1May f x
50foldr1Note note f x = withFrozenCallStack $ fromNote note "foldr1Note on empty" $ foldr1May f x
51
52minimumMay, maximumMay :: (Foldable t, Ord a) => t a -> Maybe a
53minimumMay = liftMay F.null F.minimum
54maximumMay = liftMay F.null F.maximum
55
56minimumNote, maximumNote :: (Partial, Foldable t, Ord a) => String -> t a -> a
57minimumNote note x = withFrozenCallStack $ fromNote note "minimumNote on empty" $ minimumMay x
58maximumNote note x = withFrozenCallStack $ fromNote note "maximumNote on empty" $ maximumMay x
59
60minimumByMay, maximumByMay :: Foldable t => (a -> a -> Ordering) -> t a -> Maybe a
61minimumByMay = liftMay F.null . F.minimumBy
62maximumByMay = liftMay F.null . F.maximumBy
63
64minimumByNote, maximumByNote :: (Partial, Foldable t) => String -> (a -> a -> Ordering) -> t a -> a
65minimumByNote note f x = withFrozenCallStack $ fromNote note "minimumByNote on empty" $ minimumByMay f x
66maximumByNote note f x = withFrozenCallStack $ fromNote note "maximumByNote on empty" $ maximumByMay f x
67
68-- | The largest element of a foldable structure with respect to the
69-- given comparison function. The result is bounded by the value given as the first argument.
70maximumBoundBy :: Foldable f => a -> (a -> a -> Ordering) -> f a -> a
71maximumBoundBy x f xs = maximumBy f $ x : toList xs
72
73-- | The smallest element of a foldable structure with respect to the
74-- given comparison function. The result is bounded by the value given as the first argument.
75minimumBoundBy :: Foldable f => a -> (a -> a -> Ordering) -> f a -> a
76minimumBoundBy x f xs = minimumBy f $ x : toList xs
77
78-- | The largest element of a foldable structure.
79-- The result is bounded by the value given as the first argument.
80maximumBound :: (Foldable f, Ord a) => a -> f a -> a
81maximumBound x xs = maximum $ x : toList xs
82
83-- | The smallest element of a foldable structure.
84-- The result is bounded by the value given as the first argument.
85minimumBound :: (Foldable f, Ord a) => a -> f a -> a
86minimumBound x xs = minimum $ x : toList xs
87
88-- | The largest element of a foldable structure.
89-- The result is bounded by 'minBound'.
90maximumBounded :: (Foldable f, Ord a, Bounded a) => f a -> a
91maximumBounded = maximumBound minBound
92
93-- | The largest element of a foldable structure.
94-- The result is bounded by 'maxBound'.
95minimumBounded :: (Foldable f, Ord a, Bounded a) => f a -> a
96minimumBounded = minimumBound maxBound
97
98-- |
99-- > findJust op = fromJust . find op
100findJust :: (Partial, Foldable t) => (a -> Bool) -> t a -> a
101findJust f x = withFrozenCallStack $ fromNote "" "findJust, no matching value" $ F.find f x
102
103findJustDef :: Foldable t => a -> (a -> Bool) -> t a -> a
104findJustDef def = fromMaybe def .^ F.find
105
106findJustNote :: (Partial, Foldable t) => String -> (a -> Bool) -> t a -> a
107findJustNote note f x = withFrozenCallStack $ fromNote note "findJustNote, no matching value" $ F.find f x
108
109
110---------------------------------------------------------------------
111-- DISCOURAGED
112
113-- | New users are recommended to use 'minimumBound' or 'maximumBound' instead.
114minimumDef, maximumDef :: (Foldable t, Ord a) => a -> t a -> a
115minimumDef def = fromMaybe def . minimumMay
116maximumDef def = fromMaybe def . maximumMay
117
118-- | New users are recommended to use 'minimumBoundBy' or 'maximumBoundBy' instead.
119minimumByDef, maximumByDef :: Foldable t => a -> (a -> a -> Ordering) -> t a -> a
120minimumByDef def = fromMaybe def .^ minimumByMay
121maximumByDef def = fromMaybe def .^ maximumByMay
122
123-- | New users are recommended to use 'foldr1May' or 'foldl1May' instead.
124foldl1Def, foldr1Def :: Foldable t => a -> (a -> a -> a) -> t a -> a
125foldl1Def def = fromMaybe def .^ foldl1May
126foldr1Def def = fromMaybe def .^ foldr1May
127
128
129---------------------------------------------------------------------
130-- DEPRECATED
131
132{-# DEPRECATED foldl1Safe "Use @foldl f mempty@ instead." #-}
133foldl1Safe :: (Monoid m, Foldable t) => (m -> m -> m) -> t m -> m
134foldl1Safe fun = F.foldl fun mempty
135
136{-# DEPRECATED foldr1Safe "Use @foldr f mempty@ instead." #-}
137foldr1Safe :: (Monoid m, Foldable t) => (m -> m -> m) -> t m -> m
138foldr1Safe fun = F.foldr fun mempty
139
140{-# DEPRECATED findJustSafe "Use @findJustDef mempty@ instead." #-}
141findJustSafe :: (Monoid m, Foldable t) => (m -> Bool) -> t m -> m
142findJustSafe = findJustDef mempty
143