safe 0.3.10 → 0.3.11
raw patch · 8 files changed
+279/−24 lines, 8 filesdep +QuickCheckdep +deepseqdep +safedep ~base
Dependencies added: QuickCheck, deepseq, safe
Dependency ranges changed: base
Files
- CHANGES.txt +4/−0
- LICENSE +1/−1
- Safe.hs +44/−15
- Safe/Exact.hs +49/−0
- Safe/Foldable.hs +11/−6
- Safe/Util.hs +3/−0
- Test.hs +154/−0
- safe.cabal +13/−2
CHANGES.txt view
@@ -1,5 +1,9 @@ Changelog for Safe +0.3.11+ #16, add Safe succ and pred+ #16, add readEitherSafe for better errors than readEither+ #14, add Safe zip3Exact 0.3.10 #15, add Safe cycle 0.3.9
LICENSE view
@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2007-2016.+Copyright Neil Mitchell 2007-2017. All rights reserved. Redistribution and use in source and binary forms, with or without
Safe.hs view
@@ -36,12 +36,14 @@ 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+ toEnumMay, toEnumDef, toEnumNote, toEnumSafe,+ succMay, succDef, succNote, succSafe,+ predMay, predDef, predNote, predSafe, ) where import Safe.Util@@ -51,7 +53,10 @@ --------------------------------------------------------------------- -- UTILITIES +fromNote :: String -> String -> Maybe a -> a fromNote = fromNoteModule "Safe"++fromNoteEither :: String -> String -> Either String a -> a fromNoteEither = fromNoteEitherModule "Safe" @@ -73,17 +78,6 @@ 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 @@ -225,15 +219,26 @@ atNote :: String -> [a] -> Int -> a atNote note = fromNoteEither note "atNote" .^ at_ +-- | 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' uses 'readEitherSafe' for the error message. readNote :: Read a => String -> String -> a-readNote note = fromNoteEither note "readNote" . read_+readNote note = fromNoteEither note "readNote" . readEitherSafe -- | -- > lookupJust key = fromJust . lookup key@@ -298,3 +303,27 @@ 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 :: (Enum a, Eq a, Bounded a) => String -> a -> a+succNote note = fromNote note "succNote, out of range" . succMay++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 :: (Enum a, Eq a, Bounded a) => String -> a -> a+predNote note = fromNote note "predNote, out of range" . predMay++predSafe :: (Enum a, Eq a, Bounded a) => a -> a+predSafe = predDef minBound
Safe/Exact.hs view
@@ -19,12 +19,15 @@ -- * 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@@ -34,6 +37,7 @@ --------------------------------------------------------------------- -- HELPERS +addNote :: String -> String -> String -> a addNote note fun msg = error $ "Safe.Exact." ++ fun ++ ", " ++ msg ++ (if null note then "" else ", " ++ note) @@ -62,6 +66,17 @@ f _ [] = err "first list is longer than the second" +{-# INLINE zipWith3Exact_ #-}+zipWith3Exact_ :: (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 @@ -151,3 +166,37 @@ 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 :: [a] -> [b] -> [c] -> [(a,b,c)]+zip3Exact = zipWith3Exact_ (addNote "" "zip3Exact") [] (\a b c xs -> (a, b, c) : xs)++-- |+-- > zipWith3Exact f xs ys zs =+-- > | length xs == length ys && length xs == length zs = zipWith3 f xs ys zs+-- > | otherwise = error "some message"+zipWith3Exact :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]+zipWith3Exact f = zipWith3Exact_ (addNote "" "zipWith3Exact") [] (\a b c xs -> f a b c : xs)+++zip3ExactNote :: String -> [a] -> [b] -> [c]-> [(a,b,c)]+zip3ExactNote note = zipWith3Exact_ (addNote note "zip3ExactNote") [] (\a b c xs -> (a,b,c) : xs)++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 :: String -> (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]+zipWith3ExactNote note f = zipWith3Exact_ (addNote note "zipWith3ExactNote") [] (\a b c xs -> f a b c : xs)++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,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- Monoid required < 7.9+{-# LANGUAGE CPP #-} {- | 'Foldable' functions, with wrappers like the "Safe" module. -}@@ -19,18 +19,23 @@ import Safe.Util import Data.Foldable as F-import Data.Monoid import Data.Maybe+import Data.Monoid+import Prelude --------------------------------------------------------------------- -- UTILITIES +fromNote :: String -> String -> Maybe a -> a fromNote = fromNoteModule "Safe.Foldable" isNull :: Foldable t => t a -> Bool+#if __GLASGOW_HASKELL__ < 710 isNull = null . toList-+#else+isNull = F.null+#endif --------------------------------------------------------------------- -- WRAPPERS@@ -59,15 +64,15 @@ 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, maximumByMay :: Foldable t => (a -> a -> Ordering) -> t a -> Maybe a minimumByMay = liftMay isNull . F.minimumBy maximumByMay = liftMay isNull . F.maximumBy -minimumByDef, maximumByDef :: (Foldable t) => a -> (a -> a -> Ordering) -> t a -> a+minimumByDef, maximumByDef :: Foldable t => a -> (a -> a -> Ordering) -> t a -> a minimumByDef def = fromMaybe def .^ minimumByMay maximumByDef def = fromMaybe def .^ maximumByMay -minimumByNote, maximumByNote :: (Foldable t) => String -> (a -> a -> Ordering) -> t a -> a+minimumByNote, maximumByNote :: Foldable t => String -> (a -> a -> Ordering) -> t a -> a minimumByNote note = fromNote note "minimumByNote on empty" .^ minimumByMay maximumByNote note = fromNote note "maximumByNote on empty" .^ maximumByMay
Safe/Util.hs view
@@ -11,6 +11,9 @@ (.^^) :: (b -> c) -> (a1 -> a2 -> a3 -> b) -> a1 -> a2 -> a3 -> c (.^^) f g x1 x2 x3 = f (g x1 x2 x3) +(.^^^) :: (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
+ Test.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE ScopedTypeVariables #-}++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)++ 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` (,))++ 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 (,,))+++---------------------------------------------------------------------+-- 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 () where+ property () = property True++instance Testable a => Testable (IO a) where+ property = property . unsafePerformIO
safe.cabal view
@@ -1,13 +1,13 @@ cabal-version: >= 1.18 build-type: Simple name: safe-version: 0.3.10+version: 0.3.11 license: BSD3 license-file: LICENSE category: Unclassified author: Neil Mitchell <ndmitchell@gmail.com> maintainer: Neil Mitchell <ndmitchell@gmail.com>-copyright: Neil Mitchell 2007-2016+copyright: Neil Mitchell 2007-2017 homepage: https://github.com/ndmitchell/safe#readme synopsis: Library of safe (exception free) functions bug-reports: https://github.com/ndmitchell/safe/issues@@ -53,3 +53,14 @@ other-modules: Safe.Util++test-suite safe-test+ type: exitcode-stdio-1.0+ main-is: Test.hs+ default-language: Haskell2010++ build-depends:+ base,+ deepseq,+ QuickCheck,+ safe