safe-0.3.19/0000755000000000000000000000000013662553443010723 5ustar0000000000000000safe-0.3.19/Test.hs0000644000000000000000000001350113207351206012162 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- In the test suite, so OK module Main(main) where import Safe import Safe.Exact import qualified Safe.Foldable as F import Control.DeepSeq import Control.Exception import Control.Monad import Data.Char import Data.List import Data.Maybe import System.IO.Unsafe import Test.QuickCheck.Test import Test.QuickCheck hiding ((===)) --------------------------------------------------------------------- -- TESTS main :: IO () main = do -- All from the docs, so check they match tailMay dNil === Nothing tailMay [1,3,4] === Just [3,4] tailDef [12] [] === [12] tailDef [12] [1,3,4] === [3,4] tailNote "help me" dNil `err` "Safe.tailNote [], help me" tailNote "help me" [1,3,4] === [3,4] tailSafe [] === dNil tailSafe [1,3,4] === [3,4] findJust (== 2) [d1,2,3] === 2 findJust (== 4) [d1,2,3] `err` "Safe.findJust" F.findJust (== 2) [d1,2,3] === 2 F.findJust (== 4) [d1,2,3] `err` "Safe.Foldable.findJust" F.findJustDef 20 (== 4) [d1,2,3] === 20 F.findJustNote "my note" (== 4) [d1,2,3] `errs` ["Safe.Foldable.findJustNote","my note"] takeExact 3 [d1,2] `errs` ["Safe.Exact.takeExact","index=3","length=2"] takeExact (-1) [d1,2] `errs` ["Safe.Exact.takeExact","negative","index=-1"] takeExact 1 (takeExact 3 [d1,2]) === [1] -- test is lazy quickCheck_ $ \(Int10 i) (List10 (xs :: [Int])) -> do let (t,d) = splitAt i xs let good = length t == i let f name exact may note res = if good then do exact i xs === res note "foo" i xs === res may i xs === Just res else do exact i xs `err` ("Safe.Exact." ++ name ++ "Exact") note "foo" i xs `errs` ["Safe.Exact." ++ name ++ "ExactNote","foo"] may i xs === Nothing f "take" takeExact takeExactMay takeExactNote t f "drop" dropExact dropExactMay dropExactNote d f "splitAt" splitAtExact splitAtExactMay splitAtExactNote (t, d) return True take 2 (zipExact [1,2,3] [1,2]) === [(1,1),(2,2)] zipExact [d1,2,3] [d1,2] `errs` ["Safe.Exact.zipExact","first list is longer than the second"] zipExact [d1,2] [d1,2,3] `errs` ["Safe.Exact.zipExact","second list is longer than the first"] zipExact dNil dNil === [] predMay (minBound :: Int) === Nothing succMay (maxBound :: Int) === Nothing predMay ((minBound + 1) :: Int) === Just minBound succMay ((maxBound - 1) :: Int) === Just maxBound quickCheck_ $ \(List10 (xs :: [Int])) x -> do let ys = maybeToList x ++ xs let res = zip xs ys let f name exact may note = if isNothing x then do exact xs ys === res note "foo" xs ys === res may xs ys === Just res else do exact xs ys `err` ("Safe.Exact." ++ name ++ "Exact") note "foo" xs ys `errs` ["Safe.Exact." ++ name ++ "ExactNote","foo"] may xs ys === Nothing f "zip" zipExact zipExactMay zipExactNote f "zipWith" (zipWithExact (,)) (zipWithExactMay (,)) (`zipWithExactNote` (,)) return True take 2 (zip3Exact [1,2,3] [1,2,3] [1,2]) === [(1,1,1),(2,2,2)] zip3Exact [d1,2] [d1,2,3] [d1,2,3] `errs` ["Safe.Exact.zip3Exact","first list is shorter than the others"] zip3Exact [d1,2,3] [d1,2] [d1,2,3] `errs` ["Safe.Exact.zip3Exact","second list is shorter than the others"] zip3Exact [d1,2,3] [d1,2,3] [d1,2] `errs` ["Safe.Exact.zip3Exact","third list is shorter than the others"] zip3Exact dNil dNil dNil === [] quickCheck_ $ \(List10 (xs :: [Int])) x1 x2 -> do let ys = maybeToList x1 ++ xs let zs = maybeToList x2 ++ xs let res = zip3 xs ys zs let f name exact may note = if isNothing x1 && isNothing x2 then do exact xs ys zs === res note "foo" xs ys zs === res may xs ys zs === Just res else do exact xs ys zs `err` ("Safe.Exact." ++ name ++ "Exact") note "foo" xs ys zs `errs` ["Safe.Exact." ++ name ++ "ExactNote","foo"] may xs ys zs === Nothing f "zip3" zip3Exact zip3ExactMay zip3ExactNote f "zipWith3" (zipWith3Exact (,,)) (zipWith3ExactMay (,,)) (flip zipWith3ExactNote (,,)) return True --------------------------------------------------------------------- -- UTILITIES quickCheck_ prop = do r <- quickCheckResult prop unless (isSuccess r) $ error "Test failed" d1 = 1 :: Double dNil = [] :: [Double] (===) :: (Show a, Eq a) => a -> a -> IO () (===) a b = when (a /= b) $ error $ "Mismatch: " ++ show a ++ " /= " ++ show b err :: NFData a => a -> String -> IO () err a b = errs a [b] errs :: NFData a => a -> [String] -> IO () errs a bs = do res <- try $ evaluate $ rnf a case res of Right v -> error $ "Expected error, but succeeded: " ++ show bs Left (msg :: SomeException) -> forM_ bs $ \b -> do let s = show msg unless (b `isInfixOf` s) $ error $ "Invalid error string, got " ++ show s ++ ", want " ++ show b let f xs = " " ++ map (\x -> if sepChar x then ' ' else x) xs ++ " " unless (f b `isInfixOf` f s) $ error $ "Not standalone error string, got " ++ show s ++ ", want " ++ show b sepChar x = isSpace x || x `elem` ",;." newtype Int10 = Int10 Int deriving Show instance Arbitrary Int10 where arbitrary = fmap Int10 $ choose (-3, 10) newtype List10 a = List10 [a] deriving Show instance Arbitrary a => Arbitrary (List10 a) where arbitrary = do i <- choose (0, 10); fmap List10 $ vector i instance Testable a => Testable (IO a) where property = property . unsafePerformIO safe-0.3.19/Setup.hs0000644000000000000000000000005512523462614012351 0ustar0000000000000000import Distribution.Simple main = defaultMainsafe-0.3.19/Safe.hs0000644000000000000000000003420413662552300012127 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} {- | A module wrapping @Prelude@/@Data.List@ functions that can throw exceptions, such as @head@ and @!!@. Each unsafe function has up to four variants, e.g. with @tail@: * @'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' :: 'Partial' => /String/ -> [a] -> [a]@, takes an extra argument which supplements the error message. * @'tailSafe' :: [a] -> [a]@, returns some sensible default if possible, @[]@ in the case of @tail@. All functions marked with the @'Partial'@ constraint are not total, and will produce stack traces on error, on GHC versions which support them (see "GHC.Stack"). This module also introduces some new functions, documented at the top of the module. -} module Safe( -- * New functions abort, at, lookupJust, findJust, elemIndexJust, findIndexJust, -- * Safe wrappers tailMay, tailDef, tailNote, tailSafe, initMay, initDef, initNote, initSafe, headMay, headDef, headNote, lastMay, lastDef, lastNote, minimumMay, minimumNote, maximumMay, maximumNote, minimumByMay, minimumByNote, maximumByMay, maximumByNote, minimumBoundBy, maximumBoundBy, maximumBounded, maximumBound, minimumBounded, minimumBound, foldr1May, foldr1Def, foldr1Note, foldl1May, foldl1Def, foldl1Note, foldl1May', foldl1Def', foldl1Note', scanl1May, scanl1Def, scanl1Note, scanr1May, scanr1Def, scanr1Note, cycleMay, cycleDef, cycleNote, fromJustDef, fromJustNote, assertNote, atMay, atDef, atNote, readMay, readDef, readNote, readEitherSafe, lookupJustDef, lookupJustNote, findJustDef, findJustNote, elemIndexJustDef, elemIndexJustNote, findIndexJustDef, findIndexJustNote, toEnumMay, toEnumDef, toEnumNote, toEnumSafe, succMay, succDef, succNote, succSafe, predMay, predDef, predNote, predSafe, indexMay, indexDef, indexNote, -- * Discouraged minimumDef, maximumDef, minimumByDef, maximumByDef ) where import Safe.Util import Data.Ix import Data.List import Data.Maybe import Safe.Partial --------------------------------------------------------------------- -- UTILITIES fromNote :: Partial => String -> String -> Maybe a -> a fromNote = fromNoteModule "Safe" fromNoteEither :: Partial => String -> String -> Either String a -> a fromNoteEither = fromNoteEitherModule "Safe" --------------------------------------------------------------------- -- IMPLEMENTATIONS -- | Synonym for 'error'. Used for instances where the program -- has decided to exit because of invalid user input, or the user pressed -- quit etc. This function allows 'error' to be reserved for programmer errors. abort :: Partial => String -> a abort x = withFrozenCallStack (error x) at_ :: [a] -> Int -> Either String a at_ xs o | o < 0 = Left $ "index must not be negative, index=" ++ show o | otherwise = f o xs where f 0 (x:xs) = Right x f i (x:xs) = f (i-1) xs f i [] = Left $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i) --------------------------------------------------------------------- -- WRAPPERS -- | -- > tailMay [] = Nothing -- > tailMay [1,3,4] = Just [3,4] tailMay :: [a] -> Maybe [a] tailMay = liftMay 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 = tailDef [] initMay :: [a] -> Maybe [a] initMay = liftMay null init initDef :: [a] -> [a] -> [a] initDef def = fromMaybe def . initMay initNote :: Partial => String -> [a] -> [a] initNote note x = withFrozenCallStack $ fromNote note "initNote []" $ initMay x initSafe :: [a] -> [a] initSafe = initDef [] headMay, lastMay :: [a] -> Maybe a headMay = liftMay null head lastMay = liftMay null last headDef, lastDef :: a -> [a] -> a headDef def = fromMaybe def . headMay lastDef def = fromMaybe def . lastMay headNote, lastNote :: Partial => String -> [a] -> a headNote note x = withFrozenCallStack $ fromNote note "headNote []" $ headMay x lastNote note x = withFrozenCallStack $ fromNote note "lastNote []" $ lastMay x minimumMay, maximumMay :: Ord a => [a] -> Maybe a minimumMay = liftMay null minimum maximumMay = liftMay null maximum minimumNote, maximumNote :: (Partial, Ord a) => String -> [a] -> a minimumNote note x = withFrozenCallStack $ fromNote note "minumumNote []" $ minimumMay x maximumNote note x = withFrozenCallStack $ fromNote note "maximumNote []" $ maximumMay x minimumByMay, maximumByMay :: (a -> a -> Ordering) -> [a] -> Maybe a minimumByMay = liftMay null . minimumBy maximumByMay = liftMay null . maximumBy minimumByNote, maximumByNote :: Partial => String -> (a -> a -> Ordering) -> [a] -> a minimumByNote note f x = withFrozenCallStack $ fromNote note "minumumByNote []" $ minimumByMay f x maximumByNote note f x = withFrozenCallStack $ fromNote note "maximumByNote []" $ maximumByMay f x -- | The largest element of a list with respect to the -- given comparison function. The result is bounded by the value given as the first argument. maximumBoundBy :: a -> (a -> a -> Ordering) -> [a] -> a maximumBoundBy x f xs = maximumBy f $ x : xs -- | The smallest element of a list with respect to the -- given comparison function. The result is bounded by the value given as the first argument. minimumBoundBy :: a -> (a -> a -> Ordering) -> [a] -> a minimumBoundBy x f xs = minimumBy f $ x : xs -- | The largest element of a list. -- The result is bounded by the value given as the first argument. maximumBound :: Ord a => a -> [a] -> a maximumBound x xs = maximum $ x : xs -- | The smallest element of a list. -- The result is bounded by the value given as the first argument. minimumBound :: Ord a => a -> [a] -> a minimumBound x xs = minimum $ x : xs -- | The largest element of a list. -- The result is bounded by 'minBound'. maximumBounded :: (Ord a, Bounded a) => [a] -> a maximumBounded = maximumBound minBound -- | The largest element of a list. -- The result is bounded by 'maxBound'. minimumBounded :: (Ord a, Bounded a) => [a] -> a minimumBounded = minimumBound maxBound foldr1May, foldl1May, foldl1May' :: (a -> a -> a) -> [a] -> Maybe a foldr1May = liftMay null . foldr1 foldl1May = liftMay null . foldl1 foldl1May' = liftMay null . foldl1' foldr1Note, foldl1Note, foldl1Note' :: Partial => String -> (a -> a -> a) -> [a] -> a foldr1Note note f x = withFrozenCallStack $ fromNote note "foldr1Note []" $ foldr1May f x foldl1Note note f x = withFrozenCallStack $ fromNote note "foldl1Note []" $ foldl1May f x foldl1Note' note f x = withFrozenCallStack $ fromNote note "foldl1Note []" $ foldl1May' f x scanr1May, scanl1May :: (a -> a -> a) -> [a] -> Maybe [a] scanr1May = liftMay null . scanr1 scanl1May = liftMay null . scanl1 scanr1Def, scanl1Def :: [a] -> (a -> a -> a) -> [a] -> [a] scanr1Def def = fromMaybe def .^ scanr1May scanl1Def def = fromMaybe def .^ scanl1May scanr1Note, scanl1Note :: Partial => String -> (a -> a -> a) -> [a] -> [a] scanr1Note note f x = withFrozenCallStack $ fromNote note "scanr1Note []" $ scanr1May f x scanl1Note note f x = withFrozenCallStack $ fromNote note "scanl1Note []" $ scanl1May f x cycleMay :: [a] -> Maybe [a] cycleMay = liftMay null cycle cycleDef :: [a] -> [a] -> [a] cycleDef def = fromMaybe def . cycleMay cycleNote :: Partial => String -> [a] -> [a] cycleNote note x = withFrozenCallStack $ fromNote note "cycleNote []" $ cycleMay x -- | An alternative name for 'fromMaybe', to fit the naming scheme of this package. -- Generally using 'fromMaybe' directly would be considered better style. fromJustDef :: a -> Maybe a -> a fromJustDef = fromMaybe fromJustNote :: Partial => String -> Maybe a -> a fromJustNote note x = withFrozenCallStack $ fromNote note "fromJustNote Nothing" x assertNote :: Partial => String -> Bool -> a -> a assertNote note True val = val assertNote note False val = withFrozenCallStack $ fromNote note "assertNote False" Nothing -- | Synonym for '!!', but includes more information in the error message. at :: Partial => [a] -> Int -> a at = fromNoteEither "" "at" .^ at_ atMay :: [a] -> Int -> Maybe a atMay = eitherToMaybe .^ at_ atDef :: a -> [a] -> Int -> a atDef def = fromMaybe def .^ atMay atNote :: Partial => String -> [a] -> Int -> a atNote note f x = withFrozenCallStack $ fromNoteEither note "atNote" $ at_ f x -- | This function provides a more precise error message than 'readEither' from 'base'. readEitherSafe :: Read a => String -> Either String a readEitherSafe s = case [x | (x,t) <- reads s, ("","") <- lex t] of [x] -> Right x [] -> Left $ "no parse on " ++ prefix _ -> Left $ "ambiguous parse on " ++ prefix where maxLength = 15 prefix = '\"' : a ++ if length s <= maxLength then b ++ "\"" else "...\"" where (a,b) = splitAt (maxLength - 3) s readMay :: Read a => String -> Maybe a readMay = eitherToMaybe . readEitherSafe readDef :: Read a => a -> String -> a readDef def = fromMaybe def . readMay -- | 'readNote' uses 'readEitherSafe' for the error message. readNote :: (Partial, Read a) => String -> String -> a readNote note x = withFrozenCallStack $ fromNoteEither note "readNote" $ readEitherSafe x -- | -- > lookupJust key = fromJust . lookup key lookupJust :: (Eq a, Partial) => a -> [(a,b)] -> b lookupJust x xs = withFrozenCallStack $ fromNote "" "lookupJust, no matching value" $ lookup x xs lookupJustDef :: Eq a => b -> a -> [(a,b)] -> b lookupJustDef def = fromMaybe def .^ lookup lookupJustNote :: (Partial, Eq a) => String -> a -> [(a,b)] -> b lookupJustNote note x xs = withFrozenCallStack $ fromNote note "lookupJustNote, no matching value" $ lookup x xs -- | -- > findJust op = fromJust . find op findJust :: (a -> Bool) -> [a] -> a findJust = fromNote "" "findJust, no matching value" .^ find findJustDef :: a -> (a -> Bool) -> [a] -> a findJustDef def = fromMaybe def .^ find findJustNote :: Partial => String -> (a -> Bool) -> [a] -> a findJustNote note f x = withFrozenCallStack $ fromNote note "findJustNote, no matching value" $ find f x -- | -- > elemIndexJust op = fromJust . elemIndex op elemIndexJust :: (Partial, Eq a) => a -> [a] -> Int elemIndexJust x xs = withFrozenCallStack $ fromNote "" "elemIndexJust, no matching value" $ elemIndex x xs elemIndexJustDef :: Eq a => Int -> a -> [a] -> Int elemIndexJustDef def = fromMaybe def .^ elemIndex elemIndexJustNote :: (Partial, Eq a) => String -> a -> [a] -> Int elemIndexJustNote note x xs = withFrozenCallStack $ fromNote note "elemIndexJustNote, no matching value" $ elemIndex x xs -- | -- > findIndexJust op = fromJust . findIndex op findIndexJust :: (a -> Bool) -> [a] -> Int findIndexJust f x = withFrozenCallStack $ fromNote "" "findIndexJust, no matching value" $ findIndex f x findIndexJustDef :: Int -> (a -> Bool) -> [a] -> Int findIndexJustDef def = fromMaybe def .^ findIndex findIndexJustNote :: Partial => String -> (a -> Bool) -> [a] -> Int findIndexJustNote note f x = withFrozenCallStack $ fromNote note "findIndexJustNote, no matching value" $ findIndex f x -- From http://stackoverflow.com/questions/2743858/safe-and-polymorphic-toenum -- answer by C. A. McCann toEnumMay :: (Enum a, Bounded a) => Int -> Maybe a toEnumMay i = let r = toEnum i max = maxBound `asTypeOf` r min = minBound `asTypeOf` r in if i >= fromEnum min && i <= fromEnum max then Just r else Nothing toEnumDef :: (Enum a, Bounded a) => a -> Int -> a toEnumDef def = fromMaybe def . toEnumMay toEnumNote :: (Partial, Enum a, Bounded a) => String -> Int -> a toEnumNote note x = withFrozenCallStack $ fromNote note "toEnumNote, out of range" $ toEnumMay x toEnumSafe :: (Enum a, Bounded a) => Int -> a toEnumSafe = toEnumDef minBound succMay :: (Enum a, Eq a, Bounded a) => a -> Maybe a succMay = liftMay (== maxBound) succ succDef :: (Enum a, Eq a, Bounded a) => a -> a -> a succDef def = fromMaybe def . succMay succNote :: (Partial, Enum a, Eq a, Bounded a) => String -> a -> a succNote note x = withFrozenCallStack $ fromNote note "succNote, out of range" $ succMay x succSafe :: (Enum a, Eq a, Bounded a) => a -> a succSafe = succDef maxBound predMay :: (Enum a, Eq a, Bounded a) => a -> Maybe a predMay = liftMay (== minBound) pred predDef :: (Enum a, Eq a, Bounded a) => a -> a -> a predDef def = fromMaybe def . predMay predNote :: (Partial, Enum a, Eq a, Bounded a) => String -> a -> a predNote note x = withFrozenCallStack $ fromNote note "predNote, out of range" $ predMay x predSafe :: (Enum a, Eq a, Bounded a) => a -> a predSafe = predDef minBound indexMay :: Ix a => (a, a) -> a -> Maybe Int indexMay b i = if inRange b i then Just (index b i) else Nothing indexDef :: Ix a => Int -> (a, a) -> a -> Int indexDef def b = fromMaybe def . indexMay b indexNote :: (Partial, Ix a) => String -> (a, a) -> a -> Int indexNote note x y = withFrozenCallStack $ fromNote note "indexNote, out of range" $ indexMay x y --------------------------------------------------------------------- -- DISCOURAGED -- | New users are recommended to use 'minimumBound' or 'maximumBound' instead. minimumDef, maximumDef :: Ord a => a -> [a] -> a minimumDef def = fromMaybe def . minimumMay maximumDef def = fromMaybe def . maximumMay -- | New users are recommended to use 'minimumBoundBy' or 'maximumBoundBy' instead. minimumByDef, maximumByDef :: a -> (a -> a -> Ordering) -> [a] -> a minimumByDef def = fromMaybe def .^ minimumByMay maximumByDef def = fromMaybe def .^ maximumByMay --------------------------------------------------------------------- -- DEPRECATED {-# DEPRECATED foldr1Def "Use @foldr1May@ instead." #-} {-# DEPRECATED foldl1Def "Use @foldl1May@ instead." #-} {-# DEPRECATED foldl1Def' "Use @foldl1May'@ instead." #-} foldr1Def, foldl1Def, foldl1Def' :: a -> (a -> a -> a) -> [a] -> a foldr1Def def = fromMaybe def .^ foldr1May foldl1Def def = fromMaybe def .^ foldl1May foldl1Def' def = fromMaybe def .^ foldl1May' safe-0.3.19/safe.cabal0000644000000000000000000000441513662553375012635 0ustar0000000000000000cabal-version: >= 1.18 build-type: Simple name: safe version: 0.3.19 license: BSD3 license-file: LICENSE category: Unclassified author: Neil Mitchell maintainer: Neil Mitchell copyright: Neil Mitchell 2007-2020 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==8.10.1, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 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 safe-0.3.19/README.md0000644000000000000000000000253613472475043012206 0ustar0000000000000000# 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/travis/ndmitchell/safe/master.svg?label=Build)](https://travis-ci.org/ndmitchell/safe) A library wrapping `Prelude`/`Data.List` functions that can throw exceptions, such as `head` and `!!`. Each unsafe function has up to four variants, e.g. with `tail`: * tail :: [a] -> [a], raises an error on `tail []`. * tailMay :: [a] -> Maybe [a], turns errors into `Nothing`. * tailDef :: [a] -> [a] -> [a], takes a default to return on errors. * tailNote :: String -> [a] -> [a], takes an extra argument which supplements the error message. * tailSafe :: [a] -> [a], returns some sensible default if possible, `[]` in the case of `tail`. This package is divided into three modules: * `Safe` contains safe variants of `Prelude` and `Data.List` functions. * `Safe.Foldable` contains safe variants of `Foldable` functions. * `Safe.Exact` creates crashing versions of functions like `zip` (errors if the lists are not equal) and `take` (errors if there are not enough elements), then wraps them to provide safe variants. safe-0.3.19/LICENSE0000644000000000000000000000276413631220617011727 0ustar0000000000000000Copyright Neil Mitchell 2007-2020. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Neil Mitchell nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. safe-0.3.19/CHANGES.txt0000644000000000000000000000347113662553366012545 0ustar0000000000000000Changelog for Safe 0.3.19, released 2020-05-24 #30, undeprecate maximumDef and friends, fold*1Def 0.3.18, released 2019-12-04 #27, deprecate maximumDef and friends, fold*1Def #27, add maximumBounded and friends Stop supporting GHC 7.4 to 7.8 0.3.17, released 2018-03-09 Improve the display of errors, less internal callstack Add a few missing Partial constraints 0.3.16, released 2018-01-06 #22, add Safe index 0.3.15, released 2017-06-18 Support QuickCheck 2.10 0.3.14, released 2017-02-15 #20, fix for GHC 7.10.1 0.3.13, released 2017-02-09 #20, require GHC 7.4 or above 0.3.12, released 2017-02-05 #19, add Safe.Partial exposing a Partial typeclass #19, add support for GHC call stacks 0.3.11, released 2017-01-22 #16, add Safe succ and pred #16, add readEitherSafe for better errors than readEither #14, add Safe zip3Exact 0.3.10, released 2016-11-08 #15, add Safe cycle 0.3.9, released 2015-05-09 #9, add Safe toEnum 0.3.8, released 2014-08-10 #8, remove unnecessary Ord constraints from Foldable functions 0.3.7, released 2014-07-16 Add Def variants of the Exact functions 0.3.6, released 2014-07-12 #6, remove unnecessary Ord constraints from maximumBy/minimumBy 0.3.5, released 2014-06-28 Add Safe elemIndexJust/findIndexJust functions Add Safe scan functions Add Safe minimumBy/maximumBy functions Add a module of Exact functions Add Foldable minimum functions Clean up the Foldable module, deprecate the Safe variants 0.3.4, released 2014-01-30 #1, improve the string clipping in readNote 0.3.3, released 2011-11-15 #494, add foldl1' wrappings 0.3.2, released 2011-11-13 Add a Safe.Foldable module 0.3.1, released 2011-11-09 Add findJust, safe wrapping of fromJust/find 0.3, released 2010-11-10 Start of changelog safe-0.3.19/Safe/0000755000000000000000000000000013662553443011601 5ustar0000000000000000safe-0.3.19/Safe/Util.hs0000644000000000000000000000270613250476574013061 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} -- | Internal utilities. module Safe.Util( fromNoteModule, fromNoteEitherModule, liftMay, (.^), (.^^), (.^^^), eitherToMaybe, withFrozenCallStack ) where import Data.Maybe import Safe.Partial -- Let things work through ghci alone #if __GLASGOW_HASKELL__ >= 800 import GHC.Stack #else withFrozenCallStack :: a -> a withFrozenCallStack = id #endif (.^) :: Partial => (b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c (.^) f g x1 x2 = f (g x1 x2) (.^^) :: Partial => (b -> c) -> (a1 -> a2 -> a3 -> b) -> a1 -> a2 -> a3 -> c (.^^) f g x1 x2 x3 = f (g x1 x2 x3) (.^^^) :: Partial => (b -> c) -> (a1 -> a2 -> a3 -> a4 -> b) -> a1 -> a2 -> a3 -> a4 -> c (.^^^) f g x1 x2 x3 x4 = f (g x1 x2 x3 x4) liftMay :: (a -> Bool) -> (a -> b) -> (a -> Maybe b) liftMay test func val = if test val then Nothing else Just $ func val fromNoteModule :: Partial => String -> String -> String -> Maybe a -> a fromNoteModule modu note func = fromMaybe (error msg) where msg = modu ++ "." ++ func ++ (if null note then "" else ", " ++ note) fromNoteEitherModule :: Partial => String -> String -> String -> Either String a -> a fromNoteEitherModule modu note func = either (error . msg) id where msg ex = modu ++ "." ++ func ++ " " ++ ex ++ (if null note then "" else ", " ++ note) eitherToMaybe :: Either a b -> Maybe b eitherToMaybe = either (const Nothing) Just safe-0.3.19/Safe/Partial.hs0000644000000000000000000000221013051042373013507 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ImplicitParams #-} -- | ConstraintKind synonym for marking partial functions module Safe.Partial(Partial) where -- Let things work through ghci alone #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif -- GHC has changed its opinion on the location a few times -- v0: GHC 7.4.1, has ConstraintKinds -- v1: GHC 7.10.2, base 4.8.1.0 = CallStack -- v2: GHC 8.0.1, base 4.9.0.0 = HasCallStack #if __GLASGOW_HASKELL__ >= 800 #define OPTION 2 #elif __GLASGOW_HASKELL__ >= 710 && MIN_VERSION_base(4,8,1) #define OPTION 1 #else #define OPTION 0 #endif #if OPTION == 0 import GHC.Exts #else import GHC.Stack #endif -- | A constraint synonym which denotes that the function is partial, and will -- (on GHC 8.* and up) produce a stack trace on failure. -- You may mark your own non-total functions as Partial, if necessary, and this -- will ensure that they produce useful stack traces. #if OPTION == 0 type Partial = (() :: Constraint) #elif OPTION == 1 type Partial = (?loc :: CallStack) #else type Partial = HasCallStack #endif safe-0.3.19/Safe/Foldable.hs0000644000000000000000000001305313662552310013637 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} {- | 'Foldable' functions, with wrappers like the "Safe" module. -} module Safe.Foldable( -- * New functions findJust, -- * Safe wrappers foldl1May, foldl1Def, foldl1Note, foldr1May, foldr1Def, foldr1Note, findJustDef, findJustNote, minimumMay, minimumNote, maximumMay, maximumNote, minimumByMay, minimumByNote, maximumByMay, maximumByNote, maximumBoundBy, minimumBoundBy, maximumBounded, maximumBound, minimumBounded, minimumBound, -- * Discouraged minimumDef, maximumDef, minimumByDef, maximumByDef, -- * Deprecated foldl1Safe, foldr1Safe, findJustSafe, ) where import Safe.Util import Data.Foldable as F import Data.Maybe import Data.Monoid import Prelude import Safe.Partial --------------------------------------------------------------------- -- UTILITIES fromNote :: Partial => String -> String -> Maybe a -> a fromNote = fromNoteModule "Safe.Foldable" --------------------------------------------------------------------- -- WRAPPERS foldl1May, foldr1May :: Foldable t => (a -> a -> a) -> t a -> Maybe a foldl1May = liftMay F.null . F.foldl1 foldr1May = liftMay F.null . F.foldr1 foldl1Note, foldr1Note :: (Partial, Foldable t) => String -> (a -> a -> a) -> t a -> a foldl1Note note f x = withFrozenCallStack $ fromNote note "foldl1Note on empty" $ foldl1May f x foldr1Note note f x = withFrozenCallStack $ fromNote note "foldr1Note on empty" $ foldr1May f x minimumMay, maximumMay :: (Foldable t, Ord a) => t a -> Maybe a minimumMay = liftMay F.null F.minimum maximumMay = liftMay F.null F.maximum minimumNote, maximumNote :: (Partial, Foldable t, Ord a) => String -> t a -> a minimumNote note x = withFrozenCallStack $ fromNote note "minimumNote on empty" $ minimumMay x maximumNote note x = withFrozenCallStack $ fromNote note "maximumNote on empty" $ maximumMay x minimumByMay, maximumByMay :: Foldable t => (a -> a -> Ordering) -> t a -> Maybe a minimumByMay = liftMay F.null . F.minimumBy maximumByMay = liftMay F.null . F.maximumBy minimumByNote, maximumByNote :: (Partial, Foldable t) => String -> (a -> a -> Ordering) -> t a -> a minimumByNote note f x = withFrozenCallStack $ fromNote note "minimumByNote on empty" $ minimumByMay f x maximumByNote note f x = withFrozenCallStack $ fromNote note "maximumByNote on empty" $ maximumByMay f x -- | The largest element of a foldable structure with respect to the -- given comparison function. The result is bounded by the value given as the first argument. maximumBoundBy :: Foldable f => a -> (a -> a -> Ordering) -> f a -> a maximumBoundBy x f xs = maximumBy f $ x : toList xs -- | The smallest element of a foldable structure with respect to the -- given comparison function. The result is bounded by the value given as the first argument. minimumBoundBy :: Foldable f => a -> (a -> a -> Ordering) -> f a -> a minimumBoundBy x f xs = minimumBy f $ x : toList xs -- | The largest element of a foldable structure. -- The result is bounded by the value given as the first argument. maximumBound :: (Foldable f, Ord a) => a -> f a -> a maximumBound x xs = maximum $ x : toList xs -- | The smallest element of a foldable structure. -- The result is bounded by the value given as the first argument. minimumBound :: (Foldable f, Ord a) => a -> f a -> a minimumBound x xs = minimum $ x : toList xs -- | The largest element of a foldable structure. -- The result is bounded by 'minBound'. maximumBounded :: (Foldable f, Ord a, Bounded a) => f a -> a maximumBounded = maximumBound minBound -- | The largest element of a foldable structure. -- The result is bounded by 'maxBound'. minimumBounded :: (Foldable f, Ord a, Bounded a) => f a -> a minimumBounded = minimumBound maxBound -- | -- > findJust op = fromJust . find op findJust :: (Partial, Foldable t) => (a -> Bool) -> t a -> a findJust f x = withFrozenCallStack $ fromNote "" "findJust, no matching value" $ F.find f x findJustDef :: Foldable t => a -> (a -> Bool) -> t a -> a findJustDef def = fromMaybe def .^ F.find findJustNote :: (Partial, Foldable t) => String -> (a -> Bool) -> t a -> a findJustNote note f x = withFrozenCallStack $ fromNote note "findJustNote, no matching value" $ F.find f x --------------------------------------------------------------------- -- DISCOURAGED -- | New users are recommended to use 'minimumBound' or 'maximumBound' instead. minimumDef, maximumDef :: (Foldable t, Ord a) => a -> t a -> a minimumDef def = fromMaybe def . minimumMay maximumDef def = fromMaybe def . maximumMay -- | New users are recommended to use 'minimumBoundBy' or 'maximumBoundBy' instead. minimumByDef, maximumByDef :: Foldable t => a -> (a -> a -> Ordering) -> t a -> a minimumByDef def = fromMaybe def .^ minimumByMay maximumByDef def = fromMaybe def .^ maximumByMay -- | New users are recommended to use 'foldr1May' or 'foldl1May' instead. foldl1Def, foldr1Def :: Foldable t => a -> (a -> a -> a) -> t a -> a foldl1Def def = fromMaybe def .^ foldl1May foldr1Def def = fromMaybe def .^ foldr1May --------------------------------------------------------------------- -- DEPRECATED {-# DEPRECATED foldl1Safe "Use @foldl f mempty@ instead." #-} foldl1Safe :: (Monoid m, Foldable t) => (m -> m -> m) -> t m -> m foldl1Safe fun = F.foldl fun mempty {-# DEPRECATED foldr1Safe "Use @foldr f mempty@ instead." #-} foldr1Safe :: (Monoid m, Foldable t) => (m -> m -> m) -> t m -> m foldr1Safe fun = F.foldr fun mempty {-# DEPRECATED findJustSafe "Use @findJustDef mempty@ instead." #-} findJustSafe :: (Monoid m, Foldable t) => (m -> Bool) -> t m -> m findJustSafe = findJustDef mempty safe-0.3.19/Safe/Exact.hs0000644000000000000000000002047213306561613013177 0ustar0000000000000000{-# 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 (flip const) 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 (flip const) i xs dropExactMay :: Int -> [a] -> Maybe [a] dropExactMay = splitAtExact_ (const Nothing) Just (flip const) 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