    {-# LANGUAGE LambdaCase #-}

    -----------------------------------------------------------------------------

    -- |
    -- 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
      , parsecToReadE
      , parsecToReadEErr

        -- * Parse Errors
      , unexpectMsgString
      ) where

    import qualified Data.Bifunctor as Bi (first)
    import Distribution.Compat.Prelude
    import Prelude ()

    import Distribution.Parsec
    import Distribution.Parsec.FieldLineStream
    import qualified Text.Parsec.Error as Parsec

    -- | 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

    runParsecFromString :: ParsecParser a -> String -> Either Parsec.ParseError a
    runParsecFromString :: forall a. ParsecParser a -> String -> Either ParseError a
    runParsecFromString ParsecParser a
    p String
    txt =
      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)

    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 ->
      String -> ParseError -> String
    forall a b. a -> b -> a
    const (String -> String
    err String
    txt) (ParseError -> String) -> Either ParseError a -> Either String a
    forall a b c. (a -> b) -> Either a c -> Either b c
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    `Bi.first` ParsecParser a -> String -> Either ParseError a
    forall a. ParsecParser a -> String -> Either ParseError a
    runParsecFromString ParsecParser a
    p String
    txt

    parsecToReadEErr :: (Parsec.ParseError -> ErrorMsg) -> ParsecParser a -> ReadE a
    parsecToReadEErr :: forall a. (ParseError -> String) -> ParsecParser a -> ReadE a
    parsecToReadEErr ParseError -> 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
    $
        (ParseError -> String) -> Either ParseError a -> Either String a
    forall a b c. (a -> b) -> Either a c -> Either b c
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    Bi.first ParseError -> String
    err (Either ParseError a -> Either String a)
    -> (String -> Either ParseError a) -> String -> Either String a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsecParser a -> String -> Either ParseError a
    forall a. ParsecParser a -> String -> Either ParseError a
    runParsecFromString ParsecParser a
    p

    -- Show only unexpected error messages
    unexpectMsgString :: Parsec.ParseError -> String
    unexpectMsgString :: ParseError -> String
    unexpectMsgString =
      [String] -> String
    unlines
        ([String] -> String)
    -> (ParseError -> [String]) -> ParseError -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Message -> String) -> [Message] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Message -> String
    Parsec.messageString
        ([Message] -> [String])
    -> (ParseError -> [Message]) -> ParseError -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Message -> Bool) -> [Message] -> [Message]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\case Parsec.UnExpect String
    _ -> Bool
    True; Message
    _ -> Bool
    False)
        ([Message] -> [Message])
    -> (ParseError -> [Message]) -> ParseError -> [Message]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseError -> [Message]
    Parsec.errorMessages