{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
module GHC.Internal.Text.Read (
Read(..),
ReadS,
reads,
read,
readParen,
lex,
module GHC.Internal.Text.ParserCombinators.ReadPrec,
L.Lexeme(..),
lexP,
parens,
readListDefault,
readListPrecDefault,
readEither,
readMaybe
) where
import GHC.Internal.Base
import GHC.Internal.Read
import GHC.Internal.Data.Either
import GHC.Internal.Text.ParserCombinators.ReadP as P
import GHC.Internal.Text.ParserCombinators.ReadPrec
import qualified GHC.Internal.Text.Read.Lex as L
reads :: Read a => ReadS a
reads :: forall a. Read a => ReadS a
reads = Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec Int
minPrec
readEither :: Read a => String -> Either String a
readEither :: forall a. Read a => String -> Either String a
readEither String
s =
case [ a
x | (a
x,String
"") <- ReadPrec a -> Int -> ReadS a
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec a
read' Int
minPrec String
s ] of
[a
x] -> a -> Either String a
forall a b. b -> Either a b
Right a
x
[] -> String -> Either String a
forall a b. a -> Either a b
Left String
"Prelude.read: no parse"
[a]
_ -> String -> Either String a
forall a b. a -> Either a b
Left String
"Prelude.read: ambiguous parse"
where
read' :: ReadPrec a
read' =
do x <- ReadPrec a
forall a. Read a => ReadPrec a
readPrec
lift P.skipSpaces
return x
readMaybe :: Read a => String -> Maybe a
readMaybe :: forall a. Read a => String -> Maybe a
readMaybe String
s = case String -> Either String a
forall a. Read a => String -> Either String a
readEither String
s of
Left String
_ -> Maybe a
forall a. Maybe a
Nothing
Right a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
read :: Read a => String -> a
read :: forall a. Read a => String -> a
read String
s = (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. String -> a
errorWithoutStackTrace a -> a
forall a. a -> a
id (String -> Either String a
forall a. Read a => String -> Either String a
readEither String
s)