safe 0.3.7 → 0.3.21
raw patch · 10 files changed
Files
- CHANGES.txt +43/−8
- LICENSE +1/−1
- README.md +15/−0
- Safe.hs +226/−78
- Safe/Exact.hs +78/−25
- Safe/Foldable.hs +83/−40
- Safe/Partial.hs +44/−0
- Safe/Util.hs +26/−5
- Test.hs +155/−0
- safe.cabal +27/−7
CHANGES.txt view
@@ -1,23 +1,58 @@ Changelog for Safe -0.3.7+0.3.21, released 2024-01-18+ #34, mark headErr/tailErr as Partial+0.3.20, released 2024-01-14+ #34, add headErr, tailErr+ #33, avoid using head/tail to avoid x-partial+0.3.19, released 2020-05-24+ #30, undeprecate maximumDef and friends, fold*1Def+0.3.18, released 2019-12-04+ #27, deprecate maximumDef and friends, fold*1Def+ #27, add maximumBounded and friends+ Stop supporting GHC 7.4 to 7.8+0.3.17, released 2018-03-09+ Improve the display of errors, less internal callstack+ Add a few missing Partial constraints+0.3.16, released 2018-01-06+ #22, add Safe index+0.3.15, released 2017-06-18+ Support QuickCheck 2.10+0.3.14, released 2017-02-15+ #20, fix for GHC 7.10.1+0.3.13, released 2017-02-09+ #20, require GHC 7.4 or above+0.3.12, released 2017-02-05+ #19, add Safe.Partial exposing a Partial typeclass+ #19, add support for GHC call stacks+0.3.11, released 2017-01-22+ #16, add Safe succ and pred+ #16, add readEitherSafe for better errors than readEither+ #14, add Safe zip3Exact+0.3.10, released 2016-11-08+ #15, add Safe cycle+0.3.9, released 2015-05-09+ #9, add Safe toEnum+0.3.8, released 2014-08-10+ #8, remove unnecessary Ord constraints from Foldable functions+0.3.7, released 2014-07-16 Add Def variants of the Exact functions-0.3.6+0.3.6, released 2014-07-12 #6, remove unnecessary Ord constraints from maximumBy/minimumBy-0.3.5+0.3.5, released 2014-06-28 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+0.3.4, released 2014-01-30 #1, improve the string clipping in readNote-0.3.3+0.3.3, released 2011-11-15 #494, add foldl1' wrappings-0.3.2+0.3.2, released 2011-11-13 Add a Safe.Foldable module-0.3.1+0.3.1, released 2011-11-09 Add findJust, safe wrapping of fromJust/find-0.3+0.3, released 2010-11-10 Start of changelog
LICENSE view
@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2007-2014.+Copyright Neil Mitchell 2007-2024. All rights reserved. Redistribution and use in source and binary forms, with or without
+ README.md view
@@ -0,0 +1,15 @@+# Safe [](https://hackage.haskell.org/package/safe) [](https://www.stackage.org/package/safe) [](https://github.com/ndmitchell/safe/actions)++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`:++* <tt>tail :: [a] -> [a]</tt>, raises an error on `tail []`.+* <tt>tailMay :: [a] -> <i>Maybe</i> [a]</tt>, turns errors into `Nothing`.+* <tt>tailDef :: <i>[a]</i> -> [a] -> [a]</tt>, takes a default to return on errors.+* <tt>tailNote :: <i>String</i> -> [a] -> [a]</tt>, takes an extra argument which supplements the error message.+* <tt>tailSafe :: [a] -> [a]</tt>, 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.
Safe.hs view
@@ -1,55 +1,82 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}++{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}+ {- | 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@:+Each unsafe function has up to five variants, e.g. with @tail@: -* @'tail' :: [a] -> [a]@, raises an error on @tail []@.+* @'tail' :: [a] -> [a]@, raises an error on @tail []@, as provided by 'Prelude'. +* @'tailErr' :: [a] -> [a]@, alias for @tail@ that doesn't trigger an @x-partial@ warning and does raise errors.+ * @'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.+* @'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,+ -- * Partial functions+ tailErr, headErr, -- * 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,+ minimumMay, minimumNote,+ maximumMay, maximumNote,+ minimumByMay, minimumByNote,+ maximumByMay, maximumByNote,+ minimumBoundBy, maximumBoundBy,+ maximumBounded, maximumBound,+ minimumBounded, minimumBound, 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,+ 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,+ -- * Discouraged+ minimumDef, maximumDef, minimumByDef, maximumByDef ) 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" @@ -59,8 +86,8 @@ -- | 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+abort :: Partial => String -> a+abort x = withFrozenCallStack (error x) at_ :: [a] -> Int -> Either String a@@ -71,25 +98,31 @@ 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 +-- | Identical to 'tail', namely that fails on an empty list.+-- Useful to avoid the @x-partial@ warning introduced in GHC 9.8.+--+-- > tailErr [] = error "Prelude.tail: empty list"+-- > tailErr [1,2,3] = [2,3]+tailErr :: Partial => [a] -> [a]+tailErr = tail++-- | Identical to 'head', namely that fails on an empty list.+-- Useful to avoid the @x-partial@ warning introduced in GHC 9.8.+--+-- > headErr [] = error "Prelude.head: empty list"+-- > headErr [1,2,3] = 1+headErr :: Partial => [a] -> a+headErr = head+ -- | -- > tailMay [] = Nothing -- > tailMay [1,3,4] = Just [3,4] tailMay :: [a] -> Maybe [a]-tailMay = liftMay null tail+tailMay [] = Nothing+tailMay (_:xs) = Just xs -- | -- > tailDef [12] [] = [12]@@ -100,8 +133,8 @@ -- | -- > 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+tailNote :: Partial => String -> [a] -> [a]+tailNote note x = withFrozenCallStack $ fromNote note "tailNote []" $ tailMay x -- | -- > tailSafe [] = []@@ -116,8 +149,8 @@ initDef :: [a] -> [a] -> [a] initDef def = fromMaybe def . initMay -initNote :: String -> [a] -> [a]-initNote note = fromNote note "initNote []" . initMay+initNote :: Partial => String -> [a] -> [a]+initNote note x = withFrozenCallStack $ fromNote note "initNote []" $ initMay x initSafe :: [a] -> [a] initSafe = initDef []@@ -125,56 +158,72 @@ headMay, lastMay :: [a] -> Maybe a-headMay = liftMay null head+headMay = listToMaybe 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+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 :: Ord a => String -> [a] -> a-minimumNote note = fromNote note "minumumNote []" . minimumMay-maximumNote note = fromNote note "maximumNote []" . 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 -minimumByNote, maximumByNote :: String -> (a -> a -> Ordering) -> [a] -> a-minimumByNote note = fromNote note "minumumByNote []" .^ minimumByMay-maximumByNote note = fromNote note "maximumByNote []" .^ maximumByMay+-- | The largest element of a list with respect to the+-- given comparison function. The result is bounded by the value given as the first argument.+maximumBoundBy :: a -> (a -> a -> Ordering) -> [a] -> a+maximumBoundBy x f xs = maximumBy f $ x : xs +-- | The smallest element of a list with respect to the+-- given comparison function. The result is bounded by the value given as the first argument.+minimumBoundBy :: a -> (a -> a -> Ordering) -> [a] -> a+minimumBoundBy x f xs = minimumBy f $ x : xs +-- | The largest element of a list.+-- The result is bounded by the value given as the first argument.+maximumBound :: Ord a => a -> [a] -> a+maximumBound x xs = maximum $ x : xs++-- | The smallest element of a list.+-- The result is bounded by the value given as the first argument.+minimumBound :: Ord a => a -> [a] -> a+minimumBound x xs = minimum $ x : xs++-- | The largest element of a list.+-- The result is bounded by 'minBound'.+maximumBounded :: (Ord a, Bounded a) => [a] -> a+maximumBounded = maximumBound minBound++-- | The largest element of a list.+-- The result is bounded by 'maxBound'.+minimumBounded :: (Ord a, Bounded a) => [a] -> a+minimumBounded = minimumBound maxBound+ 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'+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@@ -184,25 +233,34 @@ 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+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 :: String -> Maybe a -> a-fromJustNote note = fromNote note "fromJustNote Nothing"+fromJustNote :: Partial => String -> Maybe a -> a+fromJustNote note x = withFrozenCallStack $ fromNote note "fromJustNote Nothing" x -assertNote :: String -> Bool -> a -> a+assertNote :: Partial => String -> Bool -> a -> a assertNote note True val = val-assertNote note False val = fromNote note "assertNote False" Nothing+assertNote note False val = withFrozenCallStack $ fromNote note "assertNote False" Nothing -- | Synonym for '!!', but includes more information in the error message.-at :: [a] -> Int -> a+at :: Partial => [a] -> Int -> a at = fromNoteEither "" "at" .^ at_ atMay :: [a] -> Int -> Maybe a@@ -211,29 +269,40 @@ atDef :: a -> [a] -> Int -> a atDef def = fromMaybe def .^ atMay -atNote :: String -> [a] -> Int -> a-atNote note = fromNoteEither note "atNote" .^ at_+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 . read_+readMay = eitherToMaybe . readEitherSafe readDef :: Read a => a -> String -> a readDef def = fromMaybe def . readMay -readNote :: Read a => String -> String -> a-readNote note = fromNoteEither note "readNote" . read_+-- | '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 => a -> [(a,b)] -> b-lookupJust = fromNote "" "lookupJust, no matching value" .^ lookup+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 :: Eq a => String -> a -> [(a,b)] -> b-lookupJustNote note = fromNote note "lookupJustNote, no matching value" .^ 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@@ -243,27 +312,106 @@ 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+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 :: Eq a => a -> [a] -> Int-elemIndexJust = fromNote "" "elemIndexJust, no matching value" .^ elemIndex+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 :: Eq a => String -> a -> [a] -> Int-elemIndexJustNote note = fromNote note "elemIndexJustNote, no matching value" .^ 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 = fromNote "" "findIndexJust, no matching value" .^ findIndex+findIndexJust f x = withFrozenCallStack $ fromNote "" "findIndexJust, no matching value" $ findIndex f x 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+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+++---------------------------------------------------------------------+-- DISCOURAGED++-- | New users are recommended to use 'minimumBound' or 'maximumBound' instead.+minimumDef, maximumDef :: Ord a => a -> [a] -> a+minimumDef def = fromMaybe def . minimumMay+maximumDef def = fromMaybe def . maximumMay++-- | New users are recommended to use 'minimumBoundBy' or 'maximumBoundBy' instead.+minimumByDef, maximumByDef :: a -> (a -> a -> Ordering) -> [a] -> a+minimumByDef def = fromMaybe def .^ minimumByMay+maximumByDef def = fromMaybe def .^ maximumByMay+++---------------------------------------------------------------------+-- DEPRECATED++{-# DEPRECATED foldr1Def "Use @foldr1May@ instead." #-}+{-# DEPRECATED foldl1Def "Use @foldl1May@ instead." #-}+{-# DEPRECATED foldl1Def' "Use @foldl1May'@ instead." #-}+foldr1Def, foldl1Def, foldl1Def' :: a -> (a -> a -> a) -> [a] -> a+foldr1Def def = fromMaybe def .^ foldr1May+foldl1Def def = fromMaybe def .^ foldl1May+foldl1Def' def = fromMaybe def .^ foldl1May'
Safe/Exact.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TupleSections #-} {- | Provides functions that raise errors in corner cases instead of returning \"best effort\" results, then provides wrappers like the "Safe" module. For example:@@ -19,21 +22,26 @@ -- * New functions takeExact, dropExact, splitAtExact, zipExact, zipWithExact,+ zip3Exact, zipWith3Exact, -- * Safe wrappers takeExactMay, takeExactNote, takeExactDef, dropExactMay, dropExactNote, dropExactDef, splitAtExactMay, splitAtExactNote, splitAtExactDef, zipExactMay, zipExactNote, zipExactDef, zipWithExactMay, zipWithExactNote, zipWithExactDef,+ zip3ExactMay, zip3ExactNote, zip3ExactDef,+ zipWith3ExactMay, zipWith3ExactNote, zipWith3ExactDef, ) where import Control.Arrow import Data.Maybe import Safe.Util+import Safe.Partial --------------------------------------------------------------------- -- HELPERS +addNote :: Partial => String -> String -> String -> a addNote note fun msg = error $ "Safe.Exact." ++ fun ++ ", " ++ msg ++ (if null note then "" else ", " ++ note) @@ -42,7 +50,7 @@ -- IMPLEMENTATIONS {-# INLINE splitAtExact_ #-}-splitAtExact_ :: (String -> r) -> ([a] -> r) -> (a -> r -> r) -> Int -> [a] -> r+splitAtExact_ :: Partial => (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@@ -53,7 +61,7 @@ {-# INLINE zipWithExact_ #-}-zipWithExact_ :: (String -> r) -> r -> (a -> b -> r -> r) -> [a] -> [b] -> r+zipWithExact_ :: Partial => (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@@ -62,6 +70,17 @@ f _ [] = err "first list is longer than the second" +{-# INLINE zipWith3Exact_ #-}+zipWith3Exact_ :: Partial => (String -> r) -> r -> (a -> b -> c -> r -> r) -> [a] -> [b] -> [c] -> r+zipWith3Exact_ err nil cons = f+ where+ f (x:xs) (y:ys) (z:zs) = cons x y z $ f xs ys zs+ f [] [] [] = nil+ f [] _ _ = err "first list is shorter than the others"+ f _ [] _ = err "second list is shorter than the others"+ f _ _ [] = err "third list is shorter than the others"++ --------------------------------------------------------------------- -- TAKE/DROP/SPLIT @@ -69,26 +88,26 @@ -- > takeExact n xs = -- > | n >= 0 && n <= length xs = take n xs -- > | otherwise = error "some message"-takeExact :: Int -> [a] -> [a]-takeExact = splitAtExact_ (addNote "" "takeExact") (const []) (:)+takeExact :: Partial => Int -> [a] -> [a]+takeExact i xs = withFrozenCallStack $ splitAtExact_ (addNote "" "takeExact") (const []) (:) i xs -- | -- > 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)+dropExact :: Partial => Int -> [a] -> [a]+dropExact i xs = withFrozenCallStack $ splitAtExact_ (addNote "" "dropExact") id (\_ x -> x) i xs -- | -- > 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)+splitAtExact :: Partial => Int -> [a] -> ([a], [a])+splitAtExact i xs = withFrozenCallStack $ splitAtExact_ (addNote "" "splitAtExact")+ ([],) (\a b -> first (a:) b) i xs -takeExactNote :: String -> Int -> [a] -> [a]-takeExactNote note = splitAtExact_ (addNote note "takeExactNote") (const []) (:)+takeExactNote :: Partial => String -> Int -> [a] -> [a]+takeExactNote note i xs = withFrozenCallStack $ splitAtExact_ (addNote note "takeExactNote") (const []) (:) i xs takeExactMay :: Int -> [a] -> Maybe [a] takeExactMay = splitAtExact_ (const Nothing) (const $ Just []) (\a -> fmap (a:))@@ -96,18 +115,18 @@ takeExactDef :: [a] -> Int -> [a] -> [a] takeExactDef def = fromMaybe def .^ takeExactMay -dropExactNote :: String -> Int -> [a] -> [a]-dropExactNote note = splitAtExact_ (addNote note "dropExactNote") id (flip const)+dropExactNote :: Partial => String -> Int -> [a] -> [a]+dropExactNote note i xs = withFrozenCallStack $ splitAtExact_ (addNote note "dropExactNote") id (\_ x -> x) i xs dropExactMay :: Int -> [a] -> Maybe [a]-dropExactMay = splitAtExact_ (const Nothing) Just (flip const)+dropExactMay = splitAtExact_ (const Nothing) Just (\_ x -> x) dropExactDef :: [a] -> Int -> [a] -> [a] dropExactDef def = fromMaybe def .^ dropExactMay -splitAtExactNote :: String -> Int -> [a] -> ([a], [a])-splitAtExactNote note = splitAtExact_ (addNote note "splitAtExactNote")- (\x -> ([], x)) (\a b -> first (a:) b)+splitAtExactNote :: Partial => String -> Int -> [a] -> ([a], [a])+splitAtExactNote note i xs = withFrozenCallStack $ splitAtExact_ (addNote note "splitAtExactNote")+ ([],) (\a b -> first (a:) b) i xs splitAtExactMay :: Int -> [a] -> Maybe ([a], [a]) splitAtExactMay = splitAtExact_ (const Nothing)@@ -123,19 +142,19 @@ -- > 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)+zipExact :: Partial => [a] -> [b] -> [(a,b)]+zipExact xs ys = withFrozenCallStack $ zipWithExact_ (addNote "" "zipExact") [] (\a b xs -> (a,b) : xs) xs ys -- | -- > 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)+zipWithExact :: Partial => (a -> b -> c) -> [a] -> [b] -> [c]+zipWithExact f xs ys = withFrozenCallStack $ zipWithExact_ (addNote "" "zipWithExact") [] (\a b xs -> f a b : xs) xs ys -zipExactNote :: String -> [a] -> [b] -> [(a,b)]-zipExactNote note = zipWithExact_ (addNote note "zipExactNote") [] (\a b xs -> (a,b) : xs)+zipExactNote :: Partial => String -> [a] -> [b] -> [(a,b)]+zipExactNote note xs ys = withFrozenCallStack $ zipWithExact_ (addNote note "zipExactNote") [] (\a b xs -> (a,b) : xs) xs ys zipExactMay :: [a] -> [b] -> Maybe [(a,b)] zipExactMay = zipWithExact_ (const Nothing) (Just []) (\a b xs -> fmap ((a,b) :) xs)@@ -143,11 +162,45 @@ zipExactDef :: [(a,b)] -> [a] -> [b] -> [(a,b)] zipExactDef def = fromMaybe def .^ zipExactMay -zipWithExactNote :: String -> (a -> b -> c) -> [a] -> [b] -> [c]-zipWithExactNote note f = zipWithExact_ (addNote note "zipWithExactNote") [] (\a b xs -> f a b : xs)+zipWithExactNote :: Partial => String -> (a -> b -> c) -> [a] -> [b] -> [c]+zipWithExactNote note f xs ys = withFrozenCallStack $ zipWithExact_ (addNote note "zipWithExactNote") [] (\a b xs -> f a b : xs) xs ys zipWithExactMay :: (a -> b -> c) -> [a] -> [b] -> Maybe [c] zipWithExactMay f = zipWithExact_ (const Nothing) (Just []) (\a b xs -> fmap (f a b :) xs) zipWithExactDef :: [c] -> (a -> b -> c) -> [a] -> [b] -> [c] zipWithExactDef def = fromMaybe def .^^ zipWithExactMay+++-- |+-- > zip3Exact xs ys zs =+-- > | length xs == length ys && length xs == length zs = zip3 xs ys zs+-- > | otherwise = error "some message"+zip3Exact :: Partial => [a] -> [b] -> [c] -> [(a,b,c)]+zip3Exact xs ys zs = withFrozenCallStack $ zipWith3Exact_ (addNote "" "zip3Exact") [] (\a b c xs -> (a, b, c) : xs) xs ys zs++-- |+-- > zipWith3Exact f xs ys zs =+-- > | length xs == length ys && length xs == length zs = zipWith3 f xs ys zs+-- > | otherwise = error "some message"+zipWith3Exact :: Partial => (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]+zipWith3Exact f xs ys zs = withFrozenCallStack $ zipWith3Exact_ (addNote "" "zipWith3Exact") [] (\a b c xs -> f a b c : xs) xs ys zs+++zip3ExactNote :: Partial => String -> [a] -> [b] -> [c]-> [(a,b,c)]+zip3ExactNote note xs ys zs = withFrozenCallStack $ zipWith3Exact_ (addNote note "zip3ExactNote") [] (\a b c xs -> (a,b,c) : xs) xs ys zs++zip3ExactMay :: [a] -> [b] -> [c] -> Maybe [(a,b,c)]+zip3ExactMay = zipWith3Exact_ (const Nothing) (Just []) (\a b c xs -> fmap ((a,b,c) :) xs)++zip3ExactDef :: [(a,b,c)] -> [a] -> [b] -> [c] -> [(a,b,c)]+zip3ExactDef def = fromMaybe def .^^ zip3ExactMay++zipWith3ExactNote :: Partial => String -> (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]+zipWith3ExactNote note f xs ys zs = withFrozenCallStack $ zipWith3Exact_ (addNote note "zipWith3ExactNote") [] (\a b c xs -> f a b c : xs) xs ys zs++zipWith3ExactMay :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> Maybe [d]+zipWith3ExactMay f = zipWith3Exact_ (const Nothing) (Just []) (\a b c xs -> fmap (f a b c :) xs)++zipWith3ExactDef :: [d] -> (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]+zipWith3ExactDef def = fromMaybe def .^^^ zipWith3ExactMay
Safe/Foldable.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-} {- | 'Foldable' functions, with wrappers like the "Safe" module. -}@@ -8,81 +10,123 @@ foldl1May, foldl1Def, foldl1Note, foldr1May, foldr1Def, foldr1Note, findJustDef, findJustNote,- minimumMay, minimumDef, minimumNote,- maximumMay, maximumDef, maximumNote,- minimumByMay, minimumByDef, minimumByNote,- maximumByMay, maximumByDef, maximumByNote,+ minimumMay, minimumNote,+ maximumMay, maximumNote,+ minimumByMay, minimumByNote,+ maximumByMay, maximumByNote,+ maximumBoundBy, minimumBoundBy,+ maximumBounded, maximumBound,+ minimumBounded, minimumBound,+ -- * Discouraged+ minimumDef, maximumDef, minimumByDef, maximumByDef, -- * Deprecated- foldl1Safe, foldr1Safe, findJustSafe+ foldl1Safe, foldr1Safe, findJustSafe, ) where import Safe.Util import Data.Foldable as F-import Data.Monoid import Data.Maybe+import Data.Monoid+import Prelude+import Safe.Partial --------------------------------------------------------------------- -- UTILITIES +fromNote :: Partial => String -> String -> Maybe a -> a fromNote = fromNoteModule "Safe.Foldable" -isNull :: Foldable t => t a -> Bool-isNull = null . toList - --------------------------------------------------------------------- -- WRAPPERS foldl1May, foldr1May :: Foldable t => (a -> a -> a) -> t a -> Maybe a-foldl1May = liftMay isNull . F.foldl1-foldr1May = liftMay isNull . F.foldr1--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+foldl1May = liftMay F.null . F.foldl1+foldr1May = liftMay F.null . F.foldr1 -foldl1Def, foldr1Def :: Foldable t => a -> (a -> a -> a) -> t a -> a-foldl1Def def = fromMaybe def .^ foldl1May-foldr1Def def = fromMaybe def .^ foldr1May+foldl1Note, foldr1Note :: (Partial, Foldable t) => String -> (a -> a -> a) -> t a -> a+foldl1Note note f x = withFrozenCallStack $ fromNote note "foldl1Note on empty" $ foldl1May f x+foldr1Note note f x = withFrozenCallStack $ fromNote note "foldr1Note on empty" $ foldr1May f x minimumMay, maximumMay :: (Foldable t, Ord a) => t a -> Maybe a-minimumMay = liftMay isNull F.minimum-maximumMay = liftMay isNull F.maximum+minimumMay = liftMay F.null F.minimum+maximumMay = liftMay F.null F.maximum -minimumDef, maximumDef :: (Foldable t, Ord a) => a -> t a -> a-minimumDef def = fromMaybe def . minimumMay-maximumDef def = fromMaybe def . maximumMay+minimumNote, maximumNote :: (Partial, Foldable t, Ord a) => String -> t a -> a+minimumNote note x = withFrozenCallStack $ fromNote note "minimumNote on empty" $ minimumMay x+maximumNote note x = withFrozenCallStack $ fromNote note "maximumNote on empty" $ maximumMay x -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 => (a -> a -> Ordering) -> t a -> Maybe a+minimumByMay = liftMay F.null . F.minimumBy+maximumByMay = liftMay F.null . F.maximumBy -minimumByMay, maximumByMay :: (Foldable t, Ord a) => (a -> a -> Ordering) -> t a -> Maybe a-minimumByMay = liftMay isNull . F.minimumBy-maximumByMay = liftMay isNull . F.maximumBy+minimumByNote, maximumByNote :: (Partial, Foldable t) => String -> (a -> a -> Ordering) -> t a -> a+minimumByNote note f x = withFrozenCallStack $ fromNote note "minimumByNote on empty" $ minimumByMay f x+maximumByNote note f x = withFrozenCallStack $ fromNote note "maximumByNote on empty" $ maximumByMay f x -minimumByDef, maximumByDef :: (Foldable t, Ord a) => a -> (a -> a -> Ordering) -> t a -> a-minimumByDef def = fromMaybe def .^ minimumByMay-maximumByDef def = fromMaybe def .^ maximumByMay+-- | The largest element of a foldable structure with respect to the+-- given comparison function. The result is bounded by the value given as the first argument.+maximumBoundBy :: Foldable f => a -> (a -> a -> Ordering) -> f a -> a+maximumBoundBy x f xs = maximumBy f $ x : toList xs -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+-- | The smallest element of a foldable structure with respect to the+-- given comparison function. The result is bounded by the value given as the first argument.+minimumBoundBy :: Foldable f => a -> (a -> a -> Ordering) -> f a -> a+minimumBoundBy x f xs = minimumBy f $ x : toList xs +-- | The largest element of a foldable structure.+-- The result is bounded by the value given as the first argument.+maximumBound :: (Foldable f, Ord a) => a -> f a -> a+maximumBound x xs = maximum $ x : toList xs++-- | The smallest element of a foldable structure.+-- The result is bounded by the value given as the first argument.+minimumBound :: (Foldable f, Ord a) => a -> f a -> a+minimumBound x xs = minimum $ x : toList xs++-- | The largest element of a foldable structure.+-- The result is bounded by 'minBound'.+maximumBounded :: (Foldable f, Ord a, Bounded a) => f a -> a+maximumBounded = maximumBound minBound++-- | The largest element of a foldable structure.+-- The result is bounded by 'maxBound'.+minimumBounded :: (Foldable f, Ord a, Bounded a) => f a -> a+minimumBounded = minimumBound maxBound+ -- | -- > findJust op = fromJust . find op-findJust :: Foldable t => (a -> Bool) -> t a -> a-findJust = fromNote "" "findJust, no matching value" .^ F.find+findJust :: (Partial, Foldable t) => (a -> Bool) -> t a -> a+findJust f x = withFrozenCallStack $ fromNote "" "findJust, no matching value" $ F.find f x findJustDef :: Foldable t => a -> (a -> Bool) -> t a -> a findJustDef def = fromMaybe def .^ F.find -findJustNote :: Foldable t => String -> (a -> Bool) -> t a -> a-findJustNote note = fromNote note "findJustNote, no matching value" .^ F.find+findJustNote :: (Partial, Foldable t) => String -> (a -> Bool) -> t a -> a+findJustNote note f x = withFrozenCallStack $ fromNote note "findJustNote, no matching value" $ F.find f x ---------------------------------------------------------------------+-- DISCOURAGED++-- | New users are recommended to use 'minimumBound' or 'maximumBound' instead.+minimumDef, maximumDef :: (Foldable t, Ord a) => a -> t a -> a+minimumDef def = fromMaybe def . minimumMay+maximumDef def = fromMaybe def . maximumMay++-- | New users are recommended to use 'minimumBoundBy' or 'maximumBoundBy' instead.+minimumByDef, maximumByDef :: Foldable t => a -> (a -> a -> Ordering) -> t a -> a+minimumByDef def = fromMaybe def .^ minimumByMay+maximumByDef def = fromMaybe def .^ maximumByMay++-- | New users are recommended to use 'foldr1May' or 'foldl1May' instead.+foldl1Def, foldr1Def :: Foldable t => a -> (a -> a -> a) -> t a -> a+foldl1Def def = fromMaybe def .^ foldl1May+foldr1Def def = fromMaybe def .^ foldr1May+++--------------------------------------------------------------------- -- DEPRECATED {-# DEPRECATED foldl1Safe "Use @foldl f mempty@ instead." #-}@@ -92,7 +136,6 @@ {-# 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
+ Safe/Partial.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ImplicitParams #-}++-- | ConstraintKind synonym for marking partial functions+module Safe.Partial(Partial) where++-- Let things work through ghci alone+#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif++-- GHC has changed its opinion on the location a few times+-- v0: GHC 7.4.1, has ConstraintKinds+-- v1: GHC 7.10.2, base 4.8.1.0 = CallStack+-- v2: GHC 8.0.1, base 4.9.0.0 = HasCallStack++#if __GLASGOW_HASKELL__ >= 800+#define OPTION 2+#elif __GLASGOW_HASKELL__ >= 710 && MIN_VERSION_base(4,8,1)+#define OPTION 1+#else+#define OPTION 0+#endif+++#if OPTION == 0+import GHC.Exts+#else+import GHC.Stack+#endif++-- | A constraint synonym which denotes that the function is partial, and will+-- (on GHC 8.* and up) produce a stack trace on failure.+-- You may mark your own non-total functions as Partial, if necessary, and this+-- will ensure that they produce useful stack traces.+#if OPTION == 0+type Partial = (() :: Constraint)+#elif OPTION == 1+type Partial = (?loc :: CallStack)+#else+type Partial = HasCallStack+#endif
Safe/Util.hs view
@@ -1,24 +1,45 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-} -- | Internal utilities.-module Safe.Util where+module Safe.Util(+ fromNoteModule, fromNoteEitherModule,+ liftMay,+ (.^), (.^^), (.^^^),+ eitherToMaybe,+ withFrozenCallStack+ ) where import Data.Maybe+import Safe.Partial +-- Let things work through ghci alone+#if __GLASGOW_HASKELL__ >= 800+import GHC.Stack+#else+withFrozenCallStack :: a -> a+withFrozenCallStack = id+#endif -(.^) :: (b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c++(.^) :: Partial => (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+(.^^) :: Partial => (b -> c) -> (a1 -> a2 -> a3 -> b) -> a1 -> a2 -> a3 -> c (.^^) f g x1 x2 x3 = f (g x1 x2 x3) +(.^^^) :: Partial => (b -> c) -> (a1 -> a2 -> a3 -> a4 -> b) -> a1 -> a2 -> a3 -> a4 -> c+(.^^^) f g x1 x2 x3 x4 = f (g x1 x2 x3 x4)+ 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 :: Partial => 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 :: Partial => 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)
+ Test.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- In the test suite, so OK++module Main(main) where++import Safe+import Safe.Exact+import qualified Safe.Foldable as F++import Control.DeepSeq+import Control.Exception+import Control.Monad+import Data.Char+import Data.List+import Data.Maybe+import System.IO.Unsafe+import Test.QuickCheck.Test+import Test.QuickCheck hiding ((===))+++---------------------------------------------------------------------+-- TESTS++main :: IO ()+main = do+ -- All from the docs, so check they match+ tailMay dNil === Nothing+ tailMay [1,3,4] === Just [3,4]+ tailDef [12] [] === [12]+ tailDef [12] [1,3,4] === [3,4]+ tailNote "help me" dNil `err` "Safe.tailNote [], help me"+ tailNote "help me" [1,3,4] === [3,4]+ tailSafe [] === dNil+ tailSafe [1,3,4] === [3,4]++ findJust (== 2) [d1,2,3] === 2+ findJust (== 4) [d1,2,3] `err` "Safe.findJust"+ F.findJust (== 2) [d1,2,3] === 2+ F.findJust (== 4) [d1,2,3] `err` "Safe.Foldable.findJust"+ F.findJustDef 20 (== 4) [d1,2,3] === 20+ F.findJustNote "my note" (== 4) [d1,2,3] `errs` ["Safe.Foldable.findJustNote","my note"]++ takeExact 3 [d1,2] `errs` ["Safe.Exact.takeExact","index=3","length=2"]+ takeExact (-1) [d1,2] `errs` ["Safe.Exact.takeExact","negative","index=-1"]+ takeExact 1 (takeExact 3 [d1,2]) === [1] -- test is lazy++ quickCheck_ $ \(Int10 i) (List10 (xs :: [Int])) -> do+ let (t,d) = splitAt i xs+ let good = length t == i+ let f name exact may note res =+ if good then do+ exact i xs === res+ note "foo" i xs === res+ may i xs === Just res+ else do+ exact i xs `err` ("Safe.Exact." ++ name ++ "Exact")+ note "foo" i xs `errs` ["Safe.Exact." ++ name ++ "ExactNote","foo"]+ may i xs === Nothing+ f "take" takeExact takeExactMay takeExactNote t+ f "drop" dropExact dropExactMay dropExactNote d+ f "splitAt" splitAtExact splitAtExactMay splitAtExactNote (t, d)+ return True++ take 2 (zipExact [1,2,3] [1,2]) === [(1,1),(2,2)]+ zipExact [d1,2,3] [d1,2] `errs` ["Safe.Exact.zipExact","first list is longer than the second"]+ zipExact [d1,2] [d1,2,3] `errs` ["Safe.Exact.zipExact","second list is longer than the first"]+ zipExact dNil dNil === []++ predMay (minBound :: Int) === Nothing+ succMay (maxBound :: Int) === Nothing+ predMay ((minBound + 1) :: Int) === Just minBound+ succMay ((maxBound - 1) :: Int) === Just maxBound++ quickCheck_ $ \(List10 (xs :: [Int])) x -> do+ let ys = maybeToList x ++ xs+ let res = zip xs ys+ let f name exact may note =+ if isNothing x then do+ exact xs ys === res+ note "foo" xs ys === res+ may xs ys === Just res+ else do+ exact xs ys `err` ("Safe.Exact." ++ name ++ "Exact")+ note "foo" xs ys `errs` ["Safe.Exact." ++ name ++ "ExactNote","foo"]+ may xs ys === Nothing+ f "zip" zipExact zipExactMay zipExactNote+ f "zipWith" (zipWithExact (,)) (zipWithExactMay (,)) (`zipWithExactNote` (,))+ return True++ take 2 (zip3Exact [1,2,3] [1,2,3] [1,2]) === [(1,1,1),(2,2,2)]+ zip3Exact [d1,2] [d1,2,3] [d1,2,3] `errs` ["Safe.Exact.zip3Exact","first list is shorter than the others"]+ zip3Exact [d1,2,3] [d1,2] [d1,2,3] `errs` ["Safe.Exact.zip3Exact","second list is shorter than the others"]+ zip3Exact [d1,2,3] [d1,2,3] [d1,2] `errs` ["Safe.Exact.zip3Exact","third list is shorter than the others"]+ zip3Exact dNil dNil dNil === []++ quickCheck_ $ \(List10 (xs :: [Int])) x1 x2 -> do+ let ys = maybeToList x1 ++ xs+ let zs = maybeToList x2 ++ xs+ let res = zip3 xs ys zs+ let f name exact may note =+ if isNothing x1 && isNothing x2 then do+ exact xs ys zs === res+ note "foo" xs ys zs === res+ may xs ys zs === Just res+ else do+ exact xs ys zs `err` ("Safe.Exact." ++ name ++ "Exact")+ note "foo" xs ys zs `errs` ["Safe.Exact." ++ name ++ "ExactNote","foo"]+ may xs ys zs === Nothing+ f "zip3" zip3Exact zip3ExactMay zip3ExactNote+ f "zipWith3" (zipWith3Exact (,,)) (zipWith3ExactMay (,,)) (flip zipWith3ExactNote (,,))+ return True+++---------------------------------------------------------------------+-- UTILITIES++quickCheck_ prop = do+ r <- quickCheckResult prop+ unless (isSuccess r) $ error "Test failed"+++d1 = 1 :: Double+dNil = [] :: [Double]++(===) :: (Show a, Eq a) => a -> a -> IO ()+(===) a b = when (a /= b) $ error $ "Mismatch: " ++ show a ++ " /= " ++ show b++err :: NFData a => a -> String -> IO ()+err a b = errs a [b]++errs :: NFData a => a -> [String] -> IO ()+errs a bs = do+ res <- try $ evaluate $ rnf a+ case res of+ Right v -> error $ "Expected error, but succeeded: " ++ show bs+ Left (msg :: SomeException) -> forM_ bs $ \b -> do+ let s = show msg+ unless (b `isInfixOf` s) $ error $ "Invalid error string, got " ++ show s ++ ", want " ++ show b+ let f xs = " " ++ map (\x -> if sepChar x then ' ' else x) xs ++ " "+ unless (f b `isInfixOf` f s) $ error $ "Not standalone error string, got " ++ show s ++ ", want " ++ show b++sepChar x = isSpace x || x `elem` ",;."++newtype Int10 = Int10 Int deriving Show++instance Arbitrary Int10 where+ arbitrary = fmap Int10 $ choose (-3, 10)++newtype List10 a = List10 [a] deriving Show++instance Arbitrary a => Arbitrary (List10 a) where+ arbitrary = do i <- choose (0, 10); fmap List10 $ vector i++instance Testable a => Testable (IO a) where+ property = property . unsafePerformIO
safe.cabal view
@@ -1,17 +1,17 @@-cabal-version: >= 1.6+cabal-version: 1.18 build-type: Simple name: safe-version: 0.3.7+version: 0.3.21 license: BSD3 license-file: LICENSE category: Unclassified author: Neil Mitchell <ndmitchell@gmail.com> maintainer: Neil Mitchell <ndmitchell@gmail.com>-copyright: Neil Mitchell 2007-2014-homepage: http://community.haskell.org/~ndm/safe/+copyright: Neil Mitchell 2007-2024+homepage: https://github.com/ndmitchell/safe#readme 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+tested-with: GHC==9.8, GHC==9.6, GHC==9.4, GHC==9.2, GHC==9.0, GHC==8.10, GHC==8.8 description: 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@:@@ -33,21 +33,41 @@ * "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:+extra-doc-files: CHANGES.txt+ README.md source-repository head type: git location: https://github.com/ndmitchell/safe.git library+ default-language: Haskell2010 build-depends:- base < 5+ base >= 4.8 && < 5 exposed-modules: Safe Safe.Exact Safe.Foldable+ Safe.Partial other-modules: Safe.Util++test-suite safe-test+ type: exitcode-stdio-1.0+ main-is: Test.hs+ default-language: Haskell2010++ other-modules:+ Safe+ Safe.Exact+ Safe.Foldable+ Safe.Partial+ Safe.Util+ build-depends:+ base,+ deepseq,+ QuickCheck,+ safe