{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} {- | 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' :: 'Partial' => /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@. All functions marked with the @'Partial'@ constraint are not total, and will produce stack traces on error, on GHC versions which support them (see "GHC.Stack"). 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, cycleMay, cycleDef, cycleNote, fromJustDef, fromJustNote, assertNote, atMay, atDef, atNote, readMay, readDef, readNote, readEitherSafe, lookupJustDef, lookupJustNote, findJustDef, findJustNote, elemIndexJustDef, elemIndexJustNote, findIndexJustDef, findIndexJustNote, toEnumMay, toEnumDef, toEnumNote, toEnumSafe, succMay, succDef, succNote, succSafe, predMay, predDef, predNote, predSafe, indexMay, indexDef, indexNote, ) where import Safe.Util import Data.Ix import Data.List import Data.Maybe import Safe.Partial --------------------------------------------------------------------- -- UTILITIES fromNote :: Partial => String -> String -> Maybe a -> a fromNote = fromNoteModule "Safe" fromNoteEither :: Partial => String -> String -> Either String a -> a 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 :: Partial => String -> a abort x = withFrozenCallStack (error x) 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) --------------------------------------------------------------------- -- 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 :: Partial => String -> [a] -> [a] tailNote note x = withFrozenCallStack $ fromNote note "tailNote []" $ tailMay x -- | -- > 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 :: Partial => String -> [a] -> [a] initNote note x = withFrozenCallStack $ fromNote note "initNote []" $ initMay x 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 :: Partial => String -> [a] -> a headNote note x = withFrozenCallStack $ fromNote note "headNote []" $ headMay x lastNote note x = withFrozenCallStack $ fromNote note "lastNote []" $ lastMay x 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 :: (Partial, Ord a) => String -> [a] -> a minimumNote note x = withFrozenCallStack $ fromNote note "minumumNote []" $ minimumMay x maximumNote note x = withFrozenCallStack $ fromNote note "maximumNote []" $ maximumMay x 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 :: Partial => String -> (a -> a -> Ordering) -> [a] -> a minimumByNote note f x = withFrozenCallStack $ fromNote note "minumumByNote []" $ minimumByMay f x maximumByNote note f x = withFrozenCallStack $ fromNote note "maximumByNote []" $ maximumByMay f x 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' :: Partial => String -> (a -> a -> a) -> [a] -> a foldr1Note note f x = withFrozenCallStack $ fromNote note "foldr1Note []" $ foldr1May f x foldl1Note note f x = withFrozenCallStack $ fromNote note "foldl1Note []" $ foldl1May f x foldl1Note' note f x = withFrozenCallStack $ fromNote note "foldl1Note []" $ foldl1May' f x 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 :: Partial => String -> (a -> a -> a) -> [a] -> [a] scanr1Note note f x = withFrozenCallStack $ fromNote note "scanr1Note []" $ scanr1May f x scanl1Note note f x = withFrozenCallStack $ fromNote note "scanl1Note []" $ scanl1May f x cycleMay :: [a] -> Maybe [a] cycleMay = liftMay null cycle cycleDef :: [a] -> [a] -> [a] cycleDef def = fromMaybe def . cycleMay cycleNote :: Partial => String -> [a] -> [a] cycleNote note x = withFrozenCallStack $ fromNote note "cycleNote []" $ cycleMay x -- | 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 :: Partial => String -> Maybe a -> a fromJustNote note x = withFrozenCallStack $ fromNote note "fromJustNote Nothing" x assertNote :: Partial => String -> Bool -> a -> a assertNote note True val = val assertNote note False val = withFrozenCallStack $ fromNote note "assertNote False" Nothing -- | Synonym for '!!', but includes more information in the error message. at :: Partial => [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 :: Partial => String -> [a] -> Int -> a atNote note f x = withFrozenCallStack $ fromNoteEither note "atNote" $ at_ f x -- | This function provides a more precise error message than 'readEither' from 'base'. readEitherSafe :: Read a => String -> Either String a readEitherSafe 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 readMay :: Read a => String -> Maybe a readMay = eitherToMaybe . readEitherSafe readDef :: Read a => a -> String -> a readDef def = fromMaybe def . readMay -- | 'readNote' uses 'readEitherSafe' for the error message. readNote :: (Partial, Read a) => String -> String -> a readNote note x = withFrozenCallStack $ fromNoteEither note "readNote" $ readEitherSafe x -- | -- > lookupJust key = fromJust . lookup key lookupJust :: (Eq a, Partial) => a -> [(a,b)] -> b lookupJust x xs = withFrozenCallStack $ fromNote "" "lookupJust, no matching value" $ lookup x xs lookupJustDef :: Eq a => b -> a -> [(a,b)] -> b lookupJustDef def = fromMaybe def .^ lookup lookupJustNote :: (Partial, Eq a) => String -> a -> [(a,b)] -> b lookupJustNote note x xs = withFrozenCallStack $ fromNote note "lookupJustNote, no matching value" $ lookup x xs -- | -- > 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 :: Partial => String -> (a -> Bool) -> [a] -> a findJustNote note f x = withFrozenCallStack $ fromNote note "findJustNote, no matching value" $ find f x -- | -- > elemIndexJust op = fromJust . elemIndex op elemIndexJust :: (Partial, Eq a) => a -> [a] -> Int elemIndexJust x xs = withFrozenCallStack $ fromNote "" "elemIndexJust, no matching value" $ elemIndex x xs elemIndexJustDef :: Eq a => Int -> a -> [a] -> Int elemIndexJustDef def = fromMaybe def .^ elemIndex elemIndexJustNote :: (Partial, Eq a) => String -> a -> [a] -> Int elemIndexJustNote note x xs = withFrozenCallStack $ fromNote note "elemIndexJustNote, no matching value" $ elemIndex x xs -- | -- > findIndexJust op = fromJust . findIndex op findIndexJust :: (a -> Bool) -> [a] -> Int findIndexJust f x = withFrozenCallStack $ fromNote "" "findIndexJust, no matching value" $ findIndex f x findIndexJustDef :: Int -> (a -> Bool) -> [a] -> Int findIndexJustDef def = fromMaybe def .^ findIndex findIndexJustNote :: Partial => String -> (a -> Bool) -> [a] -> Int findIndexJustNote note f x = withFrozenCallStack $ fromNote note "findIndexJustNote, no matching value" $ findIndex f x -- From http://stackoverflow.com/questions/2743858/safe-and-polymorphic-toenum -- answer by C. A. McCann toEnumMay :: (Enum a, Bounded a) => Int -> Maybe a toEnumMay i = let r = toEnum i max = maxBound `asTypeOf` r min = minBound `asTypeOf` r in if i >= fromEnum min && i <= fromEnum max then Just r else Nothing toEnumDef :: (Enum a, Bounded a) => a -> Int -> a toEnumDef def = fromMaybe def . toEnumMay toEnumNote :: (Partial, Enum a, Bounded a) => String -> Int -> a toEnumNote note x = withFrozenCallStack $ fromNote note "toEnumNote, out of range" $ toEnumMay x toEnumSafe :: (Enum a, Bounded a) => Int -> a toEnumSafe = toEnumDef minBound succMay :: (Enum a, Eq a, Bounded a) => a -> Maybe a succMay = liftMay (== maxBound) succ succDef :: (Enum a, Eq a, Bounded a) => a -> a -> a succDef def = fromMaybe def . succMay succNote :: (Partial, Enum a, Eq a, Bounded a) => String -> a -> a succNote note x = withFrozenCallStack $ fromNote note "succNote, out of range" $ succMay x succSafe :: (Enum a, Eq a, Bounded a) => a -> a succSafe = succDef maxBound predMay :: (Enum a, Eq a, Bounded a) => a -> Maybe a predMay = liftMay (== minBound) pred predDef :: (Enum a, Eq a, Bounded a) => a -> a -> a predDef def = fromMaybe def . predMay predNote :: (Partial, Enum a, Eq a, Bounded a) => String -> a -> a predNote note x = withFrozenCallStack $ fromNote note "predNote, out of range" $ predMay x predSafe :: (Enum a, Eq a, Bounded a) => a -> a predSafe = predDef minBound indexMay :: Ix a => (a, a) -> a -> Maybe Int indexMay b i = if inRange b i then Just (index b i) else Nothing indexDef :: Ix a => Int -> (a, a) -> a -> Int indexDef def b = fromMaybe def . indexMay b indexNote :: (Partial, Ix a) => String -> (a, a) -> a -> Int indexNote note x y = withFrozenCallStack $ fromNote note "indexNote, out of range" $ indexMay x y