safe-0.3: Safe.hs

{- |
Module      :  Safe
Copyright   :  (c) Neil Mitchell 2007-2010
License     :  BSD3

Maintainer  :  http://community.haskell.org/~ndm/safe
Stability   :  in-progress
Portability :  portable

A library for safe functions, based on standard functions that may crash.
For more details see <http://community.haskell.org/~ndm/safe/>

In general, each unsafe function has up to 4 forms.
Since 'tail' has all the possible forms, it is fully documented.
The others all follow the same pattern.


* @Note@, takes an extra argument which supplements the error message, 'tailNote'

* @Def@, take an extra argument to give when a crash would otherwise happen, 'tailDef'

* @May@, wraps the result in a Maybe, 'tailMay'

* @Safe@, returns a default type if possible, 'tailSafe'

This library also introduces three brand new functions:

* 'at' - synonym for @(!!)@

* 'lookupJust' - defined as @lookupJust k = fromJust . lookup k@

* 'abort' - same as @error@, but different intended meaning

-}

module Safe(
    tailDef, tailMay, tailNote, tailSafe,
    initDef, initMay, initNote, initSafe,
    headDef, headMay, headNote,
    lastDef, lastMay, lastNote,
    minimumDef, minimumMay, minimumNote,
    maximumDef, maximumMay, maximumNote,
    foldr1Def, foldr1May, foldr1Note,
    foldl1Def, foldl1May, foldl1Note,
    fromJustDef, fromJustNote,
    assertNote,
    at, atDef, atMay, atNote,
    readDef, readMay, readNote,
    lookupJust, lookupJustDef, lookupJustNote,
    abort
    ) where


import Data.Maybe


liftDef :: (a -> b) -> (a -> Bool) -> b -> (a -> b)
liftDef func test def val = if test val then def else func val

liftMay :: (a -> b) -> (a -> Bool) -> (a -> Maybe b)
liftMay func test val = if test val then Nothing else Just $ func val

liftNote :: (a -> b) -> (a -> Bool) -> String -> String -> (a -> b)
liftNote func test caller note val =
    if test val
    then error $ "Pattern match failure, " ++ caller ++ ", " ++ note
    else func val

liftSafe :: (a -> a) -> (a -> Bool) -> (a -> a)
liftSafe func test val = if test val then val else func val


-- |
-- > tailDef [12] [] = [12]
-- > tailDef [12] [1,3,4] = [3,4]
tailDef  :: [a] -> [a] -> [a]
tailDef  = liftDef  tail null

-- |
-- > tailMay [] = Nothing
-- > tailMay [1,3,4] = Just [3,4]
tailMay  :: [a] -> Maybe [a]
tailMay  = liftMay  tail null

-- |
-- > tail "help me" [] = error "Pattern match failure, tail [], help me"
-- > tail "help me" [1,3,4] = [3,4]
tailNote :: String -> [a] -> [a]
tailNote = liftNote tail null "tail []"

-- |
-- > tailSafe [] = []
-- > tailSafe [1,3,4] = [3,4]
tailSafe :: [a] -> [a]
tailSafe = liftSafe tail null


initDef  :: [a] -> [a] -> [a]
initDef  = liftDef  init null

initMay  :: [a] -> Maybe [a]
initMay  = liftMay  init null

initNote :: String -> [a] -> [a]
initNote = liftNote init null "init []"

initSafe :: [a] -> [a]
initSafe = liftSafe init null



headDef  :: a -> [a] -> a
headDef  = liftDef  head null

headMay  :: [a] -> Maybe a
headMay  = liftMay  head null

headNote :: String -> [a] -> a
headNote = liftNote head null "head []"


lastDef  :: a -> [a] -> a
lastDef  = liftDef  last null

lastMay  :: [a] -> Maybe a
lastMay  = liftMay  last null

lastNote :: String -> [a] -> a
lastNote = liftNote last null "last []"



minimumDef  :: Ord a => a -> [a] -> a
minimumDef  = liftDef  minimum null

minimumMay  :: Ord a => [a] -> Maybe a
minimumMay  = liftMay  minimum null

