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