{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.ByteString.Conversion.From
( FromByteString (..)
, fromByteString
, fromByteString'
, runParser
, runParser'
) where
import Control.Applicative
import Control.Monad
import Data.Attoparsec.ByteString
import Data.Attoparsec.ByteString.Char8 (signed, decimal, double, hexadecimal)
import Data.Bits (Bits)
import Data.ByteString (ByteString, elem)
import Data.ByteString.Conversion.Internal
import Data.CaseInsensitive (CI, FoldCase, mk)
import Data.Int
import Data.Maybe (isJust)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8')
import Data.Word
import Prelude hiding (elem)
import qualified Data.Attoparsec.ByteString.Lazy as Lazy
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
class FromByteString a where
parser :: Parser a
fromByteString :: FromByteString a => ByteString -> Maybe a
fromByteString :: forall a. FromByteString a => ByteString -> Maybe a
fromByteString = ([Char] -> Maybe a) -> (a -> Maybe a) -> Either [Char] a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> [Char] -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either [Char] a -> Maybe a)
-> (ByteString -> Either [Char] a) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ByteString -> Either [Char] a
forall a. Parser a -> ByteString -> Either [Char] a
runParser Parser a
forall a. FromByteString a => Parser a
parser
fromByteString' :: FromByteString a => Lazy.ByteString -> Maybe a
fromByteString' :: forall a. FromByteString a => ByteString -> Maybe a
fromByteString' = ([Char] -> Maybe a) -> (a -> Maybe a) -> Either [Char] a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> [Char] -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either [Char] a -> Maybe a)
-> (ByteString -> Either [Char] a) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ByteString -> Either [Char] a
forall a. Parser a -> ByteString -> Either [Char] a
runParser' Parser a
forall a. FromByteString a => Parser a
parser
runParser :: Parser a -> ByteString -> Either String a
runParser :: forall a. Parser a -> ByteString -> Either [Char] a
runParser Parser a
p ByteString
b = case IResult ByteString a -> ByteString -> IResult ByteString a
forall i r. Monoid i => IResult i r -> i -> IResult i r
feed (Parser a -> ByteString -> IResult ByteString a
forall a. Parser a -> ByteString -> Result a
parse Parser a
p ByteString
b) ByteString
"" of
Done ByteString
"" a
r -> a -> Either [Char] a
forall a b. b -> Either a b
Right a
r
Done ByteString
_ a
_ -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
"Trailing input"
Fail ByteString
_ [] [Char]
m -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
m
Fail ByteString
_ [[Char]]
x [Char]
m -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left ([[Char]] -> ShowS
forall a. Show a => a -> ShowS
shows [[Char]]
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
m ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"")
Partial ByteString -> IResult ByteString a
_ -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
"Unexpected result: Partial"
runParser' :: Parser a -> Lazy.ByteString -> Either String a
runParser' :: forall a. Parser a -> ByteString -> Either [Char] a
runParser' Parser a
p ByteString
b = case Parser a -> ByteString -> Result a
forall a. Parser a -> ByteString -> Result a
Lazy.parse Parser a
p ByteString
b of
Lazy.Done ByteString
"" a
r -> a -> Either [Char] a
forall a b. b -> Either a b
Right a
r
Lazy.Done ByteString
_ a
_ -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
"Trailing input"
Lazy.Fail ByteString
_ [] [Char]
m -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
m
Lazy.Fail ByteString
_ [[Char]]
x [Char]
m -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left ([[Char]] -> ShowS
forall a. Show a => a -> ShowS
shows [[Char]]
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
m ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"")
instance FromByteString ByteString where
parser :: Parser ByteString
parser = Parser ByteString
takeByteString
instance FromByteString Lazy.ByteString where
parser :: Parser ByteString
parser = Parser ByteString
takeLazyByteString
instance FromByteString a => FromByteString (List a) where
parser :: Parser (List a)
parser = Parser (List a)
forall a. FromByteString a => Parser (List a)
parseList
instance (FoldCase a, FromByteString a) => FromByteString (CI a) where
parser :: Parser (CI a)
parser = a -> CI a
forall s. FoldCase s => s -> CI s
mk (a -> CI a) -> Parser ByteString a -> Parser (CI a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString a
forall a. FromByteString a => Parser a
parser
instance FromByteString Char where
parser :: Parser Char
parser = do
Text
c <- ByteString -> Parser Text
text (ByteString -> Parser Text) -> Parser ByteString -> Parser Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser ByteString
takeByteString
if Text -> Int
T.length Text
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1
then [Char] -> Parser Char
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Char"
else Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
c
instance FromByteString [Char] where
parser :: Parser [Char]
parser = Parser ByteString
takeByteString Parser ByteString -> (ByteString -> Parser [Char]) -> Parser [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> [Char]) -> Parser Text -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Char]
T.unpack (Parser Text -> Parser [Char])
-> (ByteString -> Parser Text) -> ByteString -> Parser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Parser Text
text
instance FromByteString Text where
parser :: Parser Text
parser = Parser ByteString
takeByteString Parser ByteString -> (ByteString -> Parser Text) -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Parser Text
text
instance FromByteString TL.Text where
parser :: Parser Text
parser = Parser ByteString
takeLazyByteString Parser ByteString -> (ByteString -> Parser Text) -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Parser Text
ltext
instance FromByteString Bool where
parser :: Parser Bool
parser =
(Word8 -> Bool) -> Parser Word8
satisfy (Word8 -> ByteString -> Bool
`elem` ByteString
"tT") Parser Word8 -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> Parser ByteString
string ByteString
"rue" Parser ByteString -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Word8 -> Bool) -> Parser Word8
satisfy (Word8 -> ByteString -> Bool
`elem` ByteString
"fF") Parser Word8 -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> Parser ByteString
string ByteString
"alse" Parser ByteString -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
[Char] -> Parser Bool
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Bool"
instance FromByteString Double where
parser :: Parser Double
parser = Parser Double -> Parser Double
forall a. Num a => Parser a -> Parser a
signed Parser Double
double Parser Double -> Parser Double -> Parser Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Double
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Double"
instance FromByteString Integer where
parser :: Parser Integer
parser = Parser Integer -> Parser Integer
forall a. Num a => Parser a -> Parser a
signed Parser Integer
forall a. Integral a => Parser a
decimal Parser Integer -> Parser Integer -> Parser Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Integer
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Integer"
instance FromByteString Int where
parser :: Parser Int
parser = Parser Int -> Parser Int
forall a. Num a => Parser a -> Parser a
signed Parser Int
forall a. Integral a => Parser a
decimal Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Int
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Int"
instance FromByteString Int8 where
parser :: Parser Int8
parser = Parser Int8 -> Parser Int8
forall a. Num a => Parser a -> Parser a
signed Parser Int8
forall a. Integral a => Parser a
decimal Parser Int8 -> Parser Int8 -> Parser Int8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Int8
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Int8"
instance FromByteString Int16 where
parser :: Parser Int16
parser = Parser Int16 -> Parser Int16
forall a. Num a => Parser a -> Parser a
signed Parser Int16
forall a. Integral a => Parser a
decimal Parser Int16 -> Parser Int16 -> Parser Int16
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Int16
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Int16"
instance FromByteString Int32 where
parser :: Parser Int32
parser = Parser Int32 -> Parser Int32
forall a. Num a => Parser a -> Parser a
signed Parser Int32
forall a. Integral a => Parser a
decimal Parser Int32 -> Parser Int32 -> Parser Int32
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Int32
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Int32"
instance FromByteString Int64 where
parser :: Parser Int64
parser = Parser Int64 -> Parser Int64
forall a. Num a => Parser a -> Parser a
signed Parser Int64
forall a. Integral a => Parser a
decimal Parser Int64 -> Parser Int64 -> Parser Int64
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Int64
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Int64"
instance FromByteString Word where
parser :: Parser Word
parser = Parser Word -> Parser Word
forall a. Num a => Parser a -> Parser a
signed Parser Word
forall a. Integral a => Parser a
decimal Parser Word -> Parser Word -> Parser Word
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Word
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Word"
instance FromByteString Word8 where
parser :: Parser Word8
parser = Parser Word8 -> Parser Word8
forall a. Num a => Parser a -> Parser a
signed Parser Word8
forall a. Integral a => Parser a
decimal Parser Word8 -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Word8
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Word8"
instance FromByteString Word16 where
parser :: Parser Word16
parser = Parser Word16 -> Parser Word16
forall a. Num a => Parser a -> Parser a
signed Parser Word16
forall a. Integral a => Parser a
decimal Parser Word16 -> Parser Word16 -> Parser Word16
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Word16
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Word16"
instance FromByteString Word32 where
parser :: Parser Word32
parser = Parser Word32 -> Parser Word32
forall a. Num a => Parser a -> Parser a
signed Parser Word32
forall a. Integral a => Parser a
decimal Parser Word32 -> Parser Word32 -> Parser Word32
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Word32
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Word32"
instance FromByteString Word64 where
parser :: Parser Word64
parser = Parser Word64 -> Parser Word64
forall a. Num a => Parser a -> Parser a
signed Parser Word64
forall a. Integral a => Parser a
decimal Parser Word64 -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Word64
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Word64"
instance (Integral a, Bits a) => FromByteString (Hex a) where
parser :: Parser (Hex a)
parser = a -> Hex a
forall a. a -> Hex a
Hex (a -> Hex a) -> Parser ByteString a -> Parser (Hex a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString a -> Parser ByteString a
forall a. Num a => Parser a -> Parser a
signed (Parser Word8 -> Parser ByteString (Maybe Word8)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Word8
prefix Parser ByteString (Maybe Word8)
-> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString a
forall a. (Integral a, Bits a) => Parser a
hexadecimal)
where
prefix :: Parser Word8
prefix = Word8 -> Parser Word8
word8 Word8
0x30 Parser Word8 -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser Word8
satisfy (Word8 -> ByteString -> Bool
`elem` ByteString
"xX")
parseList :: FromByteString a => Parser (List a)
parseList :: forall a. FromByteString a => Parser (List a)
parseList = Parser Bool
forall t. Chunk t => Parser t Bool
atEnd Parser Bool
-> (Bool -> Parser ByteString (List a))
-> Parser ByteString (List a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
e ->
if Bool
e then List a -> Parser ByteString (List a)
forall (m :: * -> *) a. Monad m => a -> m a
return (List a -> Parser ByteString (List a))
-> List a -> Parser ByteString (List a)
forall a b. (a -> b) -> a -> b
$ [a] -> List a
forall a. [a] -> List a
List []
else [a] -> List a
forall a. [a] -> List a
List ([a] -> List a) -> ([a] -> [a]) -> [a] -> List a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> List a)
-> Parser ByteString [a] -> Parser ByteString (List a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Parser ByteString [a]
forall {a}. FromByteString a => [a] -> Parser ByteString [a]
go []
where
go :: [a] -> Parser ByteString [a]
go [a]
acc = do
ByteString
x <- (Word8 -> Bool) -> Parser ByteString
takeTill (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2C)
a
v <- case Parser ByteString a -> ByteString -> Either [Char] a
forall a. Parser a -> ByteString -> Either [Char] a
runParser Parser ByteString a
forall a. FromByteString a => Parser a
parser ByteString
x of
Left [Char]
s -> [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
s
Right a
a -> a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Maybe Word8
c <- Parser Word8 -> Parser ByteString (Maybe Word8)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Word8 -> Parser Word8
word8 Word8
0x2C)
Bool
e <- Parser Bool
forall t. Chunk t => Parser t Bool
atEnd
case (Bool
e, Maybe Word8 -> Bool
forall a. Maybe a -> Bool
isJust Maybe Word8
c) of
(Bool
True, Bool
True) -> [Char] -> Parser ByteString [a]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"trailing comma"
(Bool
True, Bool
False) -> [a] -> Parser ByteString [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
va -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)
(Bool
False, Bool
True) -> [a] -> Parser ByteString [a]
go (a
va -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)
(Bool
False, Bool
False) -> [Char] -> Parser ByteString [a]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"missing comma"
text :: ByteString -> Parser Text
text :: ByteString -> Parser Text
text = (UnicodeException -> Parser Text)
-> (Text -> Parser Text)
-> Either UnicodeException Text
-> Parser Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Parser Text
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Text)
-> (UnicodeException -> [Char]) -> UnicodeException -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Invalid UTF-8: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (UnicodeException -> [Char]) -> UnicodeException -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeException -> [Char]
forall a. Show a => a -> [Char]
show) Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Either UnicodeException Text -> Parser Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
decodeUtf8'
{-# INLINE text #-}
ltext :: Lazy.ByteString -> Parser TL.Text
ltext :: ByteString -> Parser Text
ltext = (UnicodeException -> Parser Text)
-> (Text -> Parser Text)
-> Either UnicodeException Text
-> Parser Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Parser Text
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Text)
-> (UnicodeException -> [Char]) -> UnicodeException -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Invalid UTF-8: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (UnicodeException -> [Char]) -> UnicodeException -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeException -> [Char]
forall a. Show a => a -> [Char]
show) Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Either UnicodeException Text -> Parser Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
TL.decodeUtf8'
{-# INLINE ltext #-}