safe-0.3.21/ 0000755 0000000 0000000 00000000000 07346545000 010704 5 ustar 00 0000000 0000000 safe-0.3.21/CHANGES.txt 0000644 0000000 0000000 00000003752 07346545000 012524 0 ustar 00 0000000 0000000 Changelog for Safe
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, released 2014-07-12
#6, remove unnecessary Ord constraints from maximumBy/minimumBy
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, released 2014-01-30
#1, improve the string clipping in readNote
0.3.3, released 2011-11-15
#494, add foldl1' wrappings
0.3.2, released 2011-11-13
Add a Safe.Foldable module
0.3.1, released 2011-11-09
Add findJust, safe wrapping of fromJust/find
0.3, released 2010-11-10
Start of changelog
safe-0.3.21/LICENSE 0000644 0000000 0000000 00000002764 07346545000 011722 0 ustar 00 0000000 0000000 Copyright Neil Mitchell 2007-2024.
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Neil Mitchell nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
safe-0.3.21/README.md 0000644 0000000 0000000 00000002571 07346545000 012170 0 ustar 00 0000000 0000000 # 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`:
* 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.
safe-0.3.21/Safe.hs 0000644 0000000 0000000 00000035630 07346545000 012125 0 ustar 00 0000000 0000000 {-# 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 five variants, e.g. with @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' :: '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, 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, 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"
---------------------------------------------------------------------
-- IMPLEMENTATIONS
-- | Synonym for 'error'. Used for instances where the program
-- has decided to exit because of invalid user input, or the user pressed
-- quit etc. This function allows 'error' to be reserved for programmer errors.
abort :: Partial => String -> a
abort x = withFrozenCallStack (error x)
at_ :: [a] -> Int -> Either String a
at_ xs o | o < 0 = Left $ "index must not be negative, index=" ++ show o
| otherwise = f o xs
where f 0 (x:xs) = Right x
f i (x:xs) = f (i-1) xs
f i [] = Left $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i)
---------------------------------------------------------------------
-- WRAPPERS
-- | 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 [] = Nothing
tailMay (_:xs) = Just xs
-- |
-- > tailDef [12] [] = [12]
-- > tailDef [12] [1,3,4] = [3,4]
tailDef :: [a] -> [a] -> [a]
tailDef def = fromMaybe def . tailMay
-- |
-- > tailNote "help me" [] = error "Safe.tailNote [], help me"
-- > tailNote "help me" [1,3,4] = [3,4]
tailNote :: Partial => String -> [a] -> [a]
tailNote note x = withFrozenCallStack $ fromNote note "tailNote []" $ tailMay x
-- |
-- > tailSafe [] = []
-- > tailSafe [1,3,4] = [3,4]
tailSafe :: [a] -> [a]
tailSafe = tailDef []
initMay :: [a] -> Maybe [a]
initMay = liftMay null init
initDef :: [a] -> [a] -> [a]
initDef def = fromMaybe def . initMay
initNote :: Partial => String -> [a] -> [a]
initNote note x = withFrozenCallStack $ fromNote note "initNote []" $ initMay x
initSafe :: [a] -> [a]
initSafe = initDef []
headMay, lastMay :: [a] -> Maybe a
headMay = listToMaybe
lastMay = liftMay null last
headDef, lastDef :: a -> [a] -> a
headDef def = fromMaybe def . headMay
lastDef def = fromMaybe def . lastMay
headNote, lastNote :: Partial => String -> [a] -> a
headNote note x = withFrozenCallStack $ fromNote note "headNote []" $ headMay x
lastNote note x = withFrozenCallStack $ fromNote note "lastNote []" $ lastMay x
minimumMay, maximumMay :: Ord a => [a] -> Maybe a
minimumMay = liftMay null minimum
maximumMay = liftMay null maximum
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
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
-- | 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'
foldr1Note, foldl1Note, foldl1Note' :: Partial => String -> (a -> a -> a) -> [a] -> a
foldr1Note note f x = withFrozenCallStack $ fromNote note "foldr1Note []" $ foldr1May f x
foldl1Note note f x = withFrozenCallStack $ fromNote note "foldl1Note []" $ foldl1May f x
foldl1Note' note f x = withFrozenCallStack $ fromNote note "foldl1Note []" $ foldl1May' f x
scanr1May, scanl1May :: (a -> a -> a) -> [a] -> Maybe [a]
scanr1May = liftMay null . scanr1
scanl1May = liftMay null . scanl1
scanr1Def, scanl1Def :: [a] -> (a -> a -> a) -> [a] -> [a]
scanr1Def def = fromMaybe def .^ scanr1May
scanl1Def def = fromMaybe def .^ scanl1May
scanr1Note, scanl1Note :: Partial => String -> (a -> a -> a) -> [a] -> [a]
scanr1Note note f x = withFrozenCallStack $ fromNote note "scanr1Note []" $ scanr1May f x
scanl1Note note f x = withFrozenCallStack $ fromNote note "scanl1Note []" $ scanl1May f x
cycleMay :: [a] -> Maybe [a]
cycleMay = liftMay null cycle
cycleDef :: [a] -> [a] -> [a]
cycleDef def = fromMaybe def . cycleMay
cycleNote :: Partial => String -> [a] -> [a]
cycleNote note x = withFrozenCallStack $ fromNote note "cycleNote []" $ cycleMay x
-- | An alternative name for 'fromMaybe', to fit the naming scheme of this package.
-- Generally using 'fromMaybe' directly would be considered better style.
fromJustDef :: a -> Maybe a -> a
fromJustDef = fromMaybe
fromJustNote :: Partial => String -> Maybe a -> a
fromJustNote note x = withFrozenCallStack $ fromNote note "fromJustNote Nothing" x
assertNote :: Partial => String -> Bool -> a -> a
assertNote note True val = val
assertNote note False val = withFrozenCallStack $ fromNote note "assertNote False" Nothing
-- | Synonym for '!!', but includes more information in the error message.
at :: Partial => [a] -> Int -> a
at = fromNoteEither "" "at" .^ at_
atMay :: [a] -> Int -> Maybe a
atMay = eitherToMaybe .^ at_
atDef :: a -> [a] -> Int -> a
atDef def = fromMaybe def .^ atMay
atNote :: Partial => String -> [a] -> Int -> a
atNote note f x = withFrozenCallStack $ fromNoteEither note "atNote" $ at_ f x
-- | This function provides a more precise error message than 'readEither' from 'base'.
readEitherSafe :: Read a => String -> Either String a
readEitherSafe s = case [x | (x,t) <- reads s, ("","") <- lex t] of
[x] -> Right x
[] -> Left $ "no parse on " ++ prefix
_ -> Left $ "ambiguous parse on " ++ prefix
where
maxLength = 15
prefix = '\"' : a ++ if length s <= maxLength then b ++ "\"" else "...\""
where (a,b) = splitAt (maxLength - 3) s
readMay :: Read a => String -> Maybe a
readMay = eitherToMaybe . readEitherSafe
readDef :: Read a => a -> String -> a
readDef def = fromMaybe def . readMay
-- | 'readNote' uses 'readEitherSafe' for the error message.
readNote :: (Partial, Read a) => String -> String -> a
readNote note x = withFrozenCallStack $ fromNoteEither note "readNote" $ readEitherSafe x
-- |
-- > lookupJust key = fromJust . lookup key
lookupJust :: (Eq a, Partial) => a -> [(a,b)] -> b
lookupJust x xs = withFrozenCallStack $ fromNote "" "lookupJust, no matching value" $ lookup x xs
lookupJustDef :: Eq a => b -> a -> [(a,b)] -> b
lookupJustDef def = fromMaybe def .^ lookup
lookupJustNote :: (Partial, Eq a) => String -> a -> [(a,b)] -> b
lookupJustNote note x xs = withFrozenCallStack $ fromNote note "lookupJustNote, no matching value" $ lookup x xs
-- |
-- > findJust op = fromJust . find op
findJust :: (a -> Bool) -> [a] -> a
findJust = fromNote "" "findJust, no matching value" .^ find
findJustDef :: a -> (a -> Bool) -> [a] -> a
findJustDef def = fromMaybe def .^ find
findJustNote :: Partial => String -> (a -> Bool) -> [a] -> a
findJustNote note f x = withFrozenCallStack $ fromNote note "findJustNote, no matching value" $ find f x
-- |
-- > elemIndexJust op = fromJust . elemIndex op
elemIndexJust :: (Partial, Eq a) => a -> [a] -> Int
elemIndexJust x xs = withFrozenCallStack $ fromNote "" "elemIndexJust, no matching value" $ elemIndex x xs
elemIndexJustDef :: Eq a => Int -> a -> [a] -> Int
elemIndexJustDef def = fromMaybe def .^ elemIndex
elemIndexJustNote :: (Partial, Eq a) => String -> a -> [a] -> Int
elemIndexJustNote note x xs = withFrozenCallStack $ fromNote note "elemIndexJustNote, no matching value" $ elemIndex x xs
-- |
-- > findIndexJust op = fromJust . findIndex op
findIndexJust :: (a -> Bool) -> [a] -> Int
findIndexJust f x = withFrozenCallStack $ fromNote "" "findIndexJust, no matching value" $ findIndex f x
findIndexJustDef :: Int -> (a -> Bool) -> [a] -> Int
findIndexJustDef def = fromMaybe def .^ findIndex
findIndexJustNote :: Partial => String -> (a -> Bool) -> [a] -> Int
findIndexJustNote note f x = withFrozenCallStack $ fromNote note "findIndexJustNote, no matching value" $ findIndex f x
-- From http://stackoverflow.com/questions/2743858/safe-and-polymorphic-toenum
-- answer by C. A. McCann
toEnumMay :: (Enum a, Bounded a) => Int -> Maybe a
toEnumMay i =
let r = toEnum i
max = maxBound `asTypeOf` r
min = minBound `asTypeOf` r
in if i >= fromEnum min && i <= fromEnum max
then Just r
else Nothing
toEnumDef :: (Enum a, Bounded a) => a -> Int -> a
toEnumDef def = fromMaybe def . toEnumMay
toEnumNote :: (Partial, Enum a, Bounded a) => String -> Int -> a
toEnumNote note x = withFrozenCallStack $ fromNote note "toEnumNote, out of range" $ toEnumMay x
toEnumSafe :: (Enum a, Bounded a) => Int -> a
toEnumSafe = toEnumDef minBound
succMay :: (Enum a, Eq a, Bounded a) => a -> Maybe a
succMay = liftMay (== maxBound) succ
succDef :: (Enum a, Eq a, Bounded a) => a -> a -> a
succDef def = fromMaybe def . succMay
succNote :: (Partial, Enum a, Eq a, Bounded a) => String -> a -> a
succNote note x = withFrozenCallStack $ fromNote note "succNote, out of range" $ succMay x
succSafe :: (Enum a, Eq a, Bounded a) => a -> a
succSafe = succDef maxBound
predMay :: (Enum a, Eq a, Bounded a) => a -> Maybe a
predMay = liftMay (== minBound) pred
predDef :: (Enum a, Eq a, Bounded a) => a -> a -> a
predDef def = fromMaybe def . predMay
predNote :: (Partial, Enum a, Eq a, Bounded a) => String -> a -> a
predNote note x = withFrozenCallStack $ fromNote note "predNote, out of range" $ predMay x
predSafe :: (Enum a, Eq a, Bounded a) => a -> a
predSafe = predDef minBound
indexMay :: Ix a => (a, a) -> a -> Maybe Int
indexMay b i = if inRange b i then Just (index b i) else Nothing
indexDef :: Ix a => Int -> (a, a) -> a -> Int
indexDef def b = fromMaybe def . indexMay b
indexNote :: (Partial, Ix a) => String -> (a, a) -> a -> Int
indexNote note x y = withFrozenCallStack $ fromNote note "indexNote, out of range" $ indexMay x y
---------------------------------------------------------------------
-- 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-0.3.21/Safe/ 0000755 0000000 0000000 00000000000 07346545000 011562 5 ustar 00 0000000 0000000 safe-0.3.21/Safe/Exact.hs 0000644 0000000 0000000 00000020467 07346545000 013173 0 ustar 00 0000000 0000000 {-# 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:
* @'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,
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)
---------------------------------------------------------------------
-- IMPLEMENTATIONS
{-# INLINE splitAtExact_ #-}
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
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_ :: 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
f [] [] = nil
f [] _ = err "second list is longer than the first"
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
-- |
-- > takeExact n xs =
-- > | n >= 0 && n <= length xs = take n xs
-- > | otherwise = error "some message"
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 :: 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 :: Partial => Int -> [a] -> ([a], [a])
splitAtExact i xs = withFrozenCallStack $ splitAtExact_ (addNote "" "splitAtExact")
([],) (\a b -> first (a:) b) i xs
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:))
takeExactDef :: [a] -> Int -> [a] -> [a]
takeExactDef def = fromMaybe def .^ takeExactMay
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 (\_ x -> x)
dropExactDef :: [a] -> Int -> [a] -> [a]
dropExactDef def = fromMaybe def .^ dropExactMay
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)
(\x -> Just ([], x)) (\a b -> fmap (first (a:)) b)
splitAtExactDef :: ([a], [a]) -> Int -> [a] -> ([a], [a])
splitAtExactDef def = fromMaybe def .^ splitAtExactMay
---------------------------------------------------------------------
-- ZIP
-- |
-- > zipExact xs ys =
-- > | length xs == length ys = zip xs ys
-- > | otherwise = error "some message"
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 :: 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 :: 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)
zipExactDef :: [(a,b)] -> [a] -> [b] -> [(a,b)]
zipExactDef def = fromMaybe def .^ zipExactMay
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-0.3.21/Safe/Foldable.hs 0000644 0000000 0000000 00000013053 07346545000 013630 0 ustar 00 0000000 0000000 {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
{- |
'Foldable' functions, with wrappers like the "Safe" module.
-}
module Safe.Foldable(
-- * New functions
findJust,
-- * Safe wrappers
foldl1May, foldl1Def, foldl1Note,
foldr1May, foldr1Def, foldr1Note,
findJustDef, findJustNote,
minimumMay, minimumNote,
maximumMay, maximumNote,
minimumByMay, minimumByNote,
maximumByMay, maximumByNote,
maximumBoundBy, minimumBoundBy,
maximumBounded, maximumBound,
minimumBounded, minimumBound,
-- * Discouraged
minimumDef, maximumDef, minimumByDef, maximumByDef,
-- * Deprecated
foldl1Safe, foldr1Safe, findJustSafe,
) where
import Safe.Util
import Data.Foldable as F
import Data.Maybe
import Data.Monoid
import Prelude
import Safe.Partial
---------------------------------------------------------------------
-- UTILITIES
fromNote :: Partial => String -> String -> Maybe a -> a
fromNote = fromNoteModule "Safe.Foldable"
---------------------------------------------------------------------
-- WRAPPERS
foldl1May, foldr1May :: Foldable t => (a -> a -> a) -> t a -> Maybe a
foldl1May = liftMay F.null . F.foldl1
foldr1May = liftMay F.null . F.foldr1
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 F.null F.minimum
maximumMay = liftMay F.null F.maximum
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
minimumByMay, maximumByMay :: Foldable t => (a -> a -> Ordering) -> t a -> Maybe a
minimumByMay = liftMay F.null . F.minimumBy
maximumByMay = liftMay F.null . 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
-- | 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
-- | 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 :: (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 :: (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." #-}
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-0.3.21/Safe/Partial.hs 0000644 0000000 0000000 00000002210 07346545000 013505 0 ustar 00 0000000 0000000 {-# 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-0.3.21/Safe/Util.hs 0000644 0000000 0000000 00000002706 07346545000 013040 0 ustar 00 0000000 0000000 {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
-- | Internal utilities.
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
(.^) :: Partial => (b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
(.^) f g x1 x2 = f (g x1 x2)
(.^^) :: 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 :: 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 :: 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)
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe = either (const Nothing) Just
safe-0.3.21/Setup.hs 0000644 0000000 0000000 00000000055 07346545000 012340 0 ustar 00 0000000 0000000 import Distribution.Simple
main = defaultMain safe-0.3.21/Test.hs 0000644 0000000 0000000 00000013501 07346545000 012157 0 ustar 00 0000000 0000000 {-# 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-0.3.21/safe.cabal 0000644 0000000 0000000 00000004410 07346545000 012605 0 ustar 00 0000000 0000000 cabal-version: 1.18
build-type: Simple
name: safe
version: 0.3.21
license: BSD3
license-file: LICENSE
category: Unclassified
author: Neil Mitchell
maintainer: Neil Mitchell
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==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@:
.
* @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-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 >= 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