Real World Haskell Chapter 19. Error handling Exercises

ParseInt.hs

-- file: ch19/ParseInt.hs
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Data.Char
import Control.Monad
import Control.Monad.Error
import Control.Monad.State
import qualified Data.ByteString.Char8 as B

data ParseError = NumericOverflow
                | EndOfInput
                | Chatty String
                  deriving (Eq, Ord, Show)

instance Error ParseError where
    noMsg  = Chatty "oh noes!"
    strMsg = Chatty

newtype Parser a = P {
      runP :: ErrorT ParseError (State B.ByteString) a
    } deriving (Monad, MonadError ParseError)

liftP :: State B.ByteString a -> Parser a
liftP m = P (lift m)

satisfy :: (Char -> Bool) -> Parser Char
satisfy p = do
  s <- liftP get
  case B.uncons s of
    Nothing         -> throwError EndOfInput
    Just (c, s')
        | p c       -> liftP (put s') >> return c
        | otherwise -> throwError (Chatty "satisfy failed")

optional :: Parser a -> Parser (Maybe a)
optional p = (Just `liftM` p) `catchError` \_ -> return Nothing

runParser :: Parser a -> B.ByteString
          -> Either ParseError (a, B.ByteString)
runParser p bs = case runState (runErrorT (runP p)) bs of
                   (Left err, _) -> Left err
                   (Right r, bs) -> Right (r, bs)

many :: Parser a -> Parser [a]
many p = liftM2 (:) p (many p `catchError` \_ -> return [])

int :: Parser Int
int = do
  s <- optional $ satisfy (== '-')
  num <- read `liftM` many (satisfy isDigit) :: Parser Integer
  let sign = maybe 1 (const (-1)) s
      min = fromIntegral (minBound :: Int)
      max = fromIntegral (maxBound :: Int)
      check n
          | n < min || n > max
            = throwError NumericOverflow
          | otherwise = return $ fromIntegral $ sign * n
  check num