-----------------------------------------------------------------------------
-- |
-- 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
   readEOrFail,
   parsecToReadE,
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Parsec
import Distribution.Parsec.FieldLineStream

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

instance Functor ReadE where
  fmap :: forall a b. (a -> b) -> ReadE a -> ReadE b
fmap a -> b
f (ReadE String -> Either String a
p) = (String -> Either String b) -> ReadE b
forall a. (String -> Either String a) -> ReadE a
ReadE ((String -> Either String b) -> ReadE b)
-> (String -> Either String b) -> ReadE b
forall a b. (a -> b) -> a -> b
$ \String
txt -> case String -> Either String a
p String
txt of
                                       Right a
a  -> b -> Either String b
forall a b. b -> Either a b
Right (a -> b
f a
a)
                                       Left String
err -> String -> Either String b
forall a b. a -> Either a b
Left String
err

succeedReadE :: (String -> a) -> ReadE a
succeedReadE :: forall a. (String -> a) -> ReadE a
succeedReadE String -> a
f = (String -> Either String a) -> ReadE a
forall a. (String -> Either String a) -> ReadE a
ReadE (a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a)
-> (String -> a) -> String -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
f)

failReadE :: ErrorMsg -> ReadE a
failReadE :: forall a. String -> ReadE a
failReadE = (String -> Either String a) -> ReadE a
forall a. (String -> Either String a) -> ReadE a
ReadE ((String -> Either String a) -> ReadE a)
-> (String -> String -> Either String a) -> String -> ReadE a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String a -> String -> Either String a
forall a b. a -> b -> a
const (Either String a -> String -> Either String a)
-> (String -> Either String a)
-> String
-> String
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left

readEOrFail :: ReadE a -> String -> a
readEOrFail :: forall a. ReadE a -> String -> a
readEOrFail ReadE a
r = (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> a
forall a. HasCallStack => String -> a
error a -> a
forall a. a -> a
id (Either String a -> a)
-> (String -> Either String a) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadE a -> String -> Either String a
forall a. ReadE a -> String -> Either String a
runReadE ReadE a
r

parsecToReadE :: (String -> ErrorMsg) -> ParsecParser a -> ReadE a
parsecToReadE :: forall a. (String -> String) -> ParsecParser a -> ReadE a
parsecToReadE String -> String
err ParsecParser a
p = (String -> Either String a) -> ReadE a
forall a. (String -> Either String a) -> ReadE a
ReadE ((String -> Either String a) -> ReadE a)
-> (String -> Either String a) -> ReadE a
forall a b. (a -> b) -> a -> b
$ \String
txt ->
    case ParsecParser a -> String -> FieldLineStream -> Either ParseError a
forall a.
ParsecParser a -> String -> FieldLineStream -> Either ParseError a
runParsecParser ParsecParser a
p String
"<parsecToReadE>" (String -> FieldLineStream
fieldLineStreamFromString String
txt) of
        Right a
x -> a -> Either String a
forall a b. b -> Either a b
Right a
x
        Left ParseError
_e -> String -> Either String a
forall a b. a -> Either a b
Left (String -> String
err String
txt)
-- TODO: use parsec error to make 'ErrorMsg'.