{-# LANGUAGE CPP, ViewPatterns, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module Database.PostgreSQL.Simple.HStore.Implementation where
import Control.Applicative
import qualified Data.Attoparsec.ByteString as P
import qualified Data.Attoparsec.ByteString.Char8 as P (isSpace_w8)
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder, byteString, char8)
import qualified Data.ByteString.Builder as BU
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Lazy as BL
#if !MIN_VERSION_bytestring(0,10,0)
import qualified Data.ByteString.Lazy.Internal as BL (foldrChunks)
#endif
import Data.Map(Map)
import qualified Data.Map as Map
import Data.Text(Text)
import qualified Data.Text as TS
import qualified Data.Text.Encoding as TS
import Data.Text.Encoding.Error(UnicodeException)
import qualified Data.Text.Lazy as TL
import Data.Typeable
import Data.Monoid(Monoid(..))
import Data.Semigroup
import Database.PostgreSQL.Simple.FromField
import Database.PostgreSQL.Simple.ToField
class ToHStore a where
toHStore :: a -> HStoreBuilder
data HStoreBuilder
= Empty
| Comma !Builder
deriving (Typeable)
instance ToHStore HStoreBuilder where
toHStore :: HStoreBuilder -> HStoreBuilder
toHStore = HStoreBuilder -> HStoreBuilder
forall a. a -> a
id
toBuilder :: HStoreBuilder -> Builder
toBuilder :: HStoreBuilder -> Builder
toBuilder x :: HStoreBuilder
x = case HStoreBuilder
x of
Empty -> Builder
forall a. Monoid a => a
mempty
Comma c :: Builder
c -> Builder
c
toLazyByteString :: HStoreBuilder -> BL.ByteString
toLazyByteString :: HStoreBuilder -> ByteString
toLazyByteString x :: HStoreBuilder
x = case HStoreBuilder
x of
Empty -> ByteString
BL.empty
Comma c :: Builder
c -> Builder -> ByteString
BU.toLazyByteString Builder
c
instance Semigroup HStoreBuilder where
Empty <> :: HStoreBuilder -> HStoreBuilder -> HStoreBuilder
<> x :: HStoreBuilder
x = HStoreBuilder
x
Comma a :: Builder
a <> x :: HStoreBuilder
x
= Builder -> HStoreBuilder
Comma (Builder
a Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` case HStoreBuilder
x of
Empty -> Builder
forall a. Monoid a => a
mempty
Comma b :: Builder
b -> Char -> Builder
char8 ',' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b)
instance Monoid HStoreBuilder where
mempty :: HStoreBuilder
mempty = HStoreBuilder
Empty
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
class ToHStoreText a where
toHStoreText :: a -> HStoreText
newtype HStoreText = HStoreText Builder deriving (Typeable, b -> HStoreText -> HStoreText
NonEmpty HStoreText -> HStoreText
HStoreText -> HStoreText -> HStoreText
(HStoreText -> HStoreText -> HStoreText)
-> (NonEmpty HStoreText -> HStoreText)
-> (forall b. Integral b => b -> HStoreText -> HStoreText)
-> Semigroup HStoreText
forall b. Integral b => b -> HStoreText -> HStoreText
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> HStoreText -> HStoreText
$cstimes :: forall b. Integral b => b -> HStoreText -> HStoreText
sconcat :: NonEmpty HStoreText -> HStoreText
$csconcat :: NonEmpty HStoreText -> HStoreText
<> :: HStoreText -> HStoreText -> HStoreText
$c<> :: HStoreText -> HStoreText -> HStoreText
Semigroup, Semigroup HStoreText
HStoreText
Semigroup HStoreText =>
HStoreText
-> (HStoreText -> HStoreText -> HStoreText)
-> ([HStoreText] -> HStoreText)
-> Monoid HStoreText
[HStoreText] -> HStoreText
HStoreText -> HStoreText -> HStoreText
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [HStoreText] -> HStoreText
$cmconcat :: [HStoreText] -> HStoreText
mappend :: HStoreText -> HStoreText -> HStoreText
$cmappend :: HStoreText -> HStoreText -> HStoreText
mempty :: HStoreText
$cmempty :: HStoreText
$cp1Monoid :: Semigroup HStoreText
Monoid)
instance ToHStoreText HStoreText where
toHStoreText :: HStoreText -> HStoreText
toHStoreText = HStoreText -> HStoreText
forall a. a -> a
id
instance ToHStoreText BS.ByteString where
toHStoreText :: ByteString -> HStoreText
toHStoreText str :: ByteString
str = Builder -> HStoreText
HStoreText (ByteString -> Builder -> Builder
escapeAppend ByteString
str Builder
forall a. Monoid a => a
mempty)
instance ToHStoreText BL.ByteString where
toHStoreText :: ByteString -> HStoreText
toHStoreText = Builder -> HStoreText
HStoreText (Builder -> HStoreText)
-> (ByteString -> Builder) -> ByteString -> HStoreText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Builder -> Builder)
-> Builder -> ByteString -> Builder
forall a. (ByteString -> a -> a) -> a -> ByteString -> a
BL.foldrChunks ByteString -> Builder -> Builder
escapeAppend Builder
forall a. Monoid a => a
mempty
instance ToHStoreText TS.Text where
toHStoreText :: Text -> HStoreText
toHStoreText str :: Text
str = Builder -> HStoreText
HStoreText (ByteString -> Builder -> Builder
escapeAppend (Text -> ByteString
TS.encodeUtf8 Text
str) Builder
forall a. Monoid a => a
mempty)
instance ToHStoreText TL.Text where
toHStoreText :: Text -> HStoreText
toHStoreText = Builder -> HStoreText
HStoreText (Builder -> HStoreText) -> (Text -> Builder) -> Text -> HStoreText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Builder -> Builder) -> Builder -> Text -> Builder
forall a. (Text -> a -> a) -> a -> Text -> a
TL.foldrChunks (ByteString -> Builder -> Builder
escapeAppend (ByteString -> Builder -> Builder)
-> (Text -> ByteString) -> Text -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TS.encodeUtf8) Builder
forall a. Monoid a => a
mempty
escapeAppend :: BS.ByteString -> Builder -> Builder
escapeAppend :: ByteString -> Builder -> Builder
escapeAppend = ByteString -> Builder -> Builder
loop
where
loop :: ByteString -> Builder -> Builder
loop ((Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break Word8 -> Bool
quoteNeeded -> (a :: ByteString
a,b :: ByteString
b)) rest :: Builder
rest
= ByteString -> Builder
byteString ByteString
a Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
b of
Nothing -> Builder
rest
Just (c :: Word8
c,d :: ByteString
d) -> Word8 -> Builder
quoteChar Word8
c Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder -> Builder
loop ByteString
d Builder
rest
quoteNeeded :: Word8 -> Bool
quoteNeeded c :: Word8
c = Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w '\"' Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w '\\'
quoteChar :: Word8 -> Builder
quoteChar c :: Word8
c
| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w '\"' = ByteString -> Builder
byteString "\\\""
| Bool
otherwise = ByteString -> Builder
byteString "\\\\"
hstore :: (ToHStoreText a, ToHStoreText b) => a -> b -> HStoreBuilder
hstore :: a -> b -> HStoreBuilder
hstore (a -> HStoreText
forall a. ToHStoreText a => a -> HStoreText
toHStoreText -> (HStoreText key :: Builder
key)) (b -> HStoreText
forall a. ToHStoreText a => a -> HStoreText
toHStoreText -> (HStoreText val :: Builder
val)) =
Builder -> HStoreBuilder
Comma (Char -> Builder
char8 '"' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
key Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
byteString "\"=>\""
Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
val Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
char8 '"')
instance ToField HStoreBuilder where
toField :: HStoreBuilder -> Action
toField Empty = ByteString -> Action
forall a. ToField a => a -> Action
toField (ByteString
BS.empty)
toField (Comma x :: Builder
x) = ByteString -> Action
forall a. ToField a => a -> Action
toField (Builder -> ByteString
BU.toLazyByteString Builder
x)
newtype HStoreList = HStoreList {HStoreList -> [(Text, Text)]
fromHStoreList :: [(Text,Text)]} deriving (Typeable, Int -> HStoreList -> ShowS
[HStoreList] -> ShowS
HStoreList -> String
(Int -> HStoreList -> ShowS)
-> (HStoreList -> String)
-> ([HStoreList] -> ShowS)
-> Show HStoreList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HStoreList] -> ShowS
$cshowList :: [HStoreList] -> ShowS
show :: HStoreList -> String
$cshow :: HStoreList -> String
showsPrec :: Int -> HStoreList -> ShowS
$cshowsPrec :: Int -> HStoreList -> ShowS
Show)
instance ToHStore HStoreList where
toHStore :: HStoreList -> HStoreBuilder
toHStore (HStoreList xs :: [(Text, Text)]
xs) = [HStoreBuilder] -> HStoreBuilder
forall a. Monoid a => [a] -> a
mconcat (((Text, Text) -> HStoreBuilder)
-> [(Text, Text)] -> [HStoreBuilder]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> HStoreBuilder) -> (Text, Text) -> HStoreBuilder
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> HStoreBuilder
forall a b.
(ToHStoreText a, ToHStoreText b) =>
a -> b -> HStoreBuilder
hstore) [(Text, Text)]
xs)
instance ToField HStoreList where
toField :: HStoreList -> Action
toField xs :: HStoreList
xs = HStoreBuilder -> Action
forall a. ToField a => a -> Action
toField (HStoreList -> HStoreBuilder
forall a. ToHStore a => a -> HStoreBuilder
toHStore HStoreList
xs)
instance FromField HStoreList where
fromField :: FieldParser HStoreList
fromField f :: Field
f mdat :: Maybe ByteString
mdat = do
ByteString
typ <- Field -> Conversion ByteString
typename Field
f
if ByteString
typ ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= "hstore"
then (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion HStoreList
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
f ""
else case Maybe ByteString
mdat of
Nothing -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion HStoreList
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
f ""
Just dat :: ByteString
dat ->
case Parser (Either UnicodeException HStoreList)
-> ByteString -> Either String (Either UnicodeException HStoreList)
forall a. Parser a -> ByteString -> Either String a
P.parseOnly (Parser (Either UnicodeException HStoreList)
parseHStore Parser (Either UnicodeException HStoreList)
-> Parser ByteString ()
-> Parser (Either UnicodeException HStoreList)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
P.endOfInput) ByteString
dat of
Left err :: String
err ->
(String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion HStoreList
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f String
err
Right (Left err :: UnicodeException
err) ->
(String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion HStoreList
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f "unicode exception" Conversion HStoreList
-> Conversion HStoreList -> Conversion HStoreList
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
UnicodeException -> Conversion HStoreList
forall err a. Exception err => err -> Conversion a
conversionError UnicodeException
err
Right (Right val :: HStoreList
val) ->
HStoreList -> Conversion HStoreList
forall (m :: * -> *) a. Monad m => a -> m a
return HStoreList
val
newtype HStoreMap = HStoreMap {HStoreMap -> Map Text Text
fromHStoreMap :: Map Text Text} deriving (HStoreMap -> HStoreMap -> Bool
(HStoreMap -> HStoreMap -> Bool)
-> (HStoreMap -> HStoreMap -> Bool) -> Eq HStoreMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HStoreMap -> HStoreMap -> Bool
$c/= :: HStoreMap -> HStoreMap -> Bool
== :: HStoreMap -> HStoreMap -> Bool
$c== :: HStoreMap -> HStoreMap -> Bool
Eq, Eq HStoreMap
Eq HStoreMap =>
(HStoreMap -> HStoreMap -> Ordering)
-> (HStoreMap -> HStoreMap -> Bool)
-> (HStoreMap -> HStoreMap -> Bool)
-> (HStoreMap -> HStoreMap -> Bool)
-> (HStoreMap -> HStoreMap -> Bool)
-> (HStoreMap -> HStoreMap -> HStoreMap)
-> (HStoreMap -> HStoreMap -> HStoreMap)
-> Ord HStoreMap
HStoreMap -> HStoreMap -> Bool
HStoreMap -> HStoreMap -> Ordering
HStoreMap -> HStoreMap -> HStoreMap
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HStoreMap -> HStoreMap -> HStoreMap
$cmin :: HStoreMap -> HStoreMap -> HStoreMap
max :: HStoreMap -> HStoreMap -> HStoreMap
$cmax :: HStoreMap -> HStoreMap -> HStoreMap
>= :: HStoreMap -> HStoreMap -> Bool
$c>= :: HStoreMap -> HStoreMap -> Bool
> :: HStoreMap -> HStoreMap -> Bool
$c> :: HStoreMap -> HStoreMap -> Bool
<= :: HStoreMap -> HStoreMap -> Bool
$c<= :: HStoreMap -> HStoreMap -> Bool
< :: HStoreMap -> HStoreMap -> Bool
$c< :: HStoreMap -> HStoreMap -> Bool
compare :: HStoreMap -> HStoreMap -> Ordering
$ccompare :: HStoreMap -> HStoreMap -> Ordering
$cp1Ord :: Eq HStoreMap
Ord, Typeable, Int -> HStoreMap -> ShowS
[HStoreMap] -> ShowS
HStoreMap -> String
(Int -> HStoreMap -> ShowS)
-> (HStoreMap -> String)
-> ([HStoreMap] -> ShowS)
-> Show HStoreMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HStoreMap] -> ShowS
$cshowList :: [HStoreMap] -> ShowS
show :: HStoreMap -> String
$cshow :: HStoreMap -> String
showsPrec :: Int -> HStoreMap -> ShowS
$cshowsPrec :: Int -> HStoreMap -> ShowS
Show)
instance ToHStore HStoreMap where
toHStore :: HStoreMap -> HStoreBuilder
toHStore (HStoreMap xs :: Map Text Text
xs) = (Text -> Text -> HStoreBuilder -> HStoreBuilder)
-> HStoreBuilder -> Map Text Text -> HStoreBuilder
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Text -> Text -> HStoreBuilder -> HStoreBuilder
forall a b.
(ToHStoreText a, ToHStoreText b) =>
a -> b -> HStoreBuilder -> HStoreBuilder
f HStoreBuilder
forall a. Monoid a => a
mempty Map Text Text
xs
where f :: a -> b -> HStoreBuilder -> HStoreBuilder
f k :: a
k v :: b
v xs' :: HStoreBuilder
xs' = a -> b -> HStoreBuilder
forall a b.
(ToHStoreText a, ToHStoreText b) =>
a -> b -> HStoreBuilder
hstore a
k b
v HStoreBuilder -> HStoreBuilder -> HStoreBuilder
forall a. Monoid a => a -> a -> a
`mappend` HStoreBuilder
xs'
instance ToField HStoreMap where
toField :: HStoreMap -> Action
toField xs :: HStoreMap
xs = HStoreBuilder -> Action
forall a. ToField a => a -> Action
toField (HStoreMap -> HStoreBuilder
forall a. ToHStore a => a -> HStoreBuilder
toHStore HStoreMap
xs)
instance FromField HStoreMap where
fromField :: FieldParser HStoreMap
fromField f :: Field
f mdat :: Maybe ByteString
mdat = HStoreList -> HStoreMap
convert (HStoreList -> HStoreMap)
-> Conversion HStoreList -> Conversion HStoreMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser HStoreList
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
mdat
where convert :: HStoreList -> HStoreMap
convert (HStoreList xs :: [(Text, Text)]
xs) = Map Text Text -> HStoreMap
HStoreMap ([(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
xs)
parseHStoreList :: BS.ByteString -> Either String HStoreList
parseHStoreList :: ByteString -> Either String HStoreList
parseHStoreList dat :: ByteString
dat =
case Parser (Either UnicodeException HStoreList)
-> ByteString -> Either String (Either UnicodeException HStoreList)
forall a. Parser a -> ByteString -> Either String a
P.parseOnly (Parser (Either UnicodeException HStoreList)
parseHStore Parser (Either UnicodeException HStoreList)
-> Parser ByteString ()
-> Parser (Either UnicodeException HStoreList)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
P.endOfInput) ByteString
dat of
Left err :: String
err -> String -> Either String HStoreList
forall a b. a -> Either a b
Left (ShowS
forall a. Show a => a -> String
show String
err)
Right (Left err :: UnicodeException
err) -> String -> Either String HStoreList
forall a b. a -> Either a b
Left (UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
err)
Right (Right val :: HStoreList
val) -> HStoreList -> Either String HStoreList
forall a b. b -> Either a b
Right HStoreList
val
parseHStore :: P.Parser (Either UnicodeException HStoreList)
parseHStore :: Parser (Either UnicodeException HStoreList)
parseHStore = do
[Either UnicodeException (Text, Text)]
kvs <- Parser ByteString (Either UnicodeException (Text, Text))
-> Parser ByteString Word8
-> Parser ByteString [Either UnicodeException (Text, Text)]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
P.sepBy' (Parser ByteString ()
skipWhiteSpace Parser ByteString ()
-> Parser ByteString (Either UnicodeException (Text, Text))
-> Parser ByteString (Either UnicodeException (Text, Text))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (Either UnicodeException (Text, Text))
parseHStoreKeyVal)
(Parser ByteString ()
skipWhiteSpace Parser ByteString ()
-> Parser ByteString Word8 -> Parser ByteString Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word8 -> Parser ByteString Word8
P.word8 (Char -> Word8
c2w ','))
Either UnicodeException HStoreList
-> Parser (Either UnicodeException HStoreList)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either UnicodeException HStoreList
-> Parser (Either UnicodeException HStoreList))
-> Either UnicodeException HStoreList
-> Parser (Either UnicodeException HStoreList)
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> HStoreList
HStoreList ([(Text, Text)] -> HStoreList)
-> Either UnicodeException [(Text, Text)]
-> Either UnicodeException HStoreList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either UnicodeException (Text, Text)]
-> Either UnicodeException [(Text, Text)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Either UnicodeException (Text, Text)]
kvs
parseHStoreKeyVal :: P.Parser (Either UnicodeException (Text,Text))
parseHStoreKeyVal :: Parser ByteString (Either UnicodeException (Text, Text))
parseHStoreKeyVal = do
Either UnicodeException Text
mkey <- Parser (Either UnicodeException Text)
parseHStoreText
case Either UnicodeException Text
mkey of
Left err :: UnicodeException
err -> Either UnicodeException (Text, Text)
-> Parser ByteString (Either UnicodeException (Text, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (UnicodeException -> Either UnicodeException (Text, Text)
forall a b. a -> Either a b
Left UnicodeException
err)
Right key :: Text
key -> do
Parser ByteString ()
skipWhiteSpace
ByteString
_ <- ByteString -> Parser ByteString
P.string "=>"
Parser ByteString ()
skipWhiteSpace
Either UnicodeException Text
mval <- Parser (Either UnicodeException Text)
parseHStoreText
case Either UnicodeException Text
mval of
Left err :: UnicodeException
err -> Either UnicodeException (Text, Text)
-> Parser ByteString (Either UnicodeException (Text, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (UnicodeException -> Either UnicodeException (Text, Text)
forall a b. a -> Either a b
Left UnicodeException
err)
Right val :: Text
val -> Either UnicodeException (Text, Text)
-> Parser ByteString (Either UnicodeException (Text, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Text) -> Either UnicodeException (Text, Text)
forall a b. b -> Either a b
Right (Text
key,Text
val))
skipWhiteSpace :: P.Parser ()
skipWhiteSpace :: Parser ByteString ()
skipWhiteSpace = (Word8 -> Bool) -> Parser ByteString ()
P.skipWhile Word8 -> Bool
P.isSpace_w8
parseHStoreText :: P.Parser (Either UnicodeException Text)
parseHStoreText :: Parser (Either UnicodeException Text)
parseHStoreText = do
Word8
_ <- Word8 -> Parser ByteString Word8
P.word8 (Char -> Word8
c2w '"')
Either UnicodeException [Text]
mtexts <- ([Text] -> [Text]) -> Parser (Either UnicodeException [Text])
parseHStoreTexts [Text] -> [Text]
forall a. a -> a
id
case Either UnicodeException [Text]
mtexts of
Left err :: UnicodeException
err -> Either UnicodeException Text
-> Parser (Either UnicodeException Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (UnicodeException -> Either UnicodeException Text
forall a b. a -> Either a b
Left UnicodeException
err)
Right texts :: [Text]
texts -> do
Word8
_ <- Word8 -> Parser ByteString Word8
P.word8 (Char -> Word8
c2w '"')
Either UnicodeException Text
-> Parser (Either UnicodeException Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either UnicodeException Text
forall a b. b -> Either a b
Right ([Text] -> Text
TS.concat [Text]
texts))
parseHStoreTexts :: ([Text] -> [Text])
-> P.Parser (Either UnicodeException [Text])
parseHStoreTexts :: ([Text] -> [Text]) -> Parser (Either UnicodeException [Text])
parseHStoreTexts acc :: [Text] -> [Text]
acc = do
Either UnicodeException Text
mchunk <- ByteString -> Either UnicodeException Text
TS.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> Parser ByteString -> Parser (Either UnicodeException Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
P.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
isSpecialChar)
case Either UnicodeException Text
mchunk of
Left err :: UnicodeException
err -> Either UnicodeException [Text]
-> Parser (Either UnicodeException [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (UnicodeException -> Either UnicodeException [Text]
forall a b. a -> Either a b
Left UnicodeException
err)
Right chunk :: Text
chunk ->
(do
Word8
_ <- Word8 -> Parser ByteString Word8
P.word8 (Char -> Word8
c2w '\\')
Text
c <- Char -> Text
TS.singleton (Char -> Text) -> (Word8 -> Char) -> Word8 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c (Word8 -> Text)
-> Parser ByteString Word8 -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString Word8
P.satisfy Word8 -> Bool
isSpecialChar
([Text] -> [Text]) -> Parser (Either UnicodeException [Text])
parseHStoreTexts ([Text] -> [Text]
acc ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
chunkText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
cText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:))
) Parser (Either UnicodeException [Text])
-> Parser (Either UnicodeException [Text])
-> Parser (Either UnicodeException [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Either UnicodeException [Text]
-> Parser (Either UnicodeException [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Either UnicodeException [Text]
forall a b. b -> Either a b
Right ([Text] -> [Text]
acc [Text
chunk]))
where
isSpecialChar :: Word8 -> Bool
isSpecialChar c :: Word8
c = Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w '\\' Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w '"'