module Data.Attempt.Helper
(
join
, KeyNotFound (..)
, EmptyList (..)
, CouldNotRead (..)
, NegativeIndex (..)
, lookup
, tail
, init
, head
, last
, read
, at
, assert
, readFile
) where
import Prelude hiding (lookup, tail, init, head, last, read, readFile)
import qualified Prelude
import Data.Attempt
import Control.Monad.Attempt.Class
import Data.Generics
import qualified Control.Exception as E
import Control.Monad (liftM)
import Control.Monad.Trans
join :: (FromAttempt m, Monad m) => m (Attempt v) -> m v
join = (>>= fromAttempt)
data KeyNotFound k v = KeyNotFound k [(k, v)]
deriving Typeable
instance Show k => Show (KeyNotFound k v) where
show (KeyNotFound key _) = "Could not find requested key: " ++ show key
instance (Typeable k, Typeable v, Show k) => E.Exception (KeyNotFound k v)
lookup :: (Typeable k, Typeable v, Show k, Eq k, MonadAttempt m)
=> k
-> [(k, v)]
-> m v
lookup k m = maybe (failure $ KeyNotFound k m) return $ Prelude.lookup k m
data EmptyList = EmptyList
deriving (Show, Typeable)
instance E.Exception EmptyList
tail :: MonadAttempt m => [a] -> m [a]
tail [] = failure EmptyList
tail (_:rest) = return rest
init :: MonadAttempt m => [a] -> m [a]
init [] = failure EmptyList
init x = return $ Prelude.init x
head :: MonadAttempt m => [a] -> m a
head [] = failure EmptyList
head (x:_) = return x
last :: MonadAttempt m => [a] -> m a
last [] = failure EmptyList
last x = return $ Prelude.last x
newtype CouldNotRead = CouldNotRead String
deriving (Typeable, Show)
instance E.Exception CouldNotRead
read :: (MonadAttempt m, Read a) => String -> m a
read s = case [x | (x,t) <- reads s, ("","") <- lex t] of
[x] -> return x
_ -> failure $ CouldNotRead s
data NegativeIndex = NegativeIndex
deriving (Typeable, Show)
instance E.Exception NegativeIndex
data OutOfBoundsIndex = OutOfBoundsIndex
deriving (Typeable, Show)
instance E.Exception OutOfBoundsIndex
at :: MonadAttempt m => [a] -> Int -> m a
at [] _ = failure OutOfBoundsIndex
at (x:_) 0 = return x
at (_:xs) n
| n < 0 = failure NegativeIndex
| otherwise = at xs $ n 1
assert :: (MonadAttempt m, E.Exception e)
=> Bool
-> v
-> e
-> m v
assert b v e = if b then return v else failure e
readFile :: (MonadAttempt m, MonadIO m) => FilePath -> m String
readFile fp = do
contents <- liftIO $ E.handle
(\e -> return $ Left (e :: E.IOException))
(liftM Right $ Prelude.readFile fp)
case contents of
Left e -> failure e
Right v -> return v