diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,12 @@ Changelog for Safe +0.3.5 + Add Safe elemIndexJust/findIndexJust functions + Add Safe scan functions + Add Safe minimumBy/maximumBy functions + Add a module of Exact functions + Add Foldable minimum functions + Clean up the Foldable module, deprecate the Safe variants 0.3.4 #1, improve the string clipping in readNote 0.3.3 diff --git a/Safe.hs b/Safe.hs --- a/Safe.hs +++ b/Safe.hs @@ -1,271 +1,269 @@ {- | -A library for safe functions, based on standard functions that may crash. - -In general, each unsafe function has up to 4 forms. -Since 'tail' has all the possible forms, it is fully documented. -The others all follow the same pattern. - - -* @Note@, takes an extra argument which supplements the error message, 'tailNote' - -* @Def@, take an extra argument to give when a crash would otherwise happen, 'tailDef' - -* @May@, wraps the result in a Maybe, 'tailMay' - -* @Safe@, returns a default type if possible, 'tailSafe' +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@: -This library also introduces three brand new functions: +* @'tail' :: [a] -> [a]@, raises an error on @tail []@. -* 'at' - synonym for @(!!)@ +* @'tailMay' :: [a] -> /Maybe/ [a]@, turns errors into @Nothing@. -* 'lookupJust' - defined as @lookupJust k = fromJust . lookup k@ +* @'tailDef' :: /[a]/ -> [a] -> [a]@, takes a default to return on errors. -* 'findJust' - defined as @findJust f = fromJust . find f@ +* @'tailNote' :: /String/ -> [a] -> [a]@, takes an extra argument which supplements the error message. -* 'abort' - same as @error@, but different intended meaning +* @'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( - tailDef, tailMay, tailNote, tailSafe, - initDef, initMay, initNote, initSafe, - headDef, headMay, headNote, - lastDef, lastMay, lastNote, - minimumDef, minimumMay, minimumNote, - maximumDef, maximumMay, maximumNote, - foldr1Def, foldr1May, foldr1Note, - foldl1Def, foldl1May, foldl1Note, - foldl1Def', foldl1May', foldl1Note', + -- * 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, - at, atDef, atMay, atNote, - readDef, readMay, readNote, - lookupJust, lookupJustDef, lookupJustNote, - findJust, findJustDef, findJustNote, - abort + 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 -liftDef :: (a -> b) -> (a -> Bool) -> b -> (a -> b) -liftDef func test def val = if test val then def else func val +fromNote = fromNoteModule "Safe" +fromNoteEither = fromNoteEitherModule "Safe" -liftMay :: (a -> b) -> (a -> Bool) -> (a -> Maybe b) -liftMay func test val = if test val then Nothing else Just $ func val -liftNote :: (a -> b) -> (a -> Bool) -> String -> String -> (a -> b) -liftNote func test caller note val = - if test val - then error $ "Pattern match failure, " ++ caller ++ ", " ++ note - else func val +--------------------------------------------------------------------- +-- IMPLEMENTATIONS -liftSafe :: (a -> a) -> (a -> Bool) -> (a -> a) -liftSafe func test val = if test val then val else func val +-- | 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 --- | --- > tailDef [12] [] = [12] --- > tailDef [12] [1,3,4] = [3,4] -tailDef :: [a] -> [a] -> [a] -tailDef = liftDef tail null +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 tail null +tailMay :: [a] -> Maybe [a] +tailMay = liftMay null tail -- | --- > tail "help me" [] = error "Pattern match failure, tail [], help me" --- > tail "help me" [1,3,4] = [3,4] +-- > 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 = liftNote tail null "tail []" +tailNote note = fromNote note "tailNote []" . tailMay -- | -- > tailSafe [] = [] -- > tailSafe [1,3,4] = [3,4] tailSafe :: [a] -> [a] -tailSafe = liftSafe tail null +tailSafe = tailDef [] -initDef :: [a] -> [a] -> [a] -initDef = liftDef init null +initMay :: [a] -> Maybe [a] +initMay = liftMay null init -initMay :: [a] -> Maybe [a] -initMay = liftMay init null +initDef :: [a] -> [a] -> [a] +initDef def = fromMaybe def . initMay initNote :: String -> [a] -> [a] -initNote = liftNote init null "init []" +initNote note = fromNote note "initNote []" . initMay initSafe :: [a] -> [a] -initSafe = liftSafe init null - - - -headDef :: a -> [a] -> a -headDef = liftDef head null - -headMay :: [a] -> Maybe a -headMay = liftMay head null - -headNote :: String -> [a] -> a -headNote = liftNote head null "head []" - - -lastDef :: a -> [a] -> a -lastDef = liftDef last null - -lastMay :: [a] -> Maybe a -lastMay = liftMay last null - -lastNote :: String -> [a] -> a -lastNote = liftNote last null "last []" +initSafe = initDef [] -minimumDef :: Ord a => a -> [a] -> a -minimumDef = liftDef minimum null - -minimumMay :: Ord a => [a] -> Maybe a -minimumMay = liftMay minimum null - -minimumNote :: Ord a => String -> [a] -> a -minimumNote = liftNote minimum null "minimum []" - +headMay, lastMay :: [a] -> Maybe a +headMay = liftMay null head +lastMay = liftMay null last -maximumDef :: Ord a => a -> [a] -> a -maximumDef = liftDef maximum null +headDef, lastDef :: a -> [a] -> a +headDef def = fromMaybe def . headMay +lastDef def = fromMaybe def . lastMay -maximumMay :: Ord a => [a] -> Maybe a -maximumMay = liftMay maximum null +headNote, lastNote :: String -> [a] -> a +headNote note = fromNote note "headNote []" . headMay +lastNote note = fromNote note "lastNote []" . lastMay -maximumNote :: Ord a => String -> [a] -> a -maximumNote = liftNote maximum null "maximum []" +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 -foldr1Def :: a -> (a -> a -> a) -> [a] -> a -foldr1Def def f = liftDef (foldr1 f) null def +minimumByMay, maximumByMay :: Ord a => (a -> a -> Ordering) -> [a] -> Maybe a +minimumByMay = liftMay null . minimumBy +maximumByMay = liftMay null . maximumBy -foldr1May :: (a -> a -> a) -> [a] -> Maybe a -foldr1May f = liftMay (foldr1 f) null +minimumByDef, maximumByDef :: Ord a => a -> (a -> a -> Ordering) -> [a] -> a +minimumByDef def = fromMaybe def .^ minimumByMay +maximumByDef def = fromMaybe def .^ maximumByMay -foldr1Note :: String -> (a -> a -> a) -> [a] -> a -foldr1Note note f = liftNote (foldr1 f) null "foldr1 []" note +minimumByNote, maximumByNote :: Ord a => String -> (a -> a -> Ordering) -> [a] -> a +minimumByNote note = fromNote note "minumumByNote []" .^ minimumByMay +maximumByNote note = fromNote note "maximumByNote []" .^ maximumByMay -foldl1Def :: a -> (a -> a -> a) -> [a] -> a -foldl1Def def f = liftDef (foldl1 f) null def - -foldl1May :: (a -> a -> a) -> [a] -> Maybe a -foldl1May f = liftMay (foldl1 f) null - -foldl1Note :: String -> (a -> a -> a) -> [a] -> a -foldl1Note note f = liftNote (foldl1 f) null "foldl1 []" note +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' -foldl1Def' :: a -> (a -> a -> a) -> [a] -> a -foldl1Def' def f = liftDef (foldl1' f) null def +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' -foldl1May' :: (a -> a -> a) -> [a] -> Maybe a -foldl1May' f = liftMay (foldl1' f) null +scanr1May, scanl1May :: (a -> a -> a) -> [a] -> Maybe [a] +scanr1May = liftMay null . scanr1 +scanl1May = liftMay null . scanl1 -foldl1Note' :: String -> (a -> a -> a) -> [a] -> a -foldl1Note' note f = liftNote (foldl1' f) null "foldl1' []" note +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 --- | See fromMaybe +-- | 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 = liftDef fromJust isNothing +fromJustDef = fromMaybe fromJustNote :: String -> Maybe a -> a -fromJustNote = liftNote fromJust isNothing "fromJust Nothing" - - +fromJustNote note = fromNote note "fromJustNote Nothing" assertNote :: String -> Bool -> a -> a -assertNote msg False val = error $ "assertion failed, " ++ msg -assertNote msg True val = val - +assertNote note True val = val +assertNote note False val = fromNote note "assertNote False" Nothing --- | Same as @(!!)@, but better error message +-- | Synonym for '!!', but includes more information in the error message. at :: [a] -> Int -> a -at = atNote "called by at" - -atDef :: a -> [a] -> Int -> a -atDef def x n = fromMaybe def (atMay x n) +at = fromNoteEither "" "at" .^ at_ atMay :: [a] -> Int -> Maybe a -atMay xs n | n < 0 = Nothing -atMay [] _ = Nothing -atMay (x:_) 0 = Just x -atMay (_:xs) n = atMay xs (n-1) +atMay = eitherToMaybe .^ at_ +atDef :: a -> [a] -> Int -> a +atDef def = fromMaybe def .^ atMay + atNote :: String -> [a] -> Int -> a -atNote msg _ n | n < 0 = error $ "Safe.at: negative index, " ++ msg -atNote msg xs n = f xs n - where - f [] i = error $ "Safe.at: index too large, index=" ++ show n ++ ", length=" ++ show (n-i) ++ ", " ++ msg - f (x:_) 0 = x - f (_:xs) i = f xs (i-1) +atNote note = fromNoteEither note "atNote" .^ at_ +readMay :: Read a => String -> Maybe a +readMay = eitherToMaybe . read_ readDef :: Read a => a -> String -> a -readDef def s = fromMaybe def (readMay s) - -readMay :: Read a => String -> Maybe a -readMay s = case [x | (x,t) <- reads s, ("","") <- lex t] of - [x] -> Just x - _ -> Nothing +readDef def = fromMaybe def . readMay readNote :: Read a => String -> String -> a -readNote msg s = case [x | (x,t) <- reads s, ("","") <- lex t] of - [x] -> x - [] -> error $ "Prelude.read: no parse, " ++ msg ++ ", on " ++ prefix - _ -> error $ "Prelude.read: ambiguous parse, " ++ msg ++ ", on " ++ prefix - where - maxLength = 15 - prefix = '\"' : a ++ if length s <= maxLength then (b ++ "\"") else "...\"" - where (a,b) = splitAt (maxLength - 3) s - +readNote note = fromNoteEither note "readNote" . read_ -- | -- > lookupJust key = fromJust . lookup key lookupJust :: Eq a => a -> [(a,b)] -> b -lookupJust key = fromJustNote "lookupJust, item not found" . lookup key +lookupJust = fromNote "" "lookupJust, no matching value" .^ lookup lookupJustDef :: Eq a => b -> a -> [(a,b)] -> b -lookupJustDef def key lst = fromMaybe def (lookup key lst) +lookupJustDef def = fromMaybe def .^ lookup lookupJustNote :: Eq a => String -> a -> [(a,b)] -> b -lookupJustNote msg key lst = case lookup key lst of - Nothing -> error $ "Safe.lookupJust: element not found, " ++ msg - Just x -> x - - +lookupJustNote note = fromNote note "lookupJustNote, no matching value" .^ lookup -- | -- > findJust op = fromJust . find op findJust :: (a -> Bool) -> [a] -> a -findJust op = fromJustNote "findJust, item not found" . find op +findJust = fromNote "" "findJust, no matching value" .^ find findJustDef :: a -> (a -> Bool) -> [a] -> a -findJustDef def op lst = fromMaybe def (find op lst) +findJustDef def = fromMaybe def .^ find findJustNote :: String -> (a -> Bool) -> [a] -> a -findJustNote msg op lst = case find op lst of - Nothing -> error $ "Safe.findJust: element not found, " ++ msg - Just x -> x +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 --- | Exactly the same as @error@. Use this for instances where the program --- has decided to exit because of invalid user input, or the user pressed --- quit etc. This allows @error@ to be reserved for genuine coding mistakes. -abort :: String -> a -abort = error +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 diff --git a/Safe/Exact.hs b/Safe/Exact.hs new file mode 100644 --- /dev/null +++ b/Safe/Exact.hs @@ -0,0 +1,138 @@ +{- | +Provides functions that raise errors in corner cases instead of returning \"best effort\" +results, then provides wrappers like the "Safe" module. For example: + +* @'takeExact' 3 [1,2]@ raises an error, in contrast to 'take' which would return + just two elements. + +* @'takeExact' (-1) [1,2]@ raises an error, in contrast to 'take' which would return + no elements. + +* @'zip' [1,2] [1]@ raises an error, in contrast to 'zip' which would only pair up the + first element. + +Note that the @May@ variants of these functions are /strict/ in at least the bit of the prefix +of the list required to spot errors. The standard and @Note@ versions are lazy, but throw +errors later in the process - they do not check upfront. +-} +module Safe.Exact( + -- * New functions + takeExact, dropExact, splitAtExact, + zipExact, zipWithExact, + -- * Safe wrappers + takeExactMay, takeExactNote, + dropExactMay, dropExactNote, + splitAtExactMay, splitAtExactNote, + zipExactMay, zipExactNote, + zipWithExactMay, zipWithExactNote, + ) where + +import Control.Arrow + + +--------------------------------------------------------------------- +-- HELPERS + +addNote note fun msg = error $ + "Safe.Exact." ++ fun ++ ", " ++ msg ++ (if null note then "" else ", " ++ note) + + +--------------------------------------------------------------------- +-- IMPLEMENTATIONS + +{-# INLINE splitAtExact_ #-} +splitAtExact_ :: (String -> r) -> ([a] -> r) -> (a -> r -> r) -> Int -> [a] -> r +splitAtExact_ err nil cons o xs + | o < 0 = err $ "index must not be negative, index=" ++ show o + | otherwise = f o xs + where + f 0 xs = nil xs + f i (x:xs) = x `cons` f (i-1) xs + f i [] = err $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i) + + +{-# INLINE zipWithExact_ #-} +zipWithExact_ :: (String -> r) -> r -> (a -> b -> r -> r) -> [a] -> [b] -> r +zipWithExact_ err nil cons = f + where + f (x:xs) (y:ys) = cons x y $ f xs ys + f [] [] = nil + f [] _ = err "second list is longer than the first" + f _ [] = err "first list is longer than the second" + + +--------------------------------------------------------------------- +-- TAKE/DROP/SPLIT + +-- | +-- > takeExact n xs = +-- > | n >= 0 && n <= length xs = take n xs +-- > | otherwise = error "some message" +takeExact :: Int -> [a] -> [a] +takeExact = splitAtExact_ (addNote "" "takeExact") (const []) (:) + +-- | +-- > dropExact n xs = +-- > | n >= 0 && n <= length xs = drop n xs +-- > | otherwise = error "some message" +dropExact :: Int -> [a] -> [a] +dropExact = splitAtExact_ (addNote "" "dropExact") id (flip const) + +-- | +-- > splitAtExact n xs = +-- > | n >= 0 && n <= length xs = splitAt n xs +-- > | otherwise = error "some message" +splitAtExact :: Int -> [a] -> ([a], [a]) +splitAtExact = splitAtExact_ (addNote "" "splitAtExact") + (\x -> ([], x)) (\a b -> first (a:) b) + +takeExactNote :: String -> Int -> [a] -> [a] +takeExactNote note = splitAtExact_ (addNote note "takeExactNote") (const []) (:) + +takeExactMay :: Int -> [a] -> Maybe [a] +takeExactMay = splitAtExact_ (const Nothing) (const $ Just []) (\a -> fmap (a:)) + +dropExactNote :: String -> Int -> [a] -> [a] +dropExactNote note = splitAtExact_ (addNote note "dropExactNote") id (flip const) + +dropExactMay :: Int -> [a] -> Maybe [a] +dropExactMay = splitAtExact_ (const Nothing) Just (flip const) + +splitAtExactNote :: String -> Int -> [a] -> ([a], [a]) +splitAtExactNote note = splitAtExact_ (addNote note "splitAtExactNote") + (\x -> ([], x)) (\a b -> first (a:) b) + +splitAtExactMay :: Int -> [a] -> Maybe ([a], [a]) +splitAtExactMay = splitAtExact_ (const Nothing) + (\x -> Just ([], x)) (\a b -> fmap (first (a:)) b) + + +--------------------------------------------------------------------- +-- ZIP + +-- | +-- > zipExact xs ys = +-- > | length xs == length ys = zip xs ys +-- > | otherwise = error "some message" +zipExact :: [a] -> [b] -> [(a,b)] +zipExact = zipWithExact_ (addNote "" "zipExact") [] (\a b xs -> (a,b) : xs) + +-- | +-- > zipWithExact f xs ys = +-- > | length xs == length ys = zipWith f xs ys +-- > | otherwise = error "some message" +zipWithExact :: (a -> b -> c) -> [a] -> [b] -> [c] +zipWithExact f = zipWithExact_ (addNote "" "zipWithExact") [] (\a b xs -> f a b : xs) + + +zipExactNote :: String -> [a] -> [b] -> [(a,b)] +zipExactNote note = zipWithExact_ (addNote note "zipExactNote") [] (\a b xs -> (a,b) : xs) + +zipExactMay :: [a] -> [b] -> Maybe [(a,b)] +zipExactMay = zipWithExact_ (const Nothing) (Just []) (\a b xs -> fmap ((a,b) :) xs) + +zipWithExactNote :: String -> (a -> b -> c) -> [a] -> [b] -> [c] +zipWithExactNote note f = zipWithExact_ (addNote note "zipWithExactNote") [] (\a b xs -> f a b : xs) + +zipWithExactMay :: (a -> b -> c) -> [a] -> [b] -> Maybe [c] +zipWithExactMay f = zipWithExact_ (const Nothing) (Just []) (\a b xs -> fmap (f a b :) xs) diff --git a/Safe/Foldable.hs b/Safe/Foldable.hs --- a/Safe/Foldable.hs +++ b/Safe/Foldable.hs @@ -1,71 +1,99 @@ {- | -Equivalent versions to the "Safe" module, but generalised to work -over any 'Foldable' type. +'Foldable' functions, with wrappers like the "Safe" module. -} module Safe.Foldable( - foldl1Note, foldl1Def, foldl1May, foldl1Safe, - foldr1Note, foldr1Def, foldr1May, foldr1Safe, - findJust, findJustDef, findJustNote, findJustSafe + -- * New functions + findJust, + -- * Safe wrappers + foldl1May, foldl1Def, foldl1Note, + foldr1May, foldr1Def, foldr1Note, + findJustDef, findJustNote, + minimumMay, minimumDef, minimumNote, + maximumMay, maximumDef, maximumNote, + minimumByMay, minimumByDef, minimumByNote, + maximumByMay, maximumByDef, maximumByNote, + -- * Deprecated + foldl1Safe, foldr1Safe, findJustSafe ) where -import Data.Foldable +import Safe.Util +import Data.Foldable as F import Data.Monoid import Data.Maybe -import Prelude hiding (foldl, foldr) -mfl :: (a -> a -> a) -> Maybe a -> a -> Maybe a -mfl _ Nothing x = Just x -mfl fun (Just y) x = Just (fun y x) --- | --- > Same as Data.Foldable.foldl1 -foldl1Note :: Foldable t => String -> (a -> a -> a) -> t a -> a -foldl1Note msg fun fld = fromMaybe (error $ "Safe.Foldable.foldl1Note: empty list, " ++ msg) (foldl (mfl fun) Nothing fld) +--------------------------------------------------------------------- +-- UTILITIES -foldl1Def :: Foldable t => a -> (a -> a -> a) -> t a -> a -foldl1Def def fun fld = fromMaybe def (foldl (mfl fun) Nothing fld) +fromNote = fromNoteModule "Safe.Foldable" -foldl1May :: Foldable t => (a -> a -> a) -> t a -> Maybe a -foldl1May fun = foldl (mfl fun) Nothing +isNull :: Foldable t => t a -> Bool +isNull = null . toList --- | Default value is the mempty from a monoid -foldl1Safe :: (Monoid m, Foldable t) => (m -> m -> m) -> t m -> m -foldl1Safe fun = foldl fun mempty +--------------------------------------------------------------------- +-- WRAPPERS -mfr :: (a -> a -> a) -> a -> Maybe a -> Maybe a -mfr _ x Nothing = Just x -mfr fun x (Just y) = Just (fun x y) +foldl1May, foldr1May :: Foldable t => (a -> a -> a) -> t a -> Maybe a +foldl1May = liftMay isNull . F.foldl1 +foldr1May = liftMay isNull . F.foldr1 --- | --- > Same as Data.Foldable.foldr1 -foldr1Note :: Foldable t => String -> (a -> a -> a) -> t a -> a -foldr1Note msg fun fld = fromMaybe (error $ "Safe.Foldable.foldr1Note: empty list, " ++ msg) (foldr (mfr fun) Nothing fld) +foldl1Note, foldr1Note :: Foldable t => String -> (a -> a -> a) -> t a -> a +foldl1Note note = fromNote note "foldl1Note on empty" .^ foldl1May +foldr1Note note = fromNote note "foldr1Note on empty" .^ foldr1May -foldr1Def :: Foldable t => a -> (a -> a -> a) -> t a -> a -foldr1Def def fun fld = fromMaybe def (foldr (mfr fun) Nothing fld) +foldl1Def, foldr1Def :: Foldable t => a -> (a -> a -> a) -> t a -> a +foldl1Def def = fromMaybe def .^ foldl1May +foldr1Def def = fromMaybe def .^ foldr1May -foldr1May :: Foldable t => (a -> a -> a) -> t a -> Maybe a -foldr1May fun = foldr (mfr fun) Nothing +minimumMay, maximumMay :: (Foldable t, Ord a) => t a -> Maybe a +minimumMay = liftMay isNull F.minimum +maximumMay = liftMay isNull F.maximum --- | Default value is the mempty from a monoid -foldr1Safe :: (Monoid m, Foldable t) => (m -> m -> m) -> t m -> m -foldr1Safe fun = foldr fun mempty +minimumDef, maximumDef :: (Foldable t, Ord a) => a -> t a -> a +minimumDef def = fromMaybe def . minimumMay +maximumDef def = fromMaybe def . maximumMay --- | --- > Same as Data.Foldable.find +minimumNote, maximumNote :: (Foldable t, Ord a) => String -> t a -> a +minimumNote note = fromNote note "minimumNote on empty" . minimumMay +maximumNote note = fromNote note "maximumNote on empty" . maximumMay +minimumByMay, maximumByMay :: (Foldable t, Ord a) => (a -> a -> Ordering) -> t a -> Maybe a +minimumByMay = liftMay isNull . F.minimumBy +maximumByMay = liftMay isNull . F.maximumBy + +minimumByDef, maximumByDef :: (Foldable t, Ord a) => a -> (a -> a -> Ordering) -> t a -> a +minimumByDef def = fromMaybe def .^ minimumByMay +maximumByDef def = fromMaybe def .^ maximumByMay + +minimumByNote, maximumByNote :: (Foldable t, Ord a) => String -> (a -> a -> Ordering) -> t a -> a +minimumByNote note = fromNote note "minimumByNote on empty" .^ minimumByMay +maximumByNote note = fromNote note "maximumByNote on empty" .^ maximumByMay + +-- | +-- > findJust op = fromJust . find op findJust :: Foldable t => (a -> Bool) -> t a -> a -findJust op fld = fromMaybe (error "Safe.Foldable.findJust, item not found") (find op fld) +findJust = fromNote "" "findJust, no matching value" .^ F.find findJustDef :: Foldable t => a -> (a -> Bool) -> t a -> a -findJustDef def op fld = fromMaybe def (find op fld) +findJustDef def = fromMaybe def .^ F.find findJustNote :: Foldable t => String -> (a -> Bool) -> t a -> a -findJustNote msg op fld = fromMaybe (error $ "Safe.Foldable.findJustNote: element not found, " ++ msg) (find op fld) +findJustNote note = fromNote note "findJustNote, no matching value" .^ F.find --- | Default value is the mempty from a monoid -findJustSafe :: (Monoid m, Foldable t) => (m -> Bool) -> t m -> m -findJustSafe op fld = fromMaybe mempty (find op fld) +--------------------------------------------------------------------- +-- DEPRECATED +{-# DEPRECATED foldl1Safe "Use @foldl f mempty@ instead." #-} +foldl1Safe :: (Monoid m, Foldable t) => (m -> m -> m) -> t m -> m +foldl1Safe fun = F.foldl fun mempty + +{-# DEPRECATED foldr1Safe "Use @foldr f mempty@ instead." #-} +foldr1Safe :: (Monoid m, Foldable t) => (m -> m -> m) -> t m -> m +foldr1Safe fun = F.foldr fun mempty + + +{-# DEPRECATED findJustSafe "Use @findJustDef mempty@ instead." #-} +findJustSafe :: (Monoid m, Foldable t) => (m -> Bool) -> t m -> m +findJustSafe = findJustDef mempty diff --git a/Safe/Util.hs b/Safe/Util.hs new file mode 100644 --- /dev/null +++ b/Safe/Util.hs @@ -0,0 +1,26 @@ + +-- | Internal utilities. +module Safe.Util where + +import Data.Maybe + + +(.^) :: (b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c +(.^) f g x1 x2 = f (g x1 x2) + +(.^^) :: (b -> c) -> (a1 -> a2 -> a3 -> b) -> a1 -> a2 -> a3 -> c +(.^^) f g x1 x2 x3 = f (g x1 x2 x3) + +liftMay :: (a -> Bool) -> (a -> b) -> (a -> Maybe b) +liftMay test func val = if test val then Nothing else Just $ func val + +fromNoteModule :: String -> String -> String -> Maybe a -> a +fromNoteModule modu note func = fromMaybe (error msg) + where msg = modu ++ "." ++ func ++ (if null note then "" else ", " ++ note) + +fromNoteEitherModule :: String -> String -> String -> Either String a -> a +fromNoteEitherModule modu note func = either (error . msg) id + where msg ex = modu ++ "." ++ func ++ " " ++ ex ++ (if null note then "" else ", " ++ note) + +eitherToMaybe :: Either a b -> Maybe b +eitherToMaybe = either (const Nothing) Just diff --git a/safe.cabal b/safe.cabal --- a/safe.cabal +++ b/safe.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.6 build-type: Simple name: safe -version: 0.3.4 +version: 0.3.5 license: BSD3 license-file: LICENSE category: Unclassified @@ -9,15 +9,30 @@ maintainer: Neil Mitchell copyright: Neil Mitchell 2007-2014 homepage: http://community.haskell.org/~ndm/safe/ -synopsis: Library for safe (pattern match free) functions -tested-with: GHC==7.6.3, GHC==7.4.2, GHC==7.2.2 +synopsis: Library of safe (exception free) functions +bug-reports: https://github.com/ndmitchell/safe/issues +tested-with: GHC==7.8.2, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2 description: - Partial functions from the base library, such as @head@ and @!!@, modified - to return more descriptive error messages, programmer defined error messages, - @Maybe@ wrapped results and default values. - - These functions can be used to reduce the number of unsafe pattern matches in - your code. + A library 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 package is divided into three modules: + . + * "Safe" contains safe variants of @Prelude@ and @Data.List@ functions. + . + * "Safe.Foldable" contains safe variants of @Foldable@ functions. + . + * "Safe.Exact" creates crashing versions of functions like @zip@ (errors if the lists are not equal) and @take@ (errors if there are not enough elements), then wraps them to provide safe variants. extra-source-files: CHANGES.txt @@ -31,4 +46,8 @@ exposed-modules: Safe + Safe.Exact Safe.Foldable + + other-modules: + Safe.Util