Improve the display of errors, less internal callstack

CHANGES.txt

@@ -1,5 +1,6 @@
 Changelog for Safe
 
+    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

Safe.hs

@@ -75,7 +75,7 @@ fromNoteEither = fromNoteEitherModule "Safe"
 --   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 = error
+abort x = withFrozenCallStack (error x)
 
 
 at_ :: [a] -> Int -> Either String a
@@ -105,7 +105,7 @@ 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 = fromNote note "tailNote []" . tailMay
+tailNote note x = withFrozenCallStack $ fromNote note "tailNote []" $ tailMay x
 
 -- |
 -- > tailSafe [] = []
@@ -121,7 +121,7 @@ initDef :: [a] -> [a] -> [a]
 initDef def = fromMaybe def . initMay
 
 initNote :: Partial => String -> [a] -> [a]
-initNote note = fromNote note "initNote []" . initMay
+initNote note x = withFrozenCallStack $ fromNote note "initNote []" $ initMay x
 
 initSafe :: [a] -> [a]
 initSafe = initDef []
@@ -137,8 +137,8 @@ headDef def = fromMaybe def . headMay
 lastDef def = fromMaybe def . lastMay
 
 headNote, lastNote :: Partial => String -> [a] -> a
-headNote note = fromNote note "headNote []" . headMay
-lastNote note = fromNote note "lastNote []" . lastMay
+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
@@ -149,8 +149,8 @@ minimumDef def = fromMaybe def . minimumMay
 maximumDef def = fromMaybe def . maximumMay
 
 minimumNote, maximumNote :: (Partial, Ord a) => String -> [a] -> a
-minimumNote note = fromNote note "minumumNote []" . minimumMay
-maximumNote note = fromNote note "maximumNote []" . maximumMay
+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
@@ -161,8 +161,8 @@ minimumByDef def = fromMaybe def .^ minimumByMay
 maximumByDef def = fromMaybe def .^ maximumByMay
 
 minimumByNote, maximumByNote :: Partial => String -> (a -> a -> Ordering) -> [a] -> a
-minimumByNote note = fromNote note "minumumByNote []" .^ minimumByMay
-maximumByNote note = fromNote note "maximumByNote []" .^ maximumByMay
+minimumByNote note f x = withFrozenCallStack $ fromNote note "minumumByNote []" $ minimumByMay f x
+maximumByNote note f x = withFrozenCallStack $ fromNote note "maximumByNote []" $ maximumByMay f x
 
 
 foldr1May, foldl1May, foldl1May' :: (a -> a -> a) -> [a] -> Maybe a
@@ -176,9 +176,9 @@ foldl1Def def = fromMaybe def .^ foldl1May
 foldl1Def' def = fromMaybe def .^ foldl1May'
 
 foldr1Note, foldl1Note, foldl1Note' :: Partial => String -> (a -> a -> a) -> [a] -> a
-foldr1Note note = fromNote note "foldr1Note []" .^ foldr1May
-foldl1Note note = fromNote note "foldl1Note []" .^ foldl1May
-foldl1Note' note = fromNote note "foldl1Note []" .^ foldl1May'
+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
@@ -189,8 +189,8 @@ scanr1Def def = fromMaybe def .^ scanr1May
 scanl1Def def = fromMaybe def .^ scanl1May
 
 scanr1Note, scanl1Note :: Partial => String -> (a -> a -> a) -> [a] -> [a]
-scanr1Note note = fromNote note "scanr1Note []" .^ scanr1May
-scanl1Note note = fromNote note "scanl1Note []" .^ scanl1May
+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
@@ -199,19 +199,19 @@ cycleDef :: [a] -> [a] -> [a]
 cycleDef def = fromMaybe def . cycleMay
 
 cycleNote :: Partial => String -> [a] -> [a]
-cycleNote note = fromNote note "cycleNote []" . cycleMay
+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 = fromNote note "fromJustNote Nothing"
+fromJustNote note x = withFrozenCallStack $ fromNote note "fromJustNote Nothing" x
 
 assertNote :: Partial => String -> Bool -> a -> a
 assertNote note True val = val
-assertNote note False val = fromNote note "assertNote False" Nothing
+assertNote note False val = withFrozenCallStack $ fromNote note "assertNote False" Nothing
 
 
 -- | Synonym for '!!', but includes more information in the error message.
@@ -225,7 +225,7 @@ atDef :: a -> [a] -> Int -> a
 atDef def = fromMaybe def .^ atMay
 
 atNote :: Partial => String -> [a] -> Int -> a
-atNote note = fromNoteEither note "atNote" .^ at_
+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
@@ -246,18 +246,18 @@ readDef def = fromMaybe def . readMay
 
 -- | 'readNote' uses 'readEitherSafe' for the error message.
 readNote :: (Partial, Read a) => String -> String -> a
-readNote note = fromNoteEither note "readNote" . readEitherSafe
+readNote note x = withFrozenCallStack $ fromNoteEither note "readNote" $ readEitherSafe x
 
 -- |
 -- > lookupJust key = fromJust . lookup key
 lookupJust :: (Eq a, Partial) => a -> [(a,b)] -> b
-lookupJust = fromNote "" "lookupJust, no matching value" .^ lookup
+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 = fromNote note "lookupJustNote, no matching value" .^ lookup
+lookupJustNote note x xs = withFrozenCallStack $ fromNote note "lookupJustNote, no matching value" $ lookup x xs
 
 -- |
 -- > findJust op = fromJust . find op
@@ -268,29 +268,29 @@ findJustDef :: a -> (a -> Bool) -> [a] -> a
 findJustDef def = fromMaybe def .^ find
 
 findJustNote :: Partial => String -> (a -> Bool) -> [a] -> a
-findJustNote note = fromNote note "findJustNote, no matching value" .^ find
+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 = fromNote "" "elemIndexJust, no matching value" .^ elemIndex
+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 = fromNote note "elemIndexJustNote, no matching value" .^ elemIndex
+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 = fromNote "" "findIndexJust, no matching value" .^ findIndex
+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 = fromNote note "findIndexJustNote, no matching value" .^ findIndex
+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
@@ -307,7 +307,7 @@ toEnumDef :: (Enum a, Bounded a) => a -> Int -> a
 toEnumDef def = fromMaybe def . toEnumMay
 
 toEnumNote :: (Partial, Enum a, Bounded a) => String -> Int -> a
-toEnumNote note = fromNote note "toEnumNote, out of range" . toEnumMay
+toEnumNote note x = withFrozenCallStack $ fromNote note "toEnumNote, out of range" $ toEnumMay x
 
 toEnumSafe :: (Enum a, Bounded a) => Int -> a
 toEnumSafe = toEnumDef minBound
@@ -319,7 +319,7 @@ 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 = fromNote note "succNote, out of range" . succMay
+succNote note x = withFrozenCallStack $ fromNote note "succNote, out of range" $ succMay x
 
 succSafe :: (Enum a, Eq a, Bounded a) => a -> a
 succSafe = succDef maxBound
@@ -331,7 +331,7 @@ 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 = fromNote note "predNote, out of range" . predMay
+predNote note x = withFrozenCallStack $ fromNote note "predNote, out of range" $ predMay x
 
 predSafe :: (Enum a, Eq a, Bounded a) => a -> a
 predSafe = predDef minBound
@@ -343,4 +343,4 @@ 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 b = fromNote note "indexNote, out of range" . indexMay b
+indexNote note x y = withFrozenCallStack $ fromNote note "indexNote, out of range" $ indexMay x y

Safe/Exact.hs

@@ -88,25 +88,25 @@ zipWith3Exact_ err nil cons = f
 -- >   | n >= 0 && n <= length xs = take n xs
 -- >   | otherwise                = error "some message"
 takeExact :: Partial => Int -> [a] -> [a]
-takeExact = splitAtExact_ (addNote "" "takeExact") (const []) (:)
+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 = splitAtExact_ (addNote "" "dropExact") id (flip const)
+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 = splitAtExact_ (addNote "" "splitAtExact")
-    (\x -> ([], x)) (\a b -> first (a:) b)
+splitAtExact i xs = withFrozenCallStack $ splitAtExact_ (addNote "" "splitAtExact")
+    (\x -> ([], x)) (\a b -> first (a:) b) i xs
 
 takeExactNote :: Partial => String -> Int -> [a] -> [a]
-takeExactNote note = splitAtExact_ (addNote note "takeExactNote") (const []) (:)
+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:))
@@ -115,7 +115,7 @@ takeExactDef :: [a] -> Int -> [a] -> [a]
 takeExactDef def = fromMaybe def .^ takeExactMay
 
 dropExactNote :: Partial => String -> Int -> [a] -> [a]
-dropExactNote note = splitAtExact_ (addNote note "dropExactNote") id (flip const)
+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)
@@ -124,8 +124,8 @@ dropExactDef :: [a] -> Int -> [a] -> [a]
 dropExactDef def = fromMaybe def .^ dropExactMay
 
 splitAtExactNote :: Partial => String -> Int -> [a] -> ([a], [a])
-splitAtExactNote note = splitAtExact_ (addNote note "splitAtExactNote")
-    (\x -> ([], x)) (\a b -> first (a:) b)
+splitAtExactNote note i xs = withFrozenCallStack $ splitAtExact_ (addNote note "splitAtExactNote")
+    (\x -> ([], x)) (\a b -> first (a:) b) i xs
 
 splitAtExactMay :: Int -> [a] -> Maybe ([a], [a])
 splitAtExactMay = splitAtExact_ (const Nothing)
@@ -142,18 +142,18 @@ splitAtExactDef def = fromMaybe def .^ splitAtExactMay
 -- >   | length xs == length ys = zip xs ys
 -- >   | otherwise              = error "some message"
 zipExact :: Partial => [a] -> [b] -> [(a,b)]
-zipExact = zipWithExact_ (addNote "" "zipExact") []  (\a b xs -> (a,b) : xs)
+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 = zipWithExact_ (addNote "" "zipWithExact") [] (\a b xs -> f a b : xs)
+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 = zipWithExact_ (addNote note "zipExactNote") []  (\a b xs -> (a,b) : xs)
+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)
@@ -162,7 +162,7 @@ zipExactDef :: [(a,b)] -> [a] -> [b] -> [(a,b)]
 zipExactDef def = fromMaybe def .^ zipExactMay
 
 zipWithExactNote :: Partial => String -> (a -> b -> c) -> [a] -> [b] -> [c]
-zipWithExactNote note f = zipWithExact_ (addNote note "zipWithExactNote") []  (\a b xs -> f a b : xs)
+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)
@@ -176,18 +176,18 @@ zipWithExactDef def = fromMaybe def .^^ zipWithExactMay
 -- >   | 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 = zipWith3Exact_ (addNote "" "zip3Exact") [] (\a b c xs -> (a, b, c) : xs)
+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 = zipWith3Exact_ (addNote "" "zipWith3Exact") [] (\a b c xs -> f a b c : xs)
+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 = zipWith3Exact_ (addNote note "zip3ExactNote") [] (\a b c xs -> (a,b,c) : xs)
+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)
@@ -196,7 +196,7 @@ 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 = zipWith3Exact_ (addNote note "zipWith3ExactNote") []  (\a b c xs -> f a b c : xs)
+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)

Safe/Foldable.hs

@@ -48,8 +48,8 @@ foldl1May = liftMay isNull . F.foldl1
 foldr1May = liftMay isNull . F.foldr1
 
 foldl1Note, foldr1Note :: (Partial, Foldable t) => String -> (a -> a -> a) -> t a -> a
-foldl1Note note = fromNote note "foldl1Note on empty" .^ foldl1May
-foldr1Note note = fromNote note "foldr1Note on empty" .^ foldr1May
+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
 
 foldl1Def, foldr1Def :: Foldable t => a -> (a -> a -> a) -> t a -> a
 foldl1Def def = fromMaybe def .^ foldl1May
@@ -64,8 +64,8 @@ minimumDef def = fromMaybe def . minimumMay
 maximumDef def = fromMaybe def . maximumMay
 
 minimumNote, maximumNote :: (Partial, Foldable t, Ord a) => String -> t a -> a
-minimumNote note = fromNote note "minimumNote on empty" . minimumMay
-maximumNote note = fromNote note "maximumNote on empty" . maximumMay
+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 isNull . F.minimumBy
@@ -76,19 +76,19 @@ minimumByDef def = fromMaybe def .^ minimumByMay
 maximumByDef def = fromMaybe def .^ maximumByMay
 
 minimumByNote, maximumByNote :: (Partial, Foldable t) => String -> (a -> a -> Ordering) -> t a -> a
-minimumByNote note = fromNote note "minimumByNote on empty" .^ minimumByMay
-maximumByNote note = fromNote note "maximumByNote on empty" .^ maximumByMay
+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
 
 -- |
 -- > findJust op = fromJust . find op
 findJust :: (Partial, Foldable t) => (a -> Bool) -> t a -> a
-findJust = fromNote "" "findJust, no matching value" .^ F.find
+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 = fromNote note "findJustNote, no matching value" .^ F.find
+findJustNote note f x = withFrozenCallStack $ fromNote note "findJustNote, no matching value" $ F.find f x
 
 
 ---------------------------------------------------------------------