File: Safe.hs

package info (click to toggle)
haskell-safe 0.3.8-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 84 kB
  • sloc: haskell: 307; makefile: 2
file content (269 lines) | stat: -rw-r--r-- 8,798 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
{- |
A module wrapping @Prelude@/@Data.List@ functions that can throw exceptions, such as @head@ and @!!@.
Each unsafe function has up to four variants, e.g. with @tail@:

* @'tail' :: [a] -> [a]@, raises an error on @tail []@.

* @'tailMay' :: [a] -> /Maybe/ [a]@, turns errors into @Nothing@.

* @'tailDef' :: /[a]/ -> [a] -> [a]@, takes a default to return on errors.

* @'tailNote' :: /String/ -> [a] -> [a]@, takes an extra argument which supplements the error message.

* @'tailSafe' :: [a] -> [a]@, returns some sensible default if possible, @[]@ in the case of @tail@.

This module also introduces some new functions, documented at the top of the module.
-}

module Safe(
    -- * New functions
    abort, at, lookupJust, findJust, elemIndexJust, findIndexJust,
    -- * Safe wrappers
    tailMay, tailDef, tailNote, tailSafe,
    initMay, initDef, initNote, initSafe,
    headMay, headDef, headNote,
    lastMay, lastDef, lastNote,
    minimumMay, minimumDef, minimumNote,
    maximumMay, maximumDef, maximumNote,
    minimumByMay, minimumByDef, minimumByNote,
    maximumByMay, maximumByDef, maximumByNote,
    foldr1May, foldr1Def, foldr1Note,
    foldl1May, foldl1Def, foldl1Note,
    foldl1May', foldl1Def', foldl1Note',
    scanl1May, scanl1Def, scanl1Note,
    scanr1May, scanr1Def, scanr1Note,
    fromJustDef, fromJustNote,
    assertNote,
    atMay, atDef, atNote,
    readMay, readDef, readNote,
    lookupJustDef, lookupJustNote,
    findJustDef, findJustNote,
    elemIndexJustDef, elemIndexJustNote,
    findIndexJustDef, findIndexJustNote,
    ) where

import Safe.Util
import Data.List
import Data.Maybe

---------------------------------------------------------------------
-- UTILITIES

fromNote = fromNoteModule "Safe"
fromNoteEither = fromNoteEitherModule "Safe"


---------------------------------------------------------------------
-- IMPLEMENTATIONS

-- | Synonym for 'error'. Used for instances where the program
--   has decided to exit because of invalid user input, or the user pressed
--   quit etc. This function allows 'error' to be reserved for programmer errors.
abort :: String -> a
abort = error


at_ :: [a] -> Int -> Either String a
at_ xs o | o < 0 = Left $ "index must not be negative, index=" ++ show o
         | otherwise = f o xs
    where f 0 (x:xs) = Right x
          f i (x:xs) = f (i-1) xs
          f i [] = Left $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i)


read_ :: Read a => String -> Either String a
read_ s = case [x | (x,t) <- reads s, ("","") <- lex t] of
        [x] -> Right x
        []  -> Left $ "no parse on " ++ prefix
        _   -> Left $ "ambiguous parse on " ++ prefix
    where
        maxLength = 15
        prefix = '\"' : a ++ if length s <= maxLength then (b ++ "\"") else "...\""
            where (a,b) = splitAt (maxLength - 3) s


---------------------------------------------------------------------
-- WRAPPERS

-- |
-- > tailMay [] = Nothing
-- > tailMay [1,3,4] = Just [3,4]
tailMay :: [a] -> Maybe [a]
tailMay = liftMay null tail

-- |
-- > tailDef [12] [] = [12]
-- > tailDef [12] [1,3,4] = [3,4]
tailDef :: [a] -> [a] -> [a]
tailDef def = fromMaybe def . tailMay

-- |
-- > tailNote "help me" [] = error "Safe.tailNote [], help me"
-- > tailNote "help me" [1,3,4] = [3,4]
tailNote :: String -> [a] -> [a]
tailNote note = fromNote note "tailNote []" . tailMay

-- |
-- > tailSafe [] = []
-- > tailSafe [1,3,4] = [3,4]
tailSafe :: [a] -> [a]
tailSafe = tailDef []


initMay :: [a] -> Maybe [a]
initMay = liftMay null init

initDef :: [a] -> [a] -> [a]
initDef def = fromMaybe def . initMay

initNote :: String -> [a] -> [a]
initNote note = fromNote note "initNote []" . initMay

initSafe :: [a] -> [a]
initSafe = initDef []



headMay, lastMay :: [a] -> Maybe a
headMay = liftMay null head
lastMay = liftMay null last

headDef, lastDef :: a -> [a] -> a
headDef def = fromMaybe def . headMay
lastDef def = fromMaybe def . lastMay

headNote, lastNote :: String -> [a] -> a
headNote note = fromNote note "headNote []" . headMay
lastNote note = fromNote note "lastNote []" . lastMay

minimumMay, maximumMay :: Ord a => [a] -> Maybe a
minimumMay = liftMay null minimum
maximumMay = liftMay null maximum

minimumDef, maximumDef :: Ord a => a -> [a] -> a
minimumDef def = fromMaybe def . minimumMay
maximumDef def = fromMaybe def . maximumMay

minimumNote, maximumNote :: Ord a => String -> [a] -> a
minimumNote note = fromNote note "minumumNote []" . minimumMay
maximumNote note = fromNote note "maximumNote []" . maximumMay

