Distribution/ReadE.hs

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Distribution.ReadE
    -- Copyright   :  Jose Iborra 2008
    -- License     :  BSD3
    --
    -- Maintainer  :  cabal-devel@haskell.org
    -- Portability :  portable
    --
    -- Simple parsing with failure

    module Distribution.ReadE (
       -- * ReadE
       ReadE(..), succeedReadE, failReadE,
       -- * Projections
       parseReadE, readEOrFail,
       readP_to_E,
       parsecToReadE,
      ) where

    import Prelude ()
    import Distribution.Compat.Prelude

    import Distribution.Compat.ReadP
    import qualified Distribution.Compat.Parsec as P

    -- | Parser with simple error reporting
    newtype ReadE a = ReadE {runReadE :: String -> Either ErrorMsg a}
    type ErrorMsg   = String

    instance Functor ReadE where
      fmap f (ReadE p) = ReadE $ \txt -> case p txt of
                                           Right a  -> Right (f a)
                                           Left err -> Left err

    succeedReadE :: (String -> a) -> ReadE a
    succeedReadE f = ReadE (Right . f)

    failReadE :: ErrorMsg -> ReadE a
    failReadE = ReadE . const . Left

    parseReadE :: ReadE a -> ReadP r a
    parseReadE (ReadE p) = do
      txt <- look
      either fail return (p txt)

    readEOrFail :: ReadE a -> String -> a
    readEOrFail r = either error id . runReadE r

    -- {-# DEPRECATED readP_to_E "Use parsecToReadE" #-}
    readP_to_E :: (String -> ErrorMsg) -> ReadP a a -> ReadE a
    readP_to_E err r =
        ReadE $ \txt -> case [ p | (p, s) <- readP_to_S r txt
                             , all isSpace s ]
                        of [] -> Left (err txt)
                           (p:_) -> Right p

    parsecToReadE :: (String -> ErrorMsg) -> P.Parsec String [w] a -> ReadE a
    parsecToReadE err p = ReadE $ \txt ->
        case P.runParser (p <* P.spaces <* P.eof) [] "<parsecToReadE>" txt of
            Right x -> Right x
            Left _e -> Left (err txt)
    -- TODO: use parsec error to make 'ErrorMsg'.