├── .ghci ├── .github └── workflows │ └── ci.yml ├── .gitignore ├── .hlint.yaml ├── CHANGES.txt ├── LICENSE ├── PULL_REQUEST_TEMPLATE.md ├── README.md ├── Safe.hs ├── Safe ├── Exact.hs ├── Foldable.hs ├── Partial.hs └── Util.hs ├── Setup.hs ├── Test.hs └── safe.cabal /.ghci: -------------------------------------------------------------------------------- 1 | :set -Wno-overlapping-patterns 2 | :set -Wunused-binds -Wunused-imports -Worphans 3 | :load Test 4 | 5 | :def docs_ const $ return $ unlines [":!cabal haddock"] 6 | :def docs const $ return $ unlines [":docs_",":!start dist\\doc\\html\\safe\\Safe.html"] 7 | 8 | :def test const $ return $ unlines [":main"] 9 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: ci 2 | on: 3 | push: 4 | pull_request: 5 | schedule: 6 | - cron: '0 3 * * 6' # 3am Saturday 7 | jobs: 8 | test: 9 | runs-on: ${{ matrix.os }} 10 | 11 | strategy: 12 | fail-fast: false 13 | matrix: 14 | os: [ubuntu-latest] 15 | ghc: ['9.8', '9.6', '9.4', '9.2', '9.0', '8.10', '8.8'] 16 | include: 17 | - os: windows-latest 18 | - os: macOS-latest 19 | 20 | steps: 21 | - run: git config --global core.autocrlf false 22 | - uses: actions/checkout@v2 23 | - uses: haskell/actions/setup@v2 24 | id: setup-haskell 25 | with: 26 | ghc-version: ${{ matrix.ghc }} 27 | - run: cabal v2-freeze --enable-tests 28 | - uses: actions/cache@v2 29 | with: 30 | path: ${{ steps.setup-haskell.outputs.cabal-store }} 31 | key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }} 32 | restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- 33 | - uses: ndmitchell/neil@master 34 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /dist/ 2 | /dist-newstyle/ 3 | /issues/ 4 | /.stack-work/ 5 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- 1 | # HLint configuration file 2 | # https://github.com/ndmitchell/hlint 3 | ########################## 4 | 5 | # This file contains a template configuration file, which is typically 6 | # placed as .hlint.yaml in the root of your project 7 | 8 | 9 | # Warnings currently triggered by your code 10 | - ignore: {name: "Use section"} 11 | - ignore: {name: "Use <$>"} 12 | - ignore: {name: "Unused LANGUAGE pragma"} 13 | - ignore: {name: "Use module export list"} 14 | - ignore: {name: "Use pure"} 15 | 16 | 17 | # Specify additional command line arguments 18 | # 19 | # - arguments: [--color, --cpp-simple, -XQuasiQuotes] 20 | 21 | 22 | # Control which extensions/flags/modules/functions can be used 23 | # 24 | # - extensions: 25 | # - default: false # all extension are banned by default 26 | # - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used 27 | # - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module 28 | # 29 | # - flags: 30 | # - {name: -w, within: []} # -w is allowed nowhere 31 | # 32 | # - modules: 33 | # - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set' 34 | # - {name: Control.Arrow, within: []} # Certain modules are banned entirely 35 | # 36 | # - functions: 37 | # - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules 38 | 39 | 40 | # Add custom hints for this project 41 | # 42 | # Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar" 43 | # - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x} 44 | 45 | 46 | # Turn on hints that are off by default 47 | # 48 | # Ban "module X(module X) where", to require a real export list 49 | # - warn: {name: Use explicit module export list} 50 | # 51 | # Replace a $ b $ c with a . b $ c 52 | # - group: {name: dollar, enabled: true} 53 | # 54 | # Generalise map to fmap, ++ to <> 55 | # - group: {name: generalise, enabled: true} 56 | 57 | 58 | # Ignore some builtin hints 59 | # - ignore: {name: Use let} 60 | # - ignore: {name: Use const, within: SpecialModule} # Only within certain modules 61 | 62 | 63 | # Define some custom infix operators 64 | # - fixity: infixr 3 ~^#^~ 65 | 66 | 67 | # To generate a suitable file for HLint do: 68 | # $ hlint --default > .hlint.yaml 69 | -------------------------------------------------------------------------------- /CHANGES.txt: -------------------------------------------------------------------------------- 1 | Changelog for Safe 2 | 3 | #35, exclude GHC 7.10 as it doesn't support new-style warnings 4 | 0.3.21, released 2024-01-18 5 | #34, mark headErr/tailErr as Partial 6 | 0.3.20, released 2024-01-14 7 | #34, add headErr, tailErr 8 | #33, avoid using head/tail to avoid x-partial 9 | 0.3.19, released 2020-05-24 10 | #30, undeprecate maximumDef and friends, fold*1Def 11 | 0.3.18, released 2019-12-04 12 | #27, deprecate maximumDef and friends, fold*1Def 13 | #27, add maximumBounded and friends 14 | Stop supporting GHC 7.4 to 7.8 15 | 0.3.17, released 2018-03-09 16 | Improve the display of errors, less internal callstack 17 | Add a few missing Partial constraints 18 | 0.3.16, released 2018-01-06 19 | #22, add Safe index 20 | 0.3.15, released 2017-06-18 21 | Support QuickCheck 2.10 22 | 0.3.14, released 2017-02-15 23 | #20, fix for GHC 7.10.1 24 | 0.3.13, released 2017-02-09 25 | #20, require GHC 7.4 or above 26 | 0.3.12, released 2017-02-05 27 | #19, add Safe.Partial exposing a Partial typeclass 28 | #19, add support for GHC call stacks 29 | 0.3.11, released 2017-01-22 30 | #16, add Safe succ and pred 31 | #16, add readEitherSafe for better errors than readEither 32 | #14, add Safe zip3Exact 33 | 0.3.10, released 2016-11-08 34 | #15, add Safe cycle 35 | 0.3.9, released 2015-05-09 36 | #9, add Safe toEnum 37 | 0.3.8, released 2014-08-10 38 | #8, remove unnecessary Ord constraints from Foldable functions 39 | 0.3.7, released 2014-07-16 40 | Add Def variants of the Exact functions 41 | 0.3.6, released 2014-07-12 42 | #6, remove unnecessary Ord constraints from maximumBy/minimumBy 43 | 0.3.5, released 2014-06-28 44 | Add Safe elemIndexJust/findIndexJust functions 45 | Add Safe scan functions 46 | Add Safe minimumBy/maximumBy functions 47 | Add a module of Exact functions 48 | Add Foldable minimum functions 49 | Clean up the Foldable module, deprecate the Safe variants 50 | 0.3.4, released 2014-01-30 51 | #1, improve the string clipping in readNote 52 | 0.3.3, released 2011-11-15 53 | #494, add foldl1' wrappings 54 | 0.3.2, released 2011-11-13 55 | Add a Safe.Foldable module 56 | 0.3.1, released 2011-11-09 57 | Add findJust, safe wrapping of fromJust/find 58 | 0.3, released 2010-11-10 59 | Start of changelog 60 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Neil Mitchell 2007-2024. 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Neil Mitchell nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | Thanks for the pull request! 2 | 3 | By raising this pull request you confirm you are licensing your contribution under all licenses that apply to this project (see LICENSE) and that you have no patents covering your contribution. 4 | 5 | If you care, my PR preferences are at https://github.com/ndmitchell/neil#contributions, but they're all guidelines, and I'm not too fussy - you don't have to read them. 6 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # 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) 2 | 3 | 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`: 4 | 5 | * tail :: [a] -> [a], raises an error on `tail []`. 6 | * tailMay :: [a] -> Maybe [a], turns errors into `Nothing`. 7 | * tailDef :: [a] -> [a] -> [a], takes a default to return on errors. 8 | * tailNote :: String -> [a] -> [a], takes an extra argument which supplements the error message. 9 | * tailSafe :: [a] -> [a], returns some sensible default if possible, `[]` in the case of `tail`. 10 | 11 | This package is divided into three modules: 12 | 13 | * `Safe` contains safe variants of `Prelude` and `Data.List` functions. 14 | * `Safe.Foldable` contains safe variants of `Foldable` functions. 15 | * `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. 16 | -------------------------------------------------------------------------------- /Safe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE ConstraintKinds #-} 3 | 4 | {-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-} 5 | 6 | {- | 7 | A module wrapping @Prelude@/@Data.List@ functions that can throw exceptions, such as @head@ and @!!@. 8 | Each unsafe function has up to five variants, e.g. with @tail@: 9 | 10 | * @'tail' :: [a] -> [a]@, raises an error on @tail []@, as provided by 'Prelude'. 11 | 12 | * @'tailErr' :: [a] -> [a]@, alias for @tail@ that doesn't trigger an @x-partial@ warning and does raise errors. 13 | 14 | * @'tailMay' :: [a] -> /Maybe/ [a]@, turns errors into @Nothing@. 15 | 16 | * @'tailDef' :: /[a]/ -> [a] -> [a]@, takes a default to return on errors. 17 | 18 | * @'tailNote' :: 'Partial' => /String/ -> [a] -> [a]@, takes an extra argument which supplements the error message. 19 | 20 | * @'tailSafe' :: [a] -> [a]@, returns some sensible default if possible, @[]@ in the case of @tail@. 21 | 22 | All functions marked with the @'Partial'@ constraint are not total, and will produce stack traces on error, on GHC 23 | versions which support them (see "GHC.Stack"). 24 | 25 | This module also introduces some new functions, documented at the top of the module. 26 | -} 27 | 28 | module Safe( 29 | -- * New functions 30 | abort, at, lookupJust, findJust, elemIndexJust, findIndexJust, 31 | -- * Partial functions 32 | tailErr, headErr, 33 | -- * Safe wrappers 34 | tailMay, tailDef, tailNote, tailSafe, 35 | initMay, initDef, initNote, initSafe, 36 | headMay, headDef, headNote, 37 | lastMay, lastDef, lastNote, 38 | minimumMay, minimumNote, 39 | maximumMay, maximumNote, 40 | minimumByMay, minimumByNote, 41 | maximumByMay, maximumByNote, 42 | minimumBoundBy, maximumBoundBy, 43 | maximumBounded, maximumBound, 44 | minimumBounded, minimumBound, 45 | foldr1May, foldr1Def, foldr1Note, 46 | foldl1May, foldl1Def, foldl1Note, 47 | foldl1May', foldl1Def', foldl1Note', 48 | scanl1May, scanl1Def, scanl1Note, 49 | scanr1May, scanr1Def, scanr1Note, 50 | cycleMay, cycleDef, cycleNote, 51 | fromJustDef, fromJustNote, 52 | assertNote, 53 | atMay, atDef, atNote, 54 | readMay, readDef, readNote, readEitherSafe, 55 | lookupJustDef, lookupJustNote, 56 | findJustDef, findJustNote, 57 | elemIndexJustDef, elemIndexJustNote, 58 | findIndexJustDef, findIndexJustNote, 59 | toEnumMay, toEnumDef, toEnumNote, toEnumSafe, 60 | succMay, succDef, succNote, succSafe, 61 | predMay, predDef, predNote, predSafe, 62 | indexMay, indexDef, indexNote, 63 | -- * Discouraged 64 | minimumDef, maximumDef, minimumByDef, maximumByDef 65 | ) where 66 | 67 | import Safe.Util 68 | import Data.Ix 69 | import Data.List 70 | import Data.Maybe 71 | import Safe.Partial 72 | 73 | --------------------------------------------------------------------- 74 | -- UTILITIES 75 | 76 | fromNote :: Partial => String -> String -> Maybe a -> a 77 | fromNote = fromNoteModule "Safe" 78 | 79 | fromNoteEither :: Partial => String -> String -> Either String a -> a 80 | fromNoteEither = fromNoteEitherModule "Safe" 81 | 82 | 83 | --------------------------------------------------------------------- 84 | -- IMPLEMENTATIONS 85 | 86 | -- | Synonym for 'error'. Used for instances where the program 87 | -- has decided to exit because of invalid user input, or the user pressed 88 | -- quit etc. This function allows 'error' to be reserved for programmer errors. 89 | abort :: Partial => String -> a 90 | abort x = withFrozenCallStack (error x) 91 | 92 | 93 | at_ :: [a] -> Int -> Either String a 94 | at_ xs o | o < 0 = Left $ "index must not be negative, index=" ++ show o 95 | | otherwise = f o xs 96 | where f 0 (x:xs) = Right x 97 | f i (x:xs) = f (i-1) xs 98 | f i [] = Left $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i) 99 | 100 | 101 | --------------------------------------------------------------------- 102 | -- WRAPPERS 103 | 104 | -- | Identical to 'tail', namely that fails on an empty list. 105 | -- Useful to avoid the @x-partial@ warning introduced in GHC 9.8. 106 | -- 107 | -- > tailErr [] = error "Prelude.tail: empty list" 108 | -- > tailErr [1,2,3] = [2,3] 109 | tailErr :: Partial => [a] -> [a] 110 | tailErr = tail 111 | 112 | -- | Identical to 'head', namely that fails on an empty list. 113 | -- Useful to avoid the @x-partial@ warning introduced in GHC 9.8. 114 | -- 115 | -- > headErr [] = error "Prelude.head: empty list" 116 | -- > headErr [1,2,3] = 1 117 | headErr :: Partial => [a] -> a 118 | headErr = head 119 | 120 | -- | 121 | -- > tailMay [] = Nothing 122 | -- > tailMay [1,3,4] = Just [3,4] 123 | tailMay :: [a] -> Maybe [a] 124 | tailMay [] = Nothing 125 | tailMay (_:xs) = Just xs 126 | 127 | -- | 128 | -- > tailDef [12] [] = [12] 129 | -- > tailDef [12] [1,3,4] = [3,4] 130 | tailDef :: [a] -> [a] -> [a] 131 | tailDef def = fromMaybe def . tailMay 132 | 133 | -- | 134 | -- > tailNote "help me" [] = error "Safe.tailNote [], help me" 135 | -- > tailNote "help me" [1,3,4] = [3,4] 136 | tailNote :: Partial => String -> [a] -> [a] 137 | tailNote note x = withFrozenCallStack $ fromNote note "tailNote []" $ tailMay x 138 | 139 | -- | 140 | -- > tailSafe [] = [] 141 | -- > tailSafe [1,3,4] = [3,4] 142 | tailSafe :: [a] -> [a] 143 | tailSafe = tailDef [] 144 | 145 | 146 | initMay :: [a] -> Maybe [a] 147 | initMay = liftMay null init 148 | 149 | initDef :: [a] -> [a] -> [a] 150 | initDef def = fromMaybe def . initMay 151 | 152 | initNote :: Partial => String -> [a] -> [a] 153 | initNote note x = withFrozenCallStack $ fromNote note "initNote []" $ initMay x 154 | 155 | initSafe :: [a] -> [a] 156 | initSafe = initDef [] 157 | 158 | 159 | 160 | headMay, lastMay :: [a] -> Maybe a 161 | headMay = listToMaybe 162 | lastMay = liftMay null last 163 | 164 | headDef, lastDef :: a -> [a] -> a 165 | headDef def = fromMaybe def . headMay 166 | lastDef def = fromMaybe def . lastMay 167 | 168 | headNote, lastNote :: Partial => String -> [a] -> a 169 | headNote note x = withFrozenCallStack $ fromNote note "headNote []" $ headMay x 170 | lastNote note x = withFrozenCallStack $ fromNote note "lastNote []" $ lastMay x 171 | 172 | minimumMay, maximumMay :: Ord a => [a] -> Maybe a 173 | minimumMay = liftMay null minimum 174 | maximumMay = liftMay null maximum 175 | 176 | minimumNote, maximumNote :: (Partial, Ord a) => String -> [a] -> a 177 | minimumNote note x = withFrozenCallStack $ fromNote note "minumumNote []" $ minimumMay x 178 | maximumNote note x = withFrozenCallStack $ fromNote note "maximumNote []" $ maximumMay x 179 | 180 | minimumByMay, maximumByMay :: (a -> a -> Ordering) -> [a] -> Maybe a 181 | minimumByMay = liftMay null . minimumBy 182 | maximumByMay = liftMay null . maximumBy 183 | 184 | minimumByNote, maximumByNote :: Partial => String -> (a -> a -> Ordering) -> [a] -> a 185 | minimumByNote note f x = withFrozenCallStack $ fromNote note "minumumByNote []" $ minimumByMay f x 186 | maximumByNote note f x = withFrozenCallStack $ fromNote note "maximumByNote []" $ maximumByMay f x 187 | 188 | -- | The largest element of a list with respect to the 189 | -- given comparison function. The result is bounded by the value given as the first argument. 190 | maximumBoundBy :: a -> (a -> a -> Ordering) -> [a] -> a 191 | maximumBoundBy x f xs = maximumBy f $ x : xs 192 | 193 | -- | The smallest element of a list with respect to the 194 | -- given comparison function. The result is bounded by the value given as the first argument. 195 | minimumBoundBy :: a -> (a -> a -> Ordering) -> [a] -> a 196 | minimumBoundBy x f xs = minimumBy f $ x : xs 197 | 198 | -- | The largest element of a list. 199 | -- The result is bounded by the value given as the first argument. 200 | maximumBound :: Ord a => a -> [a] -> a 201 | maximumBound x xs = maximum $ x : xs 202 | 203 | -- | The smallest element of a list. 204 | -- The result is bounded by the value given as the first argument. 205 | minimumBound :: Ord a => a -> [a] -> a 206 | minimumBound x xs = minimum $ x : xs 207 | 208 | -- | The largest element of a list. 209 | -- The result is bounded by 'minBound'. 210 | maximumBounded :: (Ord a, Bounded a) => [a] -> a 211 | maximumBounded = maximumBound minBound 212 | 213 | -- | The largest element of a list. 214 | -- The result is bounded by 'maxBound'. 215 | minimumBounded :: (Ord a, Bounded a) => [a] -> a 216 | minimumBounded = minimumBound maxBound 217 | 218 | foldr1May, foldl1May, foldl1May' :: (a -> a -> a) -> [a] -> Maybe a 219 | foldr1May = liftMay null . foldr1 220 | foldl1May = liftMay null . foldl1 221 | foldl1May' = liftMay null . foldl1' 222 | 223 | foldr1Note, foldl1Note, foldl1Note' :: Partial => String -> (a -> a -> a) -> [a] -> a 224 | foldr1Note note f x = withFrozenCallStack $ fromNote note "foldr1Note []" $ foldr1May f x 225 | foldl1Note note f x = withFrozenCallStack $ fromNote note "foldl1Note []" $ foldl1May f x 226 | foldl1Note' note f x = withFrozenCallStack $ fromNote note "foldl1Note []" $ foldl1May' f x 227 | 228 | scanr1May, scanl1May :: (a -> a -> a) -> [a] -> Maybe [a] 229 | scanr1May = liftMay null . scanr1 230 | scanl1May = liftMay null . scanl1 231 | 232 | scanr1Def, scanl1Def :: [a] -> (a -> a -> a) -> [a] -> [a] 233 | scanr1Def def = fromMaybe def .^ scanr1May 234 | scanl1Def def = fromMaybe def .^ scanl1May 235 | 236 | scanr1Note, scanl1Note :: Partial => String -> (a -> a -> a) -> [a] -> [a] 237 | scanr1Note note f x = withFrozenCallStack $ fromNote note "scanr1Note []" $ scanr1May f x 238 | scanl1Note note f x = withFrozenCallStack $ fromNote note "scanl1Note []" $ scanl1May f x 239 | 240 | cycleMay :: [a] -> Maybe [a] 241 | cycleMay = liftMay null cycle 242 | 243 | cycleDef :: [a] -> [a] -> [a] 244 | cycleDef def = fromMaybe def . cycleMay 245 | 246 | cycleNote :: Partial => String -> [a] -> [a] 247 | cycleNote note x = withFrozenCallStack $ fromNote note "cycleNote []" $ cycleMay x 248 | 249 | -- | An alternative name for 'fromMaybe', to fit the naming scheme of this package. 250 | -- Generally using 'fromMaybe' directly would be considered better style. 251 | fromJustDef :: a -> Maybe a -> a 252 | fromJustDef = fromMaybe 253 | 254 | fromJustNote :: Partial => String -> Maybe a -> a 255 | fromJustNote note x = withFrozenCallStack $ fromNote note "fromJustNote Nothing" x 256 | 257 | assertNote :: Partial => String -> Bool -> a -> a 258 | assertNote note True val = val 259 | assertNote note False val = withFrozenCallStack $ fromNote note "assertNote False" Nothing 260 | 261 | 262 | -- | Synonym for '!!', but includes more information in the error message. 263 | at :: Partial => [a] -> Int -> a 264 | at = fromNoteEither "" "at" .^ at_ 265 | 266 | atMay :: [a] -> Int -> Maybe a 267 | atMay = eitherToMaybe .^ at_ 268 | 269 | atDef :: a -> [a] -> Int -> a 270 | atDef def = fromMaybe def .^ atMay 271 | 272 | atNote :: Partial => String -> [a] -> Int -> a 273 | atNote note f x = withFrozenCallStack $ fromNoteEither note "atNote" $ at_ f x 274 | 275 | -- | This function provides a more precise error message than 'readEither' from 'base'. 276 | readEitherSafe :: Read a => String -> Either String a 277 | readEitherSafe s = case [x | (x,t) <- reads s, ("","") <- lex t] of 278 | [x] -> Right x 279 | [] -> Left $ "no parse on " ++ prefix 280 | _ -> Left $ "ambiguous parse on " ++ prefix 281 | where 282 | maxLength = 15 283 | prefix = '\"' : a ++ if length s <= maxLength then b ++ "\"" else "...\"" 284 | where (a,b) = splitAt (maxLength - 3) s 285 | 286 | readMay :: Read a => String -> Maybe a 287 | readMay = eitherToMaybe . readEitherSafe 288 | 289 | readDef :: Read a => a -> String -> a 290 | readDef def = fromMaybe def . readMay 291 | 292 | -- | 'readNote' uses 'readEitherSafe' for the error message. 293 | readNote :: (Partial, Read a) => String -> String -> a 294 | readNote note x = withFrozenCallStack $ fromNoteEither note "readNote" $ readEitherSafe x 295 | 296 | -- | 297 | -- > lookupJust key = fromJust . lookup key 298 | lookupJust :: (Eq a, Partial) => a -> [(a,b)] -> b 299 | lookupJust x xs = withFrozenCallStack $ fromNote "" "lookupJust, no matching value" $ lookup x xs 300 | 301 | lookupJustDef :: Eq a => b -> a -> [(a,b)] -> b 302 | lookupJustDef def = fromMaybe def .^ lookup 303 | 304 | lookupJustNote :: (Partial, Eq a) => String -> a -> [(a,b)] -> b 305 | lookupJustNote note x xs = withFrozenCallStack $ fromNote note "lookupJustNote, no matching value" $ lookup x xs 306 | 307 | -- | 308 | -- > findJust op = fromJust . find op 309 | findJust :: (a -> Bool) -> [a] -> a 310 | findJust = fromNote "" "findJust, no matching value" .^ find 311 | 312 | findJustDef :: a -> (a -> Bool) -> [a] -> a 313 | findJustDef def = fromMaybe def .^ find 314 | 315 | findJustNote :: Partial => String -> (a -> Bool) -> [a] -> a 316 | findJustNote note f x = withFrozenCallStack $ fromNote note "findJustNote, no matching value" $ find f x 317 | 318 | -- | 319 | -- > elemIndexJust op = fromJust . elemIndex op 320 | elemIndexJust :: (Partial, Eq a) => a -> [a] -> Int 321 | elemIndexJust x xs = withFrozenCallStack $ fromNote "" "elemIndexJust, no matching value" $ elemIndex x xs 322 | 323 | elemIndexJustDef :: Eq a => Int -> a -> [a] -> Int 324 | elemIndexJustDef def = fromMaybe def .^ elemIndex 325 | 326 | elemIndexJustNote :: (Partial, Eq a) => String -> a -> [a] -> Int 327 | elemIndexJustNote note x xs = withFrozenCallStack $ fromNote note "elemIndexJustNote, no matching value" $ elemIndex x xs 328 | 329 | -- | 330 | -- > findIndexJust op = fromJust . findIndex op 331 | findIndexJust :: (a -> Bool) -> [a] -> Int 332 | findIndexJust f x = withFrozenCallStack $ fromNote "" "findIndexJust, no matching value" $ findIndex f x 333 | 334 | findIndexJustDef :: Int -> (a -> Bool) -> [a] -> Int 335 | findIndexJustDef def = fromMaybe def .^ findIndex 336 | 337 | findIndexJustNote :: Partial => String -> (a -> Bool) -> [a] -> Int 338 | findIndexJustNote note f x = withFrozenCallStack $ fromNote note "findIndexJustNote, no matching value" $ findIndex f x 339 | 340 | -- From http://stackoverflow.com/questions/2743858/safe-and-polymorphic-toenum 341 | -- answer by C. A. McCann 342 | toEnumMay :: (Enum a, Bounded a) => Int -> Maybe a 343 | toEnumMay i = 344 | let r = toEnum i 345 | max = maxBound `asTypeOf` r 346 | min = minBound `asTypeOf` r 347 | in if i >= fromEnum min && i <= fromEnum max 348 | then Just r 349 | else Nothing 350 | 351 | toEnumDef :: (Enum a, Bounded a) => a -> Int -> a 352 | toEnumDef def = fromMaybe def . toEnumMay 353 | 354 | toEnumNote :: (Partial, Enum a, Bounded a) => String -> Int -> a 355 | toEnumNote note x = withFrozenCallStack $ fromNote note "toEnumNote, out of range" $ toEnumMay x 356 | 357 | toEnumSafe :: (Enum a, Bounded a) => Int -> a 358 | toEnumSafe = toEnumDef minBound 359 | 360 | succMay :: (Enum a, Eq a, Bounded a) => a -> Maybe a 361 | succMay = liftMay (== maxBound) succ 362 | 363 | succDef :: (Enum a, Eq a, Bounded a) => a -> a -> a 364 | succDef def = fromMaybe def . succMay 365 | 366 | succNote :: (Partial, Enum a, Eq a, Bounded a) => String -> a -> a 367 | succNote note x = withFrozenCallStack $ fromNote note "succNote, out of range" $ succMay x 368 | 369 | succSafe :: (Enum a, Eq a, Bounded a) => a -> a 370 | succSafe = succDef maxBound 371 | 372 | predMay :: (Enum a, Eq a, Bounded a) => a -> Maybe a 373 | predMay = liftMay (== minBound) pred 374 | 375 | predDef :: (Enum a, Eq a, Bounded a) => a -> a -> a 376 | predDef def = fromMaybe def . predMay 377 | 378 | predNote :: (Partial, Enum a, Eq a, Bounded a) => String -> a -> a 379 | predNote note x = withFrozenCallStack $ fromNote note "predNote, out of range" $ predMay x 380 | 381 | predSafe :: (Enum a, Eq a, Bounded a) => a -> a 382 | predSafe = predDef minBound 383 | 384 | indexMay :: Ix a => (a, a) -> a -> Maybe Int 385 | indexMay b i = if inRange b i then Just (index b i) else Nothing 386 | 387 | indexDef :: Ix a => Int -> (a, a) -> a -> Int 388 | indexDef def b = fromMaybe def . indexMay b 389 | 390 | indexNote :: (Partial, Ix a) => String -> (a, a) -> a -> Int 391 | indexNote note x y = withFrozenCallStack $ fromNote note "indexNote, out of range" $ indexMay x y 392 | 393 | 394 | --------------------------------------------------------------------- 395 | -- DISCOURAGED 396 | 397 | -- | New users are recommended to use 'minimumBound' or 'maximumBound' instead. 398 | minimumDef, maximumDef :: Ord a => a -> [a] -> a 399 | minimumDef def = fromMaybe def . minimumMay 400 | maximumDef def = fromMaybe def . maximumMay 401 | 402 | -- | New users are recommended to use 'minimumBoundBy' or 'maximumBoundBy' instead. 403 | minimumByDef, maximumByDef :: a -> (a -> a -> Ordering) -> [a] -> a 404 | minimumByDef def = fromMaybe def .^ minimumByMay 405 | maximumByDef def = fromMaybe def .^ maximumByMay 406 | 407 | 408 | --------------------------------------------------------------------- 409 | -- DEPRECATED 410 | 411 | {-# DEPRECATED foldr1Def "Use @foldr1May@ instead." #-} 412 | {-# DEPRECATED foldl1Def "Use @foldl1May@ instead." #-} 413 | {-# DEPRECATED foldl1Def' "Use @foldl1May'@ instead." #-} 414 | foldr1Def, foldl1Def, foldl1Def' :: a -> (a -> a -> a) -> [a] -> a 415 | foldr1Def def = fromMaybe def .^ foldr1May 416 | foldl1Def def = fromMaybe def .^ foldl1May 417 | foldl1Def' def = fromMaybe def .^ foldl1May' 418 | -------------------------------------------------------------------------------- /Safe/Exact.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE ConstraintKinds #-} 3 | {-# LANGUAGE TupleSections #-} 4 | {- | 5 | Provides functions that raise errors in corner cases instead of returning \"best effort\" 6 | results, then provides wrappers like the "Safe" module. For example: 7 | 8 | * @'takeExact' 3 [1,2]@ raises an error, in contrast to 'take' which would return 9 | just two elements. 10 | 11 | * @'takeExact' (-1) [1,2]@ raises an error, in contrast to 'take' which would return 12 | no elements. 13 | 14 | * @'zip' [1,2] [1]@ raises an error, in contrast to 'zip' which would only pair up the 15 | first element. 16 | 17 | Note that the @May@ variants of these functions are /strict/ in at least the bit of the prefix 18 | of the list required to spot errors. The standard and @Note@ versions are lazy, but throw 19 | errors later in the process - they do not check upfront. 20 | -} 21 | module Safe.Exact( 22 | -- * New functions 23 | takeExact, dropExact, splitAtExact, 24 | zipExact, zipWithExact, 25 | zip3Exact, zipWith3Exact, 26 | -- * Safe wrappers 27 | takeExactMay, takeExactNote, takeExactDef, 28 | dropExactMay, dropExactNote, dropExactDef, 29 | splitAtExactMay, splitAtExactNote, splitAtExactDef, 30 | zipExactMay, zipExactNote, zipExactDef, 31 | zipWithExactMay, zipWithExactNote, zipWithExactDef, 32 | zip3ExactMay, zip3ExactNote, zip3ExactDef, 33 | zipWith3ExactMay, zipWith3ExactNote, zipWith3ExactDef, 34 | ) where 35 | 36 | import Control.Arrow 37 | import Data.Maybe 38 | import Safe.Util 39 | import Safe.Partial 40 | 41 | --------------------------------------------------------------------- 42 | -- HELPERS 43 | 44 | addNote :: Partial => String -> String -> String -> a 45 | addNote note fun msg = error $ 46 | "Safe.Exact." ++ fun ++ ", " ++ msg ++ (if null note then "" else ", " ++ note) 47 | 48 | 49 | --------------------------------------------------------------------- 50 | -- IMPLEMENTATIONS 51 | 52 | {-# INLINE splitAtExact_ #-} 53 | splitAtExact_ :: Partial => (String -> r) -> ([a] -> r) -> (a -> r -> r) -> Int -> [a] -> r 54 | splitAtExact_ err nil cons o xs 55 | | o < 0 = err $ "index must not be negative, index=" ++ show o 56 | | otherwise = f o xs 57 | where 58 | f 0 xs = nil xs 59 | f i (x:xs) = x `cons` f (i-1) xs 60 | f i [] = err $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i) 61 | 62 | 63 | {-# INLINE zipWithExact_ #-} 64 | zipWithExact_ :: Partial => (String -> r) -> r -> (a -> b -> r -> r) -> [a] -> [b] -> r 65 | zipWithExact_ err nil cons = f 66 | where 67 | f (x:xs) (y:ys) = cons x y $ f xs ys 68 | f [] [] = nil 69 | f [] _ = err "second list is longer than the first" 70 | f _ [] = err "first list is longer than the second" 71 | 72 | 73 | {-# INLINE zipWith3Exact_ #-} 74 | zipWith3Exact_ :: Partial => (String -> r) -> r -> (a -> b -> c -> r -> r) -> [a] -> [b] -> [c] -> r 75 | zipWith3Exact_ err nil cons = f 76 | where 77 | f (x:xs) (y:ys) (z:zs) = cons x y z $ f xs ys zs 78 | f [] [] [] = nil 79 | f [] _ _ = err "first list is shorter than the others" 80 | f _ [] _ = err "second list is shorter than the others" 81 | f _ _ [] = err "third list is shorter than the others" 82 | 83 | 84 | --------------------------------------------------------------------- 85 | -- TAKE/DROP/SPLIT 86 | 87 | -- | 88 | -- > takeExact n xs = 89 | -- > | n >= 0 && n <= length xs = take n xs 90 | -- > | otherwise = error "some message" 91 | takeExact :: Partial => Int -> [a] -> [a] 92 | takeExact i xs = withFrozenCallStack $ splitAtExact_ (addNote "" "takeExact") (const []) (:) i xs 93 | 94 | -- | 95 | -- > dropExact n xs = 96 | -- > | n >= 0 && n <= length xs = drop n xs 97 | -- > | otherwise = error "some message" 98 | dropExact :: Partial => Int -> [a] -> [a] 99 | dropExact i xs = withFrozenCallStack $ splitAtExact_ (addNote "" "dropExact") id (\_ x -> x) i xs 100 | 101 | -- | 102 | -- > splitAtExact n xs = 103 | -- > | n >= 0 && n <= length xs = splitAt n xs 104 | -- > | otherwise = error "some message" 105 | splitAtExact :: Partial => Int -> [a] -> ([a], [a]) 106 | splitAtExact i xs = withFrozenCallStack $ splitAtExact_ (addNote "" "splitAtExact") 107 | ([],) (\a b -> first (a:) b) i xs 108 | 109 | takeExactNote :: Partial => String -> Int -> [a] -> [a] 110 | takeExactNote note i xs = withFrozenCallStack $ splitAtExact_ (addNote note "takeExactNote") (const []) (:) i xs 111 | 112 | takeExactMay :: Int -> [a] -> Maybe [a] 113 | takeExactMay = splitAtExact_ (const Nothing) (const $ Just []) (\a -> fmap (a:)) 114 | 115 | takeExactDef :: [a] -> Int -> [a] -> [a] 116 | takeExactDef def = fromMaybe def .^ takeExactMay 117 | 118 | dropExactNote :: Partial => String -> Int -> [a] -> [a] 119 | dropExactNote note i xs = withFrozenCallStack $ splitAtExact_ (addNote note "dropExactNote") id (\_ x -> x) i xs 120 | 121 | dropExactMay :: Int -> [a] -> Maybe [a] 122 | dropExactMay = splitAtExact_ (const Nothing) Just (\_ x -> x) 123 | 124 | dropExactDef :: [a] -> Int -> [a] -> [a] 125 | dropExactDef def = fromMaybe def .^ dropExactMay 126 | 127 | splitAtExactNote :: Partial => String -> Int -> [a] -> ([a], [a]) 128 | splitAtExactNote note i xs = withFrozenCallStack $ splitAtExact_ (addNote note "splitAtExactNote") 129 | ([],) (\a b -> first (a:) b) i xs 130 | 131 | splitAtExactMay :: Int -> [a] -> Maybe ([a], [a]) 132 | splitAtExactMay = splitAtExact_ (const Nothing) 133 | (\x -> Just ([], x)) (\a b -> fmap (first (a:)) b) 134 | 135 | splitAtExactDef :: ([a], [a]) -> Int -> [a] -> ([a], [a]) 136 | splitAtExactDef def = fromMaybe def .^ splitAtExactMay 137 | 138 | --------------------------------------------------------------------- 139 | -- ZIP 140 | 141 | -- | 142 | -- > zipExact xs ys = 143 | -- > | length xs == length ys = zip xs ys 144 | -- > | otherwise = error "some message" 145 | zipExact :: Partial => [a] -> [b] -> [(a,b)] 146 | zipExact xs ys = withFrozenCallStack $ zipWithExact_ (addNote "" "zipExact") [] (\a b xs -> (a,b) : xs) xs ys 147 | 148 | -- | 149 | -- > zipWithExact f xs ys = 150 | -- > | length xs == length ys = zipWith f xs ys 151 | -- > | otherwise = error "some message" 152 | zipWithExact :: Partial => (a -> b -> c) -> [a] -> [b] -> [c] 153 | zipWithExact f xs ys = withFrozenCallStack $ zipWithExact_ (addNote "" "zipWithExact") [] (\a b xs -> f a b : xs) xs ys 154 | 155 | 156 | zipExactNote :: Partial => String -> [a] -> [b] -> [(a,b)] 157 | zipExactNote note xs ys = withFrozenCallStack $ zipWithExact_ (addNote note "zipExactNote") [] (\a b xs -> (a,b) : xs) xs ys 158 | 159 | zipExactMay :: [a] -> [b] -> Maybe [(a,b)] 160 | zipExactMay = zipWithExact_ (const Nothing) (Just []) (\a b xs -> fmap ((a,b) :) xs) 161 | 162 | zipExactDef :: [(a,b)] -> [a] -> [b] -> [(a,b)] 163 | zipExactDef def = fromMaybe def .^ zipExactMay 164 | 165 | zipWithExactNote :: Partial => String -> (a -> b -> c) -> [a] -> [b] -> [c] 166 | zipWithExactNote note f xs ys = withFrozenCallStack $ zipWithExact_ (addNote note "zipWithExactNote") [] (\a b xs -> f a b : xs) xs ys 167 | 168 | zipWithExactMay :: (a -> b -> c) -> [a] -> [b] -> Maybe [c] 169 | zipWithExactMay f = zipWithExact_ (const Nothing) (Just []) (\a b xs -> fmap (f a b :) xs) 170 | 171 | zipWithExactDef :: [c] -> (a -> b -> c) -> [a] -> [b] -> [c] 172 | zipWithExactDef def = fromMaybe def .^^ zipWithExactMay 173 | 174 | 175 | -- | 176 | -- > zip3Exact xs ys zs = 177 | -- > | length xs == length ys && length xs == length zs = zip3 xs ys zs 178 | -- > | otherwise = error "some message" 179 | zip3Exact :: Partial => [a] -> [b] -> [c] -> [(a,b,c)] 180 | zip3Exact xs ys zs = withFrozenCallStack $ zipWith3Exact_ (addNote "" "zip3Exact") [] (\a b c xs -> (a, b, c) : xs) xs ys zs 181 | 182 | -- | 183 | -- > zipWith3Exact f xs ys zs = 184 | -- > | length xs == length ys && length xs == length zs = zipWith3 f xs ys zs 185 | -- > | otherwise = error "some message" 186 | zipWith3Exact :: Partial => (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] 187 | zipWith3Exact f xs ys zs = withFrozenCallStack $ zipWith3Exact_ (addNote "" "zipWith3Exact") [] (\a b c xs -> f a b c : xs) xs ys zs 188 | 189 | 190 | zip3ExactNote :: Partial => String -> [a] -> [b] -> [c]-> [(a,b,c)] 191 | zip3ExactNote note xs ys zs = withFrozenCallStack $ zipWith3Exact_ (addNote note "zip3ExactNote") [] (\a b c xs -> (a,b,c) : xs) xs ys zs 192 | 193 | zip3ExactMay :: [a] -> [b] -> [c] -> Maybe [(a,b,c)] 194 | zip3ExactMay = zipWith3Exact_ (const Nothing) (Just []) (\a b c xs -> fmap ((a,b,c) :) xs) 195 | 196 | zip3ExactDef :: [(a,b,c)] -> [a] -> [b] -> [c] -> [(a,b,c)] 197 | zip3ExactDef def = fromMaybe def .^^ zip3ExactMay 198 | 199 | zipWith3ExactNote :: Partial => String -> (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] 200 | zipWith3ExactNote note f xs ys zs = withFrozenCallStack $ zipWith3Exact_ (addNote note "zipWith3ExactNote") [] (\a b c xs -> f a b c : xs) xs ys zs 201 | 202 | zipWith3ExactMay :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> Maybe [d] 203 | zipWith3ExactMay f = zipWith3Exact_ (const Nothing) (Just []) (\a b c xs -> fmap (f a b c :) xs) 204 | 205 | zipWith3ExactDef :: [d] -> (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] 206 | zipWith3ExactDef def = fromMaybe def .^^^ zipWith3ExactMay 207 | -------------------------------------------------------------------------------- /Safe/Foldable.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE ConstraintKinds #-} 3 | {- | 4 | 'Foldable' functions, with wrappers like the "Safe" module. 5 | -} 6 | module Safe.Foldable( 7 | -- * New functions 8 | findJust, 9 | -- * Safe wrappers 10 | foldl1May, foldl1Def, foldl1Note, 11 | foldr1May, foldr1Def, foldr1Note, 12 | findJustDef, findJustNote, 13 | minimumMay, minimumNote, 14 | maximumMay, maximumNote, 15 | minimumByMay, minimumByNote, 16 | maximumByMay, maximumByNote, 17 | maximumBoundBy, minimumBoundBy, 18 | maximumBounded, maximumBound, 19 | minimumBounded, minimumBound, 20 | -- * Discouraged 21 | minimumDef, maximumDef, minimumByDef, maximumByDef, 22 | -- * Deprecated 23 | foldl1Safe, foldr1Safe, findJustSafe, 24 | ) where 25 | 26 | import Safe.Util 27 | import Data.Foldable as F 28 | import Data.Maybe 29 | import Data.Monoid 30 | import Prelude 31 | import Safe.Partial 32 | 33 | 34 | --------------------------------------------------------------------- 35 | -- UTILITIES 36 | 37 | fromNote :: Partial => String -> String -> Maybe a -> a 38 | fromNote = fromNoteModule "Safe.Foldable" 39 | 40 | 41 | --------------------------------------------------------------------- 42 | -- WRAPPERS 43 | 44 | foldl1May, foldr1May :: Foldable t => (a -> a -> a) -> t a -> Maybe a 45 | foldl1May = liftMay F.null . F.foldl1 46 | foldr1May = liftMay F.null . F.foldr1 47 | 48 | foldl1Note, foldr1Note :: (Partial, Foldable t) => String -> (a -> a -> a) -> t a -> a 49 | foldl1Note note f x = withFrozenCallStack $ fromNote note "foldl1Note on empty" $ foldl1May f x 50 | foldr1Note note f x = withFrozenCallStack $ fromNote note "foldr1Note on empty" $ foldr1May f x 51 | 52 | minimumMay, maximumMay :: (Foldable t, Ord a) => t a -> Maybe a 53 | minimumMay = liftMay F.null F.minimum 54 | maximumMay = liftMay F.null F.maximum 55 | 56 | minimumNote, maximumNote :: (Partial, Foldable t, Ord a) => String -> t a -> a 57 | minimumNote note x = withFrozenCallStack $ fromNote note "minimumNote on empty" $ minimumMay x 58 | maximumNote note x = withFrozenCallStack $ fromNote note "maximumNote on empty" $ maximumMay x 59 | 60 | minimumByMay, maximumByMay :: Foldable t => (a -> a -> Ordering) -> t a -> Maybe a 61 | minimumByMay = liftMay F.null . F.minimumBy 62 | maximumByMay = liftMay F.null . F.maximumBy 63 | 64 | minimumByNote, maximumByNote :: (Partial, Foldable t) => String -> (a -> a -> Ordering) -> t a -> a 65 | minimumByNote note f x = withFrozenCallStack $ fromNote note "minimumByNote on empty" $ minimumByMay f x 66 | maximumByNote note f x = withFrozenCallStack $ fromNote note "maximumByNote on empty" $ maximumByMay f x 67 | 68 | -- | The largest element of a foldable structure with respect to the 69 | -- given comparison function. The result is bounded by the value given as the first argument. 70 | maximumBoundBy :: Foldable f => a -> (a -> a -> Ordering) -> f a -> a 71 | maximumBoundBy x f xs = maximumBy f $ x : toList xs 72 | 73 | -- | The smallest element of a foldable structure with respect to the 74 | -- given comparison function. The result is bounded by the value given as the first argument. 75 | minimumBoundBy :: Foldable f => a -> (a -> a -> Ordering) -> f a -> a 76 | minimumBoundBy x f xs = minimumBy f $ x : toList xs 77 | 78 | -- | The largest element of a foldable structure. 79 | -- The result is bounded by the value given as the first argument. 80 | maximumBound :: (Foldable f, Ord a) => a -> f a -> a 81 | maximumBound x xs = maximum $ x : toList xs 82 | 83 | -- | The smallest element of a foldable structure. 84 | -- The result is bounded by the value given as the first argument. 85 | minimumBound :: (Foldable f, Ord a) => a -> f a -> a 86 | minimumBound x xs = minimum $ x : toList xs 87 | 88 | -- | The largest element of a foldable structure. 89 | -- The result is bounded by 'minBound'. 90 | maximumBounded :: (Foldable f, Ord a, Bounded a) => f a -> a 91 | maximumBounded = maximumBound minBound 92 | 93 | -- | The largest element of a foldable structure. 94 | -- The result is bounded by 'maxBound'. 95 | minimumBounded :: (Foldable f, Ord a, Bounded a) => f a -> a 96 | minimumBounded = minimumBound maxBound 97 | 98 | -- | 99 | -- > findJust op = fromJust . find op 100 | findJust :: (Partial, Foldable t) => (a -> Bool) -> t a -> a 101 | findJust f x = withFrozenCallStack $ fromNote "" "findJust, no matching value" $ F.find f x 102 | 103 | findJustDef :: Foldable t => a -> (a -> Bool) -> t a -> a 104 | findJustDef def = fromMaybe def .^ F.find 105 | 106 | findJustNote :: (Partial, Foldable t) => String -> (a -> Bool) -> t a -> a 107 | findJustNote note f x = withFrozenCallStack $ fromNote note "findJustNote, no matching value" $ F.find f x 108 | 109 | 110 | --------------------------------------------------------------------- 111 | -- DISCOURAGED 112 | 113 | -- | New users are recommended to use 'minimumBound' or 'maximumBound' instead. 114 | minimumDef, maximumDef :: (Foldable t, Ord a) => a -> t a -> a 115 | minimumDef def = fromMaybe def . minimumMay 116 | maximumDef def = fromMaybe def . maximumMay 117 | 118 | -- | New users are recommended to use 'minimumBoundBy' or 'maximumBoundBy' instead. 119 | minimumByDef, maximumByDef :: Foldable t => a -> (a -> a -> Ordering) -> t a -> a 120 | minimumByDef def = fromMaybe def .^ minimumByMay 121 | maximumByDef def = fromMaybe def .^ maximumByMay 122 | 123 | -- | New users are recommended to use 'foldr1May' or 'foldl1May' instead. 124 | foldl1Def, foldr1Def :: Foldable t => a -> (a -> a -> a) -> t a -> a 125 | foldl1Def def = fromMaybe def .^ foldl1May 126 | foldr1Def def = fromMaybe def .^ foldr1May 127 | 128 | 129 | --------------------------------------------------------------------- 130 | -- DEPRECATED 131 | 132 | {-# DEPRECATED foldl1Safe "Use @foldl f mempty@ instead." #-} 133 | foldl1Safe :: (Monoid m, Foldable t) => (m -> m -> m) -> t m -> m 134 | foldl1Safe fun = F.foldl fun mempty 135 | 136 | {-# DEPRECATED foldr1Safe "Use @foldr f mempty@ instead." #-} 137 | foldr1Safe :: (Monoid m, Foldable t) => (m -> m -> m) -> t m -> m 138 | foldr1Safe fun = F.foldr fun mempty 139 | 140 | {-# DEPRECATED findJustSafe "Use @findJustDef mempty@ instead." #-} 141 | findJustSafe :: (Monoid m, Foldable t) => (m -> Bool) -> t m -> m 142 | findJustSafe = findJustDef mempty 143 | -------------------------------------------------------------------------------- /Safe/Partial.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstraintKinds #-} 2 | {-# LANGUAGE KindSignatures #-} 3 | {-# LANGUAGE CPP #-} 4 | {-# LANGUAGE ImplicitParams #-} 5 | 6 | -- | ConstraintKind synonym for marking partial functions 7 | module Safe.Partial(Partial) where 8 | 9 | -- Let things work through ghci alone 10 | #ifndef MIN_VERSION_base 11 | #define MIN_VERSION_base(x,y,z) 1 12 | #endif 13 | 14 | -- GHC has changed its opinion on the location a few times 15 | -- v0: GHC 7.4.1, has ConstraintKinds 16 | -- v1: GHC 7.10.2, base 4.8.1.0 = CallStack 17 | -- v2: GHC 8.0.1, base 4.9.0.0 = HasCallStack 18 | 19 | #if __GLASGOW_HASKELL__ >= 800 20 | #define OPTION 2 21 | #elif __GLASGOW_HASKELL__ >= 710 && MIN_VERSION_base(4,8,1) 22 | #define OPTION 1 23 | #else 24 | #define OPTION 0 25 | #endif 26 | 27 | 28 | #if OPTION == 0 29 | import GHC.Exts 30 | #else 31 | import GHC.Stack 32 | #endif 33 | 34 | -- | A constraint synonym which denotes that the function is partial, and will 35 | -- (on GHC 8.* and up) produce a stack trace on failure. 36 | -- You may mark your own non-total functions as Partial, if necessary, and this 37 | -- will ensure that they produce useful stack traces. 38 | #if OPTION == 0 39 | type Partial = (() :: Constraint) 40 | #elif OPTION == 1 41 | type Partial = (?loc :: CallStack) 42 | #else 43 | type Partial = HasCallStack 44 | #endif 45 | -------------------------------------------------------------------------------- /Safe/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE ConstraintKinds #-} 3 | {-# LANGUAGE CPP #-} 4 | 5 | -- | Internal utilities. 6 | module Safe.Util( 7 | fromNoteModule, fromNoteEitherModule, 8 | liftMay, 9 | (.^), (.^^), (.^^^), 10 | eitherToMaybe, 11 | withFrozenCallStack 12 | ) where 13 | 14 | import Data.Maybe 15 | import Safe.Partial 16 | 17 | -- Let things work through ghci alone 18 | #if __GLASGOW_HASKELL__ >= 800 19 | import GHC.Stack 20 | #else 21 | withFrozenCallStack :: a -> a 22 | withFrozenCallStack = id 23 | #endif 24 | 25 | 26 | (.^) :: Partial => (b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c 27 | (.^) f g x1 x2 = f (g x1 x2) 28 | 29 | (.^^) :: Partial => (b -> c) -> (a1 -> a2 -> a3 -> b) -> a1 -> a2 -> a3 -> c 30 | (.^^) f g x1 x2 x3 = f (g x1 x2 x3) 31 | 32 | (.^^^) :: Partial => (b -> c) -> (a1 -> a2 -> a3 -> a4 -> b) -> a1 -> a2 -> a3 -> a4 -> c 33 | (.^^^) f g x1 x2 x3 x4 = f (g x1 x2 x3 x4) 34 | 35 | liftMay :: (a -> Bool) -> (a -> b) -> (a -> Maybe b) 36 | liftMay test func val = if test val then Nothing else Just $ func val 37 | 38 | fromNoteModule :: Partial => String -> String -> String -> Maybe a -> a 39 | fromNoteModule modu note func = fromMaybe (error msg) 40 | where msg = modu ++ "." ++ func ++ (if null note then "" else ", " ++ note) 41 | 42 | fromNoteEitherModule :: Partial => String -> String -> String -> Either String a -> a 43 | fromNoteEitherModule modu note func = either (error . msg) id 44 | where msg ex = modu ++ "." ++ func ++ " " ++ ex ++ (if null note then "" else ", " ++ note) 45 | 46 | eitherToMaybe :: Either a b -> Maybe b 47 | eitherToMaybe = either (const Nothing) Just 48 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} -- In the test suite, so OK 3 | 4 | module Main(main) where 5 | 6 | import Safe 7 | import Safe.Exact 8 | import qualified Safe.Foldable as F 9 | 10 | import Control.DeepSeq 11 | import Control.Exception 12 | import Control.Monad 13 | import Data.Char 14 | import Data.List 15 | import Data.Maybe 16 | import System.IO.Unsafe 17 | import Test.QuickCheck.Test 18 | import Test.QuickCheck hiding ((===)) 19 | 20 | 21 | --------------------------------------------------------------------- 22 | -- TESTS 23 | 24 | main :: IO () 25 | main = do 26 | -- All from the docs, so check they match 27 | tailMay dNil === Nothing 28 | tailMay [1,3,4] === Just [3,4] 29 | tailDef [12] [] === [12] 30 | tailDef [12] [1,3,4] === [3,4] 31 | tailNote "help me" dNil `err` "Safe.tailNote [], help me" 32 | tailNote "help me" [1,3,4] === [3,4] 33 | tailSafe [] === dNil 34 | tailSafe [1,3,4] === [3,4] 35 | 36 | findJust (== 2) [d1,2,3] === 2 37 | findJust (== 4) [d1,2,3] `err` "Safe.findJust" 38 | F.findJust (== 2) [d1,2,3] === 2 39 | F.findJust (== 4) [d1,2,3] `err` "Safe.Foldable.findJust" 40 | F.findJustDef 20 (== 4) [d1,2,3] === 20 41 | F.findJustNote "my note" (== 4) [d1,2,3] `errs` ["Safe.Foldable.findJustNote","my note"] 42 | 43 | takeExact 3 [d1,2] `errs` ["Safe.Exact.takeExact","index=3","length=2"] 44 | takeExact (-1) [d1,2] `errs` ["Safe.Exact.takeExact","negative","index=-1"] 45 | takeExact 1 (takeExact 3 [d1,2]) === [1] -- test is lazy 46 | 47 | quickCheck_ $ \(Int10 i) (List10 (xs :: [Int])) -> do 48 | let (t,d) = splitAt i xs 49 | let good = length t == i 50 | let f name exact may note res = 51 | if good then do 52 | exact i xs === res 53 | note "foo" i xs === res 54 | may i xs === Just res 55 | else do 56 | exact i xs `err` ("Safe.Exact." ++ name ++ "Exact") 57 | note "foo" i xs `errs` ["Safe.Exact." ++ name ++ "ExactNote","foo"] 58 | may i xs === Nothing 59 | f "take" takeExact takeExactMay takeExactNote t 60 | f "drop" dropExact dropExactMay dropExactNote d 61 | f "splitAt" splitAtExact splitAtExactMay splitAtExactNote (t, d) 62 | return True 63 | 64 | take 2 (zipExact [1,2,3] [1,2]) === [(1,1),(2,2)] 65 | zipExact [d1,2,3] [d1,2] `errs` ["Safe.Exact.zipExact","first list is longer than the second"] 66 | zipExact [d1,2] [d1,2,3] `errs` ["Safe.Exact.zipExact","second list is longer than the first"] 67 | zipExact dNil dNil === [] 68 | 69 | predMay (minBound :: Int) === Nothing 70 | succMay (maxBound :: Int) === Nothing 71 | predMay ((minBound + 1) :: Int) === Just minBound 72 | succMay ((maxBound - 1) :: Int) === Just maxBound 73 | 74 | quickCheck_ $ \(List10 (xs :: [Int])) x -> do 75 | let ys = maybeToList x ++ xs 76 | let res = zip xs ys 77 | let f name exact may note = 78 | if isNothing x then do 79 | exact xs ys === res 80 | note "foo" xs ys === res 81 | may xs ys === Just res 82 | else do 83 | exact xs ys `err` ("Safe.Exact." ++ name ++ "Exact") 84 | note "foo" xs ys `errs` ["Safe.Exact." ++ name ++ "ExactNote","foo"] 85 | may xs ys === Nothing 86 | f "zip" zipExact zipExactMay zipExactNote 87 | f "zipWith" (zipWithExact (,)) (zipWithExactMay (,)) (`zipWithExactNote` (,)) 88 | return True 89 | 90 | take 2 (zip3Exact [1,2,3] [1,2,3] [1,2]) === [(1,1,1),(2,2,2)] 91 | zip3Exact [d1,2] [d1,2,3] [d1,2,3] `errs` ["Safe.Exact.zip3Exact","first list is shorter than the others"] 92 | zip3Exact [d1,2,3] [d1,2] [d1,2,3] `errs` ["Safe.Exact.zip3Exact","second list is shorter than the others"] 93 | zip3Exact [d1,2,3] [d1,2,3] [d1,2] `errs` ["Safe.Exact.zip3Exact","third list is shorter than the others"] 94 | zip3Exact dNil dNil dNil === [] 95 | 96 | quickCheck_ $ \(List10 (xs :: [Int])) x1 x2 -> do 97 | let ys = maybeToList x1 ++ xs 98 | let zs = maybeToList x2 ++ xs 99 | let res = zip3 xs ys zs 100 | let f name exact may note = 101 | if isNothing x1 && isNothing x2 then do 102 | exact xs ys zs === res 103 | note "foo" xs ys zs === res 104 | may xs ys zs === Just res 105 | else do 106 | exact xs ys zs `err` ("Safe.Exact." ++ name ++ "Exact") 107 | note "foo" xs ys zs `errs` ["Safe.Exact." ++ name ++ "ExactNote","foo"] 108 | may xs ys zs === Nothing 109 | f "zip3" zip3Exact zip3ExactMay zip3ExactNote 110 | f "zipWith3" (zipWith3Exact (,,)) (zipWith3ExactMay (,,)) (flip zipWith3ExactNote (,,)) 111 | return True 112 | 113 | 114 | --------------------------------------------------------------------- 115 | -- UTILITIES 116 | 117 | quickCheck_ prop = do 118 | r <- quickCheckResult prop 119 | unless (isSuccess r) $ error "Test failed" 120 | 121 | 122 | d1 = 1 :: Double 123 | dNil = [] :: [Double] 124 | 125 | (===) :: (Show a, Eq a) => a -> a -> IO () 126 | (===) a b = when (a /= b) $ error $ "Mismatch: " ++ show a ++ " /= " ++ show b 127 | 128 | err :: NFData a => a -> String -> IO () 129 | err a b = errs a [b] 130 | 131 | errs :: NFData a => a -> [String] -> IO () 132 | errs a bs = do 133 | res <- try $ evaluate $ rnf a 134 | case res of 135 | Right v -> error $ "Expected error, but succeeded: " ++ show bs 136 | Left (msg :: SomeException) -> forM_ bs $ \b -> do 137 | let s = show msg 138 | unless (b `isInfixOf` s) $ error $ "Invalid error string, got " ++ show s ++ ", want " ++ show b 139 | let f xs = " " ++ map (\x -> if sepChar x then ' ' else x) xs ++ " " 140 | unless (f b `isInfixOf` f s) $ error $ "Not standalone error string, got " ++ show s ++ ", want " ++ show b 141 | 142 | sepChar x = isSpace x || x `elem` ",;." 143 | 144 | newtype Int10 = Int10 Int deriving Show 145 | 146 | instance Arbitrary Int10 where 147 | arbitrary = fmap Int10 $ choose (-3, 10) 148 | 149 | newtype List10 a = List10 [a] deriving Show 150 | 151 | instance Arbitrary a => Arbitrary (List10 a) where 152 | arbitrary = do i <- choose (0, 10); fmap List10 $ vector i 153 | 154 | instance Testable a => Testable (IO a) where 155 | property = property . unsafePerformIO 156 | -------------------------------------------------------------------------------- /safe.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.18 2 | build-type: Simple 3 | name: safe 4 | version: 0.3.21 5 | license: BSD3 6 | license-file: LICENSE 7 | category: Unclassified 8 | author: Neil Mitchell 9 | maintainer: Neil Mitchell 10 | copyright: Neil Mitchell 2007-2024 11 | homepage: https://github.com/ndmitchell/safe#readme 12 | synopsis: Library of safe (exception free) functions 13 | bug-reports: https://github.com/ndmitchell/safe/issues 14 | tested-with: GHC==9.8, GHC==9.6, GHC==9.4, GHC==9.2, GHC==9.0, GHC==8.10, GHC==8.8 15 | description: 16 | A library wrapping @Prelude@/@Data.List@ functions that can throw exceptions, such as @head@ and @!!@. 17 | Each unsafe function has up to four variants, e.g. with @tail@: 18 | . 19 | * @tail :: [a] -> [a]@, raises an error on @tail []@. 20 | . 21 | * @tailMay :: [a] -> /Maybe/ [a]@, turns errors into @Nothing@. 22 | . 23 | * @tailDef :: /[a]/ -> [a] -> [a]@, takes a default to return on errors. 24 | . 25 | * @tailNote :: /String/ -> [a] -> [a]@, takes an extra argument which supplements the error message. 26 | . 27 | * @tailSafe :: [a] -> [a]@, returns some sensible default if possible, @[]@ in the case of @tail@. 28 | . 29 | This package is divided into three modules: 30 | . 31 | * "Safe" contains safe variants of @Prelude@ and @Data.List@ functions. 32 | . 33 | * "Safe.Foldable" contains safe variants of @Foldable@ functions. 34 | . 35 | * "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. 36 | extra-doc-files: 37 | CHANGES.txt 38 | README.md 39 | 40 | source-repository head 41 | type: git 42 | location: https://github.com/ndmitchell/safe.git 43 | 44 | library 45 | default-language: Haskell2010 46 | build-depends: 47 | base >= 4.9 && < 5 48 | 49 | exposed-modules: 50 | Safe 51 | Safe.Exact 52 | Safe.Foldable 53 | Safe.Partial 54 | 55 | other-modules: 56 | Safe.Util 57 | 58 | test-suite safe-test 59 | type: exitcode-stdio-1.0 60 | main-is: Test.hs 61 | default-language: Haskell2010 62 | 63 | other-modules: 64 | Safe 65 | Safe.Exact 66 | Safe.Foldable 67 | Safe.Partial 68 | Safe.Util 69 | build-depends: 70 | base, 71 | deepseq, 72 | QuickCheck, 73 | safe 74 | --------------------------------------------------------------------------------