minimumByMay, maximumByMay :: (a -> a -> Ordering) -> [a] -> Maybe a
minimumByMay = liftMay null . minimumBy
maximumByMay = liftMay null . maximumBy

minimumByDef, maximumByDef :: a -> (a -> a -> Ordering) -> [a] -> a
minimumByDef def = fromMaybe def .^ minimumByMay
maximumByDef def = fromMaybe def .^ maximumByMay

minimumByNote, maximumByNote :: String -> (a -> a -> Ordering) -> [a] -> a
minimumByNote note = fromNote note "minumumByNote []" .^ minimumByMay
maximumByNote note = fromNote note "maximumByNote []" .^ maximumByMay


foldr1May, foldl1May, foldl1May' :: (a -> a -> a) -> [a] -> Maybe a
foldr1May = liftMay null . foldr1
foldl1May = liftMay null . foldl1
foldl1May' = liftMay null . foldl1'

foldr1Def, foldl1Def, foldl1Def' :: a -> (a -> a -> a) -> [a] -> a
foldr1Def def = fromMaybe def .^ foldr1May
foldl1Def def = fromMaybe def .^ foldl1May
foldl1Def' def = fromMaybe def .^ foldl1May'

foldr1Note, foldl1Note, foldl1Note' :: String -> (a -> a -> a) -> [a] -> a
foldr1Note note = fromNote note "foldr1Note []" .^ foldr1May
foldl1Note note = fromNote note "foldl1Note []" .^ foldl1May
foldl1Note' note = fromNote note "foldl1Note []" .^ foldl1May'

scanr1May, scanl1May :: (a -> a -> a) -> [a] -> Maybe [a]
scanr1May = liftMay null . scanr1
scanl1May = liftMay null . scanl1

scanr1Def, scanl1Def :: [a] -> (a -> a -> a) -> [a] -> [a]
scanr1Def def = fromMaybe def .^ scanr1May
scanl1Def def = fromMaybe def .^ scanl1May

scanr1Note, scanl1Note :: String -> (a -> a -> a) -> [a] -> [a]
scanr1Note note = fromNote note "scanr1Note []" .^ scanr1May
scanl1Note note = fromNote note "scanl1Note []" .^ scanl1May

-- | An alternative name for 'fromMaybe', to fit the naming scheme of this package.
--   Generally using 'fromMaybe' directly would be considered better style.
fromJustDef :: a -> Maybe a -> a
fromJustDef  = fromMaybe

fromJustNote :: String -> Maybe a -> a
fromJustNote note = fromNote note "fromJustNote Nothing"

assertNote :: String -> Bool -> a -> a
assertNote note True val = val
assertNote note False val = fromNote note "assertNote False" Nothing


-- | Synonym for '!!', but includes more information in the error message.
at :: [a] -> Int -> a
at = fromNoteEither "" "at" .^ at_

atMay :: [a] -> Int -> Maybe a
atMay = eitherToMaybe .^ at_

atDef :: a -> [a] -> Int -> a
atDef def = fromMaybe def .^ atMay

atNote :: String -> [a] -> Int -> a
atNote note = fromNoteEither note "atNote" .^ at_


readMay :: Read a => String -> Maybe a
readMay = eitherToMaybe . read_

readDef :: Read a => a -> String -> a
readDef def = fromMaybe def . readMay

readNote :: Read a => String -> String -> a
readNote note = fromNoteEither note "readNote" . read_

-- |
-- > lookupJust key = fromJust . lookup key
lookupJust :: Eq a => a -> [(a,b)] -> b
lookupJust = fromNote "" "lookupJust, no matching value" .^ lookup

lookupJustDef :: Eq a => b -> a -> [(a,b)] -> b
lookupJustDef def = fromMaybe def .^ lookup

lookupJustNote :: Eq a => String -> a -> [(a,b)] -> b
lookupJustNote note = fromNote note "lookupJustNote, no matching value" .^ lookup

-- |
-- > findJust op = fromJust . find op
findJust :: (a -> Bool) -> [a] -> a
findJust = fromNote "" "findJust, no matching value" .^ find

findJustDef :: a -> (a -> Bool) -> [a] -> a
findJustDef def = fromMaybe def .^ find

findJustNote :: String -> (a -> Bool) -> [a] -> a
findJustNote note = fromNote note "findJustNote, no matching value" .^ find

-- |
-- > elemIndexJust op = fromJust . elemIndex op
elemIndexJust :: Eq a => a -> [a] -> Int
elemIndexJust = fromNote "" "elemIndexJust, no matching value" .^ elemIndex

elemIndexJustDef :: Eq a => Int -> a -> [a] -> Int
elemIndexJustDef def = fromMaybe def .^ elemIndex

elemIndexJustNote :: Eq a => String -> a -> [a] -> Int
elemIndexJustNote note = fromNote note "elemIndexJustNote, no matching value" .^ elemIndex

-- |
-- > findIndexJust op = fromJust . findIndex op
findIndexJust :: (a -> Bool) -> [a] -> Int
findIndexJust = fromNote "" "findIndexJust, no matching value" .^ findIndex

findIndexJustDef :: Int -> (a -> Bool) -> [a] -> Int
findIndexJustDef def = fromMaybe def .^ findIndex

findIndexJustNote :: String -> (a -> Bool) -> [a] -> Int
findIndexJustNote note = fromNote note "findIndexJustNote, no matching value" .^ findIndex