packages feed

safe 0.2 → 0.3.21

raw patch · 10 files changed

Files

+ CHANGES.txt view
@@ -0,0 +1,58 @@+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
LICENSE view
@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2007-2008.+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 [![Hackage version](https://img.shields.io/hackage/v/safe.svg?label=Hackage)](https://hackage.haskell.org/package/safe) [![Stackage version](https://www.stackage.org/package/safe/badge/nightly?label=Stackage)](https://www.stackage.org/package/safe) [![Build status](https://img.shields.io/github/actions/workflow/status/ndmitchell/safe/ci.yml?branch=master)](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,254 +1,417 @@--{- |-Module      :  Safe-Copyright   :  (c) Neil Mitchell 2007-2008-License     :  BSD3--Maintainer  :  http://www.cs.york.ac.uk/~ndm/-Stability   :  in-progress-Portability :  portable--A library for safe functions, based on standard functions that may crash.-For more details see <http://www-users.cs.york.ac.uk/~ndm/safe/>--In general, each unsafe function has up to 4 forms.-Since 'tail' has all the possible forms, it is fully documented.-The others all follow the same pattern.+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds  #-} +{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-} -* @Note@, takes an extra argument which supplements the error message, 'tailNote'+{- |+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@: -* @Def@, take an extra argument to give when a crash would otherwise happen, 'tailDef'+* @'tail' :: [a] -> [a]@, raises an error on @tail []@, as provided by 'Prelude'. -* @May@, wraps the result in a Maybe, 'tailMay'+* @'tailErr' :: [a] -> [a]@, alias for @tail@ that doesn't trigger an @x-partial@ warning and does raise errors. -* @Safe@, returns a default type if possible, 'tailSafe'+* @'tailMay' :: [a] -> /Maybe/ [a]@, turns errors into @Nothing@. -This library also introduces three brand new functions:+* @'tailDef' :: /[a]/ -> [a] -> [a]@, takes a default to return on errors. -* 'at' - synonym for @(!!)@+* @'tailNote' :: 'Partial' => /String/ -> [a] -> [a]@, takes an extra argument which supplements the error message. -* 'lookupJust' - defined as @lookupJust k = fromJust . lookup k@+* @'tailSafe' :: [a] -> [a]@, returns some sensible default if possible, @[]@ in the case of @tail@. -* 'abort' - same as @error@, but different intended meaning+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(-    tailDef, tailMay, tailNote, tailSafe,-    initDef, initMay, initNote, initSafe,-    headDef, headMay, headNote,-    lastDef, lastMay, lastNote,-    minimumDef, minimumMay, minimumNote,-    maximumDef, maximumMay, maximumNote,-    foldr1Def, foldr1May, foldr1Note,-    foldl1Def, foldl1May, foldl1Note,+    -- * 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,-    at, atDef, atMay, atNote,-    readDef, readMay, readNote,-    lookupJust, lookupJustDef, lookupJustNote,-    abort+    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 -{-# PARTIAL tailNote, initNote, headNote, lastNote, minimumNote, maximumNote #-}-{-# PARTIAL foldr1Note, foldl1Note, fromJustNote, assertNote, at, atNote, readNote #-}-{-# PARTIAL lookupJustNote, lookupJust #-}+---------------------------------------------------------------------+-- UTILITIES +fromNote :: Partial => String -> String -> Maybe a -> a+fromNote = fromNoteModule "Safe" -liftDef :: (a -> b) -> (a -> Bool) -> b -> (a -> b)-liftDef func test def val = if test val then def else func val+fromNoteEither :: Partial => String -> String -> Either String a -> a+fromNoteEither = fromNoteEitherModule "Safe" -liftMay :: (a -> b) -> (a -> Bool) -> (a -> Maybe b)-liftMay func test val = if test val then Nothing else Just $ func val -liftNote :: (a -> b) -> (a -> Bool) -> String -> String -> (a -> b)-liftNote func test caller note val =-    if test val-    then error $ "Pattern match failure, " ++ caller ++ ", " ++ note-    else func val+---------------------------------------------------------------------+-- IMPLEMENTATIONS -liftSafe :: (a -> a) -> (a -> Bool) -> (a -> a)-liftSafe func test val = if test val then val else func val+-- | Synonym for 'error'. Used for instances where the program+--   has decided to exit because of invalid user input, or the user pressed+--   quit etc. This function allows 'error' to be reserved for programmer errors.+abort :: Partial => String -> a+abort x = withFrozenCallStack (error x)  --- |--- > tailDef [12] [] = [12]--- > tailDef [12] [1,3,4] = [3,4]-tailDef  :: [a] -> [a] -> [a]-tailDef  = liftDef  tail null+at_ :: [a] -> Int -> Either String a+at_ xs o | o < 0 = Left $ "index must not be negative, index=" ++ show o+         | otherwise = f o xs+    where f 0 (x:xs) = Right x+          f i (x:xs) = f (i-1) xs+          f i [] = Left $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i) ++---------------------------------------------------------------------+-- 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  tail null+tailMay :: [a] -> Maybe [a]+tailMay [] = Nothing+tailMay (_:xs) = Just xs  -- |--- > tail "help me" [] = error "Pattern match failure, tail [], help me"--- > tail "help me" [1,3,4] = [3,4]-tailNote :: String -> [a] -> [a]-tailNote = liftNote tail null "tail []"+-- > 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 = liftSafe tail null+tailSafe = tailDef []  -initDef  :: [a] -> [a] -> [a]-initDef  = liftDef  init null+initMay :: [a] -> Maybe [a]+initMay = liftMay null init -initMay  :: [a] -> Maybe [a]-initMay  = liftMay  init null+initDef :: [a] -> [a] -> [a]+initDef def = fromMaybe def . initMay -initNote :: String -> [a] -> [a]-initNote = liftNote init null "init []"+initNote :: Partial => String -> [a] -> [a]+initNote note x = withFrozenCallStack $ fromNote note "initNote []" $ initMay x  initSafe :: [a] -> [a]-initSafe = liftSafe init null+initSafe = initDef []   -headDef  :: a -> [a] -> a-headDef  = liftDef  head null--headMay  :: [a] -> Maybe a-headMay  = liftMay  head null+headMay, lastMay :: [a] -> Maybe a+headMay = listToMaybe+lastMay = liftMay null last -headNote :: String -> [a] -> a-headNote = liftNote head null "head []"+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 -lastDef  :: a -> [a] -> a-lastDef  = liftDef  last null+minimumMay, maximumMay :: Ord a => [a] -> Maybe a+minimumMay = liftMay null minimum+maximumMay = liftMay null maximum -lastMay  :: [a] -> Maybe a-lastMay  = liftMay  last null+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 -lastNote :: String -> [a] -> a-lastNote = liftNote last null "last []"+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 -minimumDef  :: Ord a => a -> [a] -> a-minimumDef  = liftDef  minimum null+-- | 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 -minimumMay  :: Ord a => [a] -> Maybe a-minimumMay  = liftMay  minimum null+-- | 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 -minimumNote :: Ord a => String -> [a] -> a-minimumNote = liftNote minimum null "minimum []"+-- | 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 -maximumDef  :: Ord a => a -> [a] -> a-maximumDef  = liftDef  maximum null+-- | The largest element of a list.+-- The result is bounded by 'maxBound'.+minimumBounded :: (Ord a, Bounded a) => [a] -> a+minimumBounded = minimumBound maxBound -maximumMay  :: Ord a => [a] -> Maybe a-maximumMay  = liftMay  maximum null+foldr1May, foldl1May, foldl1May' :: (a -> a -> a) -> [a] -> Maybe a+foldr1May = liftMay null . foldr1+foldl1May = liftMay null . foldl1+foldl1May' = liftMay null . foldl1' -maximumNote :: Ord a => String -> [a] -> a-maximumNote = liftNote maximum null "maximum []"+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 -foldr1Def  :: a -> (a -> a -> a) -> [a] -> a-foldr1Def def f = liftDef (foldr1 f) null def+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 -foldr1May  :: (a -> a -> a) -> [a] -> Maybe a-foldr1May f = liftMay (foldr1 f) null+cycleMay :: [a] -> Maybe [a]+cycleMay = liftMay null cycle -foldr1Note :: String -> (a -> a -> a) -> [a] -> a-foldr1Note note f = liftNote (foldr1 f) null "foldr1 []" note+cycleDef :: [a] -> [a] -> [a]+cycleDef def = fromMaybe def . cycleMay +cycleNote :: Partial => String -> [a] -> [a]+cycleNote note x = withFrozenCallStack $ fromNote note "cycleNote []" $ cycleMay x -foldl1Def  :: a -> (a -> a -> a) -> [a] -> a-foldl1Def def f = liftDef (foldl1 f) null def+-- | 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 -foldl1May  :: (a -> a -> a) -> [a] -> Maybe a-foldl1May f = liftMay (foldl1 f) null+fromJustNote :: Partial => String -> Maybe a -> a+fromJustNote note x = withFrozenCallStack $ fromNote note "fromJustNote Nothing" x -foldl1Note :: String -> (a -> a -> a) -> [a] -> a-foldl1Note note f = liftNote (foldl1 f) null "foldl1 []" note+assertNote :: Partial => String -> Bool -> a -> a+assertNote note True val = val+assertNote note False val = withFrozenCallStack $ fromNote note "assertNote False" Nothing  --- | See fromMaybe-fromJustDef :: a -> Maybe a -> a-fromJustDef  = liftDef fromJust isNothing+-- | Synonym for '!!', but includes more information in the error message.+at :: Partial => [a] -> Int -> a+at = fromNoteEither "" "at" .^ at_ -fromJustNote :: String -> Maybe a -> a-fromJustNote = liftNote fromJust isNothing "fromJust Nothing"+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 -assertNote :: String -> Bool -> a -> a-assertNote msg False val = error $ "assertion failed, " ++ msg-assertNote msg True  val = val+-- | 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 --- | Same as @(!!)@, but better error message-at :: [a] -> Int -> a-at = atNote "called by at"+-- | 'readNote' uses 'readEitherSafe' for the error message.+readNote :: (Partial, Read a) => String -> String -> a+readNote note x = withFrozenCallStack $ fromNoteEither note "readNote" $ readEitherSafe x -atDef :: a -> [a] -> Int -> a-atDef def x n = fromMaybe def (atMay x n)+-- |+-- > 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 -atMay :: [a] -> Int -> Maybe a-atMay xs n | n < 0 = Nothing-atMay [] _ = Nothing-atMay (x:_) 0 = Just x-atMay (_:xs) n = atMay xs (n-1)+lookupJustDef :: Eq a => b -> a -> [(a,b)] -> b+lookupJustDef def = fromMaybe def .^ lookup -atNote :: String -> [a] -> Int -> a-atNote msg _ n | n < 0 = error $ "Safe.at: negative index, " ++ msg-atNote msg xs n = f xs n-    where-        f [] i = error $ "Safe.at: index too large, index=" ++ show n ++ ", length=" ++ show (n-i) ++ ", " ++ msg-        f (x:_) 0 = x-        f (_:xs) i = f xs (i-1)+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 -readDef :: Read a => a -> String -> a-readDef def s = fromMaybe def (readMay s)+findJustNote :: Partial => String -> (a -> Bool) -> [a] -> a+findJustNote note f x = withFrozenCallStack $ fromNote note "findJustNote, no matching value" $ find f x -readMay :: Read a => String -> Maybe a-readMay s = case [x | (x,t) <- reads s, ("","") <- lex t] of-                [x] -> Just x-                _ -> Nothing+-- |+-- > elemIndexJust op = fromJust . elemIndex op+elemIndexJust :: (Partial, Eq a) => a -> [a] -> Int+elemIndexJust x xs = withFrozenCallStack $ fromNote "" "elemIndexJust, no matching value" $ elemIndex x xs -readNote :: Read a => String -> String -> a-readNote msg s = case [x | (x,t) <- reads s, ("","") <- lex t] of-                     [x] -> x-                     []  -> error $ "Prelude.read: no parse, " ++ msg ++ ", on " ++ prefix-                     _   -> error $ "Prelude.read: ambiguous parse, " ++ msg ++ ", on " ++ prefix-    where-        prefix = '\"' : a ++ if null b then "\"" else "..."-            where (a,b) = splitAt 10 s+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  -- |--- > lookupJust key = fromJust . lookup key-lookupJust :: Eq a => a -> [(a,b)] -> b-lookupJust key = fromJustNote "lookupJust, item not found" . lookup key+-- > findIndexJust op = fromJust . findIndex op+findIndexJust :: (a -> Bool) -> [a] -> Int+findIndexJust f x = withFrozenCallStack $ fromNote "" "findIndexJust, no matching value" $ findIndex f x -lookupJustDef :: Eq a => b -> a -> [(a,b)] -> b-lookupJustDef def key lst = fromMaybe def (lookup key lst)+findIndexJustDef :: Int -> (a -> Bool) -> [a] -> Int+findIndexJustDef def = fromMaybe def .^ findIndex -lookupJustNote :: Eq a => String -> a -> [(a,b)] -> b-lookupJustNote msg key lst = case lookup key lst of-                                 Nothing -> error $ "Safe.lookupJust: element not found, " ++ msg-                                 Just x -> x+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 --- | Exactly the same as @error@. Use this for instances where the program---   has decided to exit because of invalid user input, or the user pressed---   quit etc. This allows @error@ to be reserved for genuine coding mistakes.-abort :: String -> a-abort = error+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
@@ -0,0 +1,206 @@+{-# 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/Foldable.hs view
@@ -0,0 +1,142 @@+{-# 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/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
@@ -0,0 +1,47 @@+{-# 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
+ 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,21 +1,73 @@-Name:           safe-Build-Type:     Simple-Version:        0.2-License:        BSD3-License-File:   LICENSE-Copyright:      2007-8, Neil Mitchell-Maintainer:     ndmitchell@gmail.com-Author:         Neil Mitchell-Homepage:       http://www-users.cs.york.ac.uk/~ndm/safe/-Build-Depends:  base-Category:       Unclassified-Synopsis:       Library for safe (pattern match free) functions-Description:-    Partial functions from the base library, such as @head@ and @!!@, modified-    to return more descriptive error messages, programmer defined error messages,-    @Maybe@ wrapped results and default values.-    -    These functions can be used to reduce the number of unsafe pattern matches in-    your code.-Exposed-modules:+cabal-version:  1.18+build-type:     Simple+name:           safe+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-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