packages feed

safe 0.3.4 → 0.3.5

raw patch · 6 files changed

+441/−225 lines, 6 files

Files

CHANGES.txt view
@@ -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
Safe.hs view
@@ -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
+ Safe/Exact.hs view
@@ -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)
Safe/Foldable.hs view
@@ -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
+ Safe/Util.hs view
@@ -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
safe.cabal view
@@ -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 <ndmitchell@gmail.com> 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