{-# 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 -> ParseError -> String) -> String -> ParseError -> String
forall a b. (a -> b) -> a -> b
$ 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