1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE ConstraintKinds  #-}
3{- |
4A module wrapping @Prelude@/@Data.List@ functions that can throw exceptions, such as @head@ and @!!@.
5Each unsafe function has up to four variants, e.g. with @tail@:
6
7* @'tail' :: [a] -> [a]@, raises an error on @tail []@.
8
9* @'tailMay' :: [a] -> /Maybe/ [a]@, turns errors into @Nothing@.
10
11* @'tailDef' :: /[a]/ -> [a] -> [a]@, takes a default to return on errors.
12
13* @'tailNote' :: 'Partial' => /String/ -> [a] -> [a]@, takes an extra argument which supplements the error message.
14
15* @'tailSafe' :: [a] -> [a]@, returns some sensible default if possible, @[]@ in the case of @tail@.
16
17All functions marked with the @'Partial'@ constraint are not total, and will produce stack traces on error, on GHC
18versions which support them (see "GHC.Stack").
19
20This module also introduces some new functions, documented at the top of the module.
21-}
22
23module Safe(
24    -- * New functions
25    abort, at, lookupJust, findJust, elemIndexJust, findIndexJust,
26    -- * Safe wrappers
27    tailMay, tailDef, tailNote, tailSafe,
28    initMay, initDef, initNote, initSafe,
29    headMay, headDef, headNote,
30    lastMay, lastDef, lastNote,
31    minimumMay, minimumNote,
32    maximumMay, maximumNote,
33    minimumByMay, minimumByNote,
34    maximumByMay, maximumByNote,
35    minimumBoundBy, maximumBoundBy,
36    maximumBounded, maximumBound,
37    minimumBounded, minimumBound,
38    foldr1May, foldr1Def, foldr1Note,
39    foldl1May, foldl1Def, foldl1Note,
40    foldl1May', foldl1Def', foldl1Note',
41    scanl1May, scanl1Def, scanl1Note,
42    scanr1May, scanr1Def, scanr1Note,
43    cycleMay, cycleDef, cycleNote,
44    fromJustDef, fromJustNote,
45    assertNote,
46    atMay, atDef, atNote,
47    readMay, readDef, readNote, readEitherSafe,
48    lookupJustDef, lookupJustNote,
49    findJustDef, findJustNote,
50    elemIndexJustDef, elemIndexJustNote,
51    findIndexJustDef, findIndexJustNote,
52    toEnumMay, toEnumDef, toEnumNote, toEnumSafe,
53    succMay, succDef, succNote, succSafe,
54    predMay, predDef, predNote, predSafe,
55    indexMay, indexDef, indexNote,
56    -- * Discouraged
57    minimumDef, maximumDef, minimumByDef, maximumByDef
58    ) where
59
60import Safe.Util
61import Data.Ix
62import Data.List
63import Data.Maybe
64import Safe.Partial
65
66---------------------------------------------------------------------
67-- UTILITIES
68
69fromNote :: Partial => String -> String -> Maybe a -> a
70fromNote = fromNoteModule "Safe"
71
72fromNoteEither :: Partial => String -> String -> Either String a -> a
73fromNoteEither = fromNoteEitherModule "Safe"
74
75
76---------------------------------------------------------------------
77-- IMPLEMENTATIONS
78
79-- | Synonym for 'error'. Used for instances where the program
80--   has decided to exit because of invalid user input, or the user pressed
81--   quit etc. This function allows 'error' to be reserved for programmer errors.
82abort :: Partial => String -> a
83abort x = withFrozenCallStack (error x)
84
85
86at_ :: [a] -> Int -> Either String a
87at_ xs o | o < 0 = Left $ "index must not be negative, index=" ++ show o
88         | otherwise = f o xs
89    where f 0 (x:xs) = Right x
90          f i (x:xs) = f (i-1) xs
91          f i [] = Left $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i)
92
93
94---------------------------------------------------------------------
95-- WRAPPERS
96
97-- |
98-- > tailMay [] = Nothing
99-- > tailMay [1,3,4] = Just [3,4]
100tailMay :: [a] -> Maybe [a]
101tailMay = liftMay null tail
102
103-- |
104-- > tailDef [12] [] = [12]
105-- > tailDef [12] [1,3,4] = [3,4]
106tailDef :: [a] -> [a] -> [a]
107tailDef def = fromMaybe def . tailMay
108
109-- |
110-- > tailNote "help me" [] = error "Safe.tailNote [], help me"
111-- > tailNote "help me" [1,3,4] = [3,4]
112tailNote :: Partial => String -> [a] -> [a]
113tailNote note x = withFrozenCallStack $ fromNote note "tailNote []" $ tailMay x
114
115-- |
116-- > tailSafe [] = []
117-- > tailSafe [1,3,4] = [3,4]
118tailSafe :: [a] -> [a]
119tailSafe = tailDef []
120
121
122initMay :: [a] -> Maybe [a]
123initMay = liftMay null init
124
125initDef :: [a] -> [a] -> [a]
126initDef def = fromMaybe def . initMay
127
128initNote :: Partial => String -> [a] -> [a]
129initNote note x = withFrozenCallStack $ fromNote note "initNote []" $ initMay x
130
131initSafe :: [a] -> [a]
132initSafe = initDef []
133
134
135
136headMay, lastMay :: [a] -> Maybe a
137headMay = liftMay null head
138lastMay = liftMay null last
139
140headDef, lastDef :: a -> [a] -> a
141headDef def = fromMaybe def . headMay
142lastDef def = fromMaybe def . lastMay
143
144headNote, lastNote :: Partial => String -> [a] -> a
145headNote note x = withFrozenCallStack $ fromNote note "headNote []" $ headMay x
146lastNote note x = withFrozenCallStack $ fromNote note "lastNote []" $ lastMay x
147
148minimumMay, maximumMay :: Ord a => [a] -> Maybe a
149minimumMay = liftMay null minimum
150maximumMay = liftMay null maximum
151
152minimumNote, maximumNote :: (Partial, Ord a) => String -> [a] -> a
153minimumNote note x = withFrozenCallStack $ fromNote note "minumumNote []" $ minimumMay x
154maximumNote note x = withFrozenCallStack $ fromNote note "maximumNote []" $ maximumMay x
155
156minimumByMay, maximumByMay :: (a -> a -> Ordering) -> [a] -> Maybe a
157minimumByMay = liftMay null . minimumBy
158maximumByMay = liftMay null . maximumBy
159
160minimumByNote, maximumByNote :: Partial => String -> (a -> a -> Ordering) -> [a] -> a
161minimumByNote note f x = withFrozenCallStack $ fromNote note "minumumByNote []" $ minimumByMay f x
162maximumByNote note f x = withFrozenCallStack $ fromNote note "maximumByNote []" $ maximumByMay f x
163
164-- | The largest element of a list with respect to the
165-- given comparison function. The result is bounded by the value given as the first argument.
166maximumBoundBy :: a -> (a -> a -> Ordering) -> [a] -> a
167maximumBoundBy x f xs = maximumBy f $ x : xs
168
169-- | The smallest element of a list with respect to the
170-- given comparison function. The result is bounded by the value given as the first argument.
171minimumBoundBy :: a -> (a -> a -> Ordering) -> [a] -> a
172minimumBoundBy x f xs = minimumBy f $ x : xs
173
174-- | The largest element of a list.
175-- The result is bounded by the value given as the first argument.
176maximumBound :: Ord a => a -> [a] -> a
177maximumBound x xs = maximum $ x : xs
178
179-- | The smallest element of a list.
180-- The result is bounded by the value given as the first argument.
181minimumBound :: Ord a => a -> [a] -> a
182minimumBound x xs = minimum $ x : xs
183
184-- | The largest element of a list.
185-- The result is bounded by 'minBound'.
186maximumBounded :: (Ord a, Bounded a) => [a] -> a
187maximumBounded = maximumBound minBound
188
189-- | The largest element of a list.
190-- The result is bounded by 'maxBound'.
191minimumBounded :: (Ord a, Bounded a) => [a] -> a
192minimumBounded = minimumBound maxBound
193
194foldr1May, foldl1May, foldl1May' :: (a -> a -> a) -> [a] -> Maybe a
195foldr1May = liftMay null . foldr1
196foldl1May = liftMay null . foldl1
197foldl1May' = liftMay null . foldl1'
198
199foldr1Note, foldl1Note, foldl1Note' :: Partial => String -> (a -> a -> a) -> [a] -> a
200foldr1Note note f x = withFrozenCallStack $ fromNote note "foldr1Note []" $ foldr1May f x
201foldl1Note note f x = withFrozenCallStack $ fromNote note "foldl1Note []" $ foldl1May f x
202foldl1Note' note f x = withFrozenCallStack $ fromNote note "foldl1Note []" $ foldl1May' f x
203
204scanr1May, scanl1May :: (a -> a -> a) -> [a] -> Maybe [a]
205scanr1May = liftMay null . scanr1
206scanl1May = liftMay null . scanl1
207
208scanr1Def, scanl1Def :: [a] -> (a -> a -> a) -> [a] -> [a]
209scanr1Def def = fromMaybe def .^ scanr1May
210scanl1Def def = fromMaybe def .^ scanl1May
211
212scanr1Note, scanl1Note :: Partial => String -> (a -> a -> a) -> [a] -> [a]
213scanr1Note note f x = withFrozenCallStack $ fromNote note "scanr1Note []" $ scanr1May f x
214scanl1Note note f x = withFrozenCallStack $ fromNote note "scanl1Note []" $ scanl1May f x
215
216cycleMay :: [a] -> Maybe [a]
217cycleMay = liftMay null cycle
218
219cycleDef :: [a] -> [a] -> [a]
220cycleDef def = fromMaybe def . cycleMay
221
222cycleNote :: Partial => String -> [a] -> [a]
223cycleNote note x = withFrozenCallStack $ fromNote note "cycleNote []" $ cycleMay x
224
225-- | An alternative name for 'fromMaybe', to fit the naming scheme of this package.
226--   Generally using 'fromMaybe' directly would be considered better style.
227fromJustDef :: a -> Maybe a -> a
228fromJustDef  = fromMaybe
229
230fromJustNote :: Partial => String -> Maybe a -> a
231fromJustNote note x = withFrozenCallStack $ fromNote note "fromJustNote Nothing" x
232
233assertNote :: Partial => String -> Bool -> a -> a
234assertNote note True val = val
235assertNote note False val = withFrozenCallStack $ fromNote note "assertNote False" Nothing
236
237
238-- | Synonym for '!!', but includes more information in the error message.
239at :: Partial => [a] -> Int -> a
240at = fromNoteEither "" "at" .^ at_
241
242atMay :: [a] -> Int -> Maybe a
243atMay = eitherToMaybe .^ at_
244
245atDef :: a -> [a] -> Int -> a
246atDef def = fromMaybe def .^ atMay
247
248atNote :: Partial => String -> [a] -> Int -> a
249atNote note f x = withFrozenCallStack $ fromNoteEither note "atNote" $ at_ f x
250
251-- | This function provides a more precise error message than 'readEither' from 'base'.
252readEitherSafe :: Read a => String -> Either String a
253readEitherSafe s = case [x | (x,t) <- reads s, ("","") <- lex t] of
254        [x] -> Right x
255        []  -> Left $ "no parse on " ++ prefix
256        _   -> Left $ "ambiguous parse on " ++ prefix
257    where
258        maxLength = 15
259        prefix = '\"' : a ++ if length s <= maxLength then b ++ "\"" else "...\""
260            where (a,b) = splitAt (maxLength - 3) s
261
262readMay :: Read a => String -> Maybe a
263readMay = eitherToMaybe . readEitherSafe
264
265readDef :: Read a => a -> String -> a
266readDef def = fromMaybe def . readMay
267
268-- | 'readNote' uses 'readEitherSafe' for the error message.
269readNote :: (Partial, Read a) => String -> String -> a
270readNote note x = withFrozenCallStack $ fromNoteEither note "readNote" $ readEitherSafe x
271
272-- |
273-- > lookupJust key = fromJust . lookup key
274lookupJust :: (Eq a, Partial) => a -> [(a,b)] -> b
275lookupJust x xs = withFrozenCallStack $ fromNote "" "lookupJust, no matching value" $ lookup x xs
276
277lookupJustDef :: Eq a => b -> a -> [(a,b)] -> b
278lookupJustDef def = fromMaybe def .^ lookup
279
280lookupJustNote :: (Partial, Eq a) => String -> a -> [(a,b)] -> b
281lookupJustNote note x xs = withFrozenCallStack $ fromNote note "lookupJustNote, no matching value" $ lookup x xs
282
283-- |
284-- > findJust op = fromJust . find op
285findJust :: (a -> Bool) -> [a] -> a
286findJust = fromNote "" "findJust, no matching value" .^ find
287
288findJustDef :: a -> (a -> Bool) -> [a] -> a
289findJustDef def = fromMaybe def .^ find
290
291findJustNote :: Partial => String -> (a -> Bool) -> [a] -> a
292findJustNote note f x = withFrozenCallStack $ fromNote note "findJustNote, no matching value" $ find f x
293
294-- |
295-- > elemIndexJust op = fromJust . elemIndex op
296elemIndexJust :: (Partial, Eq a) => a -> [a] -> Int
297elemIndexJust x xs = withFrozenCallStack $ fromNote "" "elemIndexJust, no matching value" $ elemIndex x xs
298
299elemIndexJustDef :: Eq a => Int -> a -> [a] -> Int
300elemIndexJustDef def = fromMaybe def .^ elemIndex
301
302elemIndexJustNote :: (Partial, Eq a) => String -> a -> [a] -> Int
303elemIndexJustNote note x xs = withFrozenCallStack $ fromNote note "elemIndexJustNote, no matching value" $ elemIndex x xs
304
305-- |
306-- > findIndexJust op = fromJust . findIndex op
307findIndexJust :: (a -> Bool) -> [a] -> Int
308findIndexJust f x = withFrozenCallStack $ fromNote "" "findIndexJust, no matching value" $ findIndex f x
309
310findIndexJustDef :: Int -> (a -> Bool) -> [a] -> Int
311findIndexJustDef def = fromMaybe def .^ findIndex
312
313findIndexJustNote :: Partial => String -> (a -> Bool) -> [a] -> Int
314findIndexJustNote note f x = withFrozenCallStack $ fromNote note "findIndexJustNote, no matching value" $ findIndex f x
315
316-- From http://stackoverflow.com/questions/2743858/safe-and-polymorphic-toenum
317-- answer by C. A. McCann
318toEnumMay :: (Enum a, Bounded a) => Int -> Maybe a
319toEnumMay i =
320  let r = toEnum i
321      max = maxBound `asTypeOf` r
322      min = minBound `asTypeOf` r
323  in if i >= fromEnum min && i <= fromEnum max
324  then Just r
325  else Nothing
326
327toEnumDef :: (Enum a, Bounded a) => a -> Int -> a
328toEnumDef def = fromMaybe def . toEnumMay
329
330toEnumNote :: (Partial, Enum a, Bounded a) => String -> Int -> a
331toEnumNote note x = withFrozenCallStack $ fromNote note "toEnumNote, out of range" $ toEnumMay x
332
333toEnumSafe :: (Enum a, Bounded a) => Int -> a
334toEnumSafe = toEnumDef minBound
335
336succMay :: (Enum a, Eq a, Bounded a) => a -> Maybe a
337succMay = liftMay (== maxBound) succ
338
339succDef :: (Enum a, Eq a, Bounded a) => a -> a -> a
340succDef def = fromMaybe def . succMay
341
342succNote :: (Partial, Enum a, Eq a, Bounded a) => String -> a -> a
343succNote note x = withFrozenCallStack $ fromNote note "succNote, out of range" $ succMay x
344
345succSafe :: (Enum a, Eq a, Bounded a) => a -> a
346succSafe = succDef maxBound
347
348predMay :: (Enum a, Eq a, Bounded a) => a -> Maybe a
349predMay = liftMay (== minBound) pred
350
351predDef :: (Enum a, Eq a, Bounded a) => a -> a -> a
352predDef def = fromMaybe def . predMay
353
354predNote :: (Partial, Enum a, Eq a, Bounded a) => String -> a -> a
355predNote note x = withFrozenCallStack $ fromNote note "predNote, out of range" $ predMay x
356
357predSafe :: (Enum a, Eq a, Bounded a) => a -> a
358predSafe = predDef minBound
359
360indexMay :: Ix a => (a, a) -> a -> Maybe Int
361indexMay b i = if inRange b i then Just (index b i) else Nothing
362
363indexDef :: Ix a => Int -> (a, a) -> a -> Int
364indexDef def b = fromMaybe def . indexMay b
365
366indexNote :: (Partial, Ix a) => String -> (a, a) -> a -> Int
367indexNote note x y = withFrozenCallStack $ fromNote note "indexNote, out of range" $ indexMay x y
368
369
370---------------------------------------------------------------------
371-- DISCOURAGED
372
373-- | New users are recommended to use 'minimumBound' or 'maximumBound' instead.
374minimumDef, maximumDef :: Ord a => a -> [a] -> a
375minimumDef def = fromMaybe def . minimumMay
376maximumDef def = fromMaybe def . maximumMay
377
378-- | New users are recommended to use 'minimumBoundBy' or 'maximumBoundBy' instead.
379minimumByDef, maximumByDef :: a -> (a -> a -> Ordering) -> [a] -> a
380minimumByDef def = fromMaybe def .^ minimumByMay
381maximumByDef def = fromMaybe def .^ maximumByMay
382
383
384---------------------------------------------------------------------
385-- DEPRECATED
386
387{-# DEPRECATED foldr1Def "Use @foldr1May@ instead." #-}
388{-# DEPRECATED foldl1Def "Use @foldl1May@ instead." #-}
389{-# DEPRECATED foldl1Def' "Use @foldl1May'@ instead." #-}
390foldr1Def, foldl1Def, foldl1Def' :: a -> (a -> a -> a) -> [a] -> a
391foldr1Def def = fromMaybe def .^ foldr1May
392foldl1Def def = fromMaybe def .^ foldl1May
393foldl1Def' def = fromMaybe def .^ foldl1May'
394