minimumNote :: Ord a => String -> [a] -> a
minimumNote = liftNote minimum null "minimum []"


maximumDef  :: Ord a => a -> [a] -> a
maximumDef  = liftDef  maximum null

maximumMay  :: Ord a => [a] -> Maybe a
maximumMay  = liftMay  maximum null

maximumNote :: Ord a => String -> [a] -> a
maximumNote = liftNote maximum null "maximum []"



foldr1Def  :: a -> (a -> a -> a) -> [a] -> a
foldr1Def def f = liftDef (foldr1 f) null def

foldr1May  :: (a -> a -> a) -> [a] -> Maybe a
foldr1May f = liftMay (foldr1 f) null

foldr1Note :: String -> (a -> a -> a) -> [a] -> a
foldr1Note note f = liftNote (foldr1 f) null "foldr1 []" note


foldl1Def  :: a -> (a -> a -> a) -> [a] -> a
foldl1Def def f = liftDef (foldl1 f) null def

foldl1May  :: (a -> a -> a) -> [a] -> Maybe a
foldl1May f = liftMay (foldl1 f) null

foldl1Note :: String -> (a -> a -> a) -> [a] -> a
foldl1Note note f = liftNote (foldl1 f) null "foldl1 []" note


-- | See fromMaybe
fromJustDef :: a -> Maybe a -> a
fromJustDef  = liftDef fromJust isNothing

fromJustNote :: String -> Maybe a -> a
fromJustNote = liftNote fromJust isNothing "fromJust Nothing"



assertNote :: String -> Bool -> a -> a
assertNote msg False val = error $ "assertion failed, " ++ msg
assertNote msg True  val = val



-- | Same as @(!!)@, but better error message
at :: [a] -> Int -> a
at = atNote "called by at"

atDef :: a -> [a] -> Int -> a
atDef def x n = fromMaybe def (atMay x n)

atMay :: [a] -> Int -> Maybe a
atMay xs n | n < 0 = Nothing
atMay [] _ = Nothing
atMay (x:_) 0 = Just x
atMay (_:xs) n = atMay xs (n-1)

atNote :: String -> [a] -> Int -> a
atNote msg _ n | n < 0 = error $ "Safe.at: negative index, " ++ msg
atNote msg xs n = f xs n
    where
        f [] i = error $ "Safe.at: index too large, index=" ++ show n ++ ", length=" ++ show (n-i) ++ ", " ++ msg
        f (x:_) 0 = x
        f (_:xs) i = f xs (i-1)



readDef :: Read a => a -> String -> a
readDef def s = fromMaybe def (readMay s)

readMay :: Read a => String -> Maybe a
readMay s = case [x | (x,t) <- reads s, ("","") <- lex t] of
                [x] -> Just x
                _ -> Nothing

readNote :: Read a => String -> String -> a
readNote msg s = case [x | (x,t) <- reads s, ("","") <- lex t] of
                     [x] -> x
                     []  -> error $ "Prelude.read: no parse, " ++ msg ++ ", on " ++ prefix
                     _   -> error $ "Prelude.read: ambiguous parse, " ++ msg ++ ", on " ++ prefix
    where
        prefix = '\"' : a ++ if null b then "\"" else "..."
            where (a,b) = splitAt 10 s


-- |
-- > lookupJust key = fromJust . lookup key
lookupJust :: Eq a => a -> [(a,b)] -> b
lookupJust key = fromJustNote "lookupJust, item not found" . lookup key

lookupJustDef :: Eq a => b -> a -> [(a,b)] -> b
lookupJustDef def key lst = fromMaybe def (lookup key lst)

lookupJustNote :: Eq a => String -> a -> [(a,b)] -> b
lookupJustNote msg key lst = case lookup key lst of
                                 Nothing -> error $ "Safe.lookupJust: element not found, " ++ msg
                                 Just x -> x



-- | Exactly the same as @error@. Use this for instances where the program
--   has decided to exit because of invalid user input, or the user pressed
--   quit etc. This allows @error@ to be reserved for genuine coding mistakes.
abort :: String -> a
abort = error