    {-# LANGUAGE CPP, ViewPatterns, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

    ------------------------------------------------------------------------------
    -- |
    -- Module:      Database.PostgreSQL.Simple.HStore.Implementation
    -- Copyright:   (c) 2013 Leon P Smith
    -- License:     BSD3
    -- Maintainer:  Leon P Smith <leon@melding-monads.com>
    -- Stability:   experimental
    --
    -- This code has yet to be profiled and optimized.
    --
    ------------------------------------------------------------------------------

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

    -- | Represents valid hstore syntax.
    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 HStoreBuilder
    x = case HStoreBuilder
    x of
                    HStoreBuilder
    Empty -> Builder
    forall a. Monoid a => a
    mempty
                    Comma Builder
    c -> Builder
    c

    toLazyByteString :: HStoreBuilder -> BL.ByteString
    toLazyByteString :: HStoreBuilder -> ByteString
    toLazyByteString HStoreBuilder
    x = case HStoreBuilder
    x of
                           HStoreBuilder
    Empty -> ByteString
    BL.empty
                           Comma Builder
    c -> Builder -> ByteString
    BU.toLazyByteString Builder
    c

    instance Semigroup HStoreBuilder where
        HStoreBuilder
    Empty   <> :: HStoreBuilder -> HStoreBuilder -> HStoreBuilder
    <> HStoreBuilder
    x = HStoreBuilder
    x
        Comma Builder
    a <> HStoreBuilder
    x
            = Builder -> HStoreBuilder
    Comma (Builder
    a Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` case HStoreBuilder
    x of
                                   HStoreBuilder
    Empty   -> Builder
    forall a. Monoid a => a
    mempty
                                   Comma Builder
    b -> Char -> Builder
    char8 Char
    ',' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    b)

    instance Monoid HStoreBuilder where
        mempty :: HStoreBuilder
    mempty = HStoreBuilder
    Empty

    class ToHStoreText a where
      toHStoreText :: a -> HStoreText

    -- | Represents escape text, ready to be the key or value to a hstore value
    newtype HStoreText = HStoreText Builder deriving (Typeable, 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
    $c<> :: HStoreText -> HStoreText -> HStoreText
    <> :: HStoreText -> HStoreText -> HStoreText
    $csconcat :: NonEmpty HStoreText -> HStoreText
    sconcat :: NonEmpty HStoreText -> HStoreText
    $cstimes :: forall b. Integral b => b -> HStoreText -> HStoreText
    stimes :: forall b. Integral b => b -> 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
    $cmempty :: HStoreText
    mempty :: HStoreText
    $cmappend :: HStoreText -> HStoreText -> HStoreText
    mappend :: HStoreText -> HStoreText -> HStoreText
    $cmconcat :: [HStoreText] -> HStoreText
    mconcat :: [HStoreText] -> HStoreText
    Monoid)

    instance ToHStoreText HStoreText where
      toHStoreText :: HStoreText -> HStoreText
    toHStoreText = HStoreText -> HStoreText
    forall a. a -> a
    id

    -- | Assumed to be UTF-8 encoded
    instance ToHStoreText BS.ByteString where
      toHStoreText :: ByteString -> HStoreText
    toHStoreText ByteString
    str = Builder -> HStoreText
    HStoreText (ByteString -> Builder -> Builder
    escapeAppend ByteString
    str Builder
    forall a. Monoid a => a
    mempty)

    -- | Assumed to be UTF-8 encoded
    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 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 -> (ByteString
    a,ByteString
    b)) 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
                Maybe (Word8, ByteString)
    Nothing     ->  Builder
    rest
                Just (Word8
    c,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 Word8
    c = Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    c2w Char
    '\"' Bool -> Bool -> Bool
    || Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    c2w Char
    '\\'
        quoteChar :: Word8 -> Builder
    quoteChar Word8
    c
            | Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    c2w Char
    '\"' = ByteString -> Builder
    byteString ByteString
    "\\\""
            | Bool
    otherwise     = ByteString -> Builder
    byteString ByteString
    "\\\\"

    hstore :: (ToHStoreText a, ToHStoreText b) => a -> b -> HStoreBuilder
    hstore :: forall a b.
    (ToHStoreText a, ToHStoreText b) =>
    a -> b -> HStoreBuilder
    hstore (a -> HStoreText
    forall a. ToHStoreText a => a -> HStoreText
    toHStoreText -> (HStoreText Builder
    key)) (b -> HStoreText
    forall a. ToHStoreText a => a -> HStoreText
    toHStoreText -> (HStoreText Builder
    val)) =
        Builder -> HStoreBuilder
    Comma (Char -> Builder
    char8 Char
    '"' 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 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 Char
    '"')

    instance ToField HStoreBuilder where
        toField :: HStoreBuilder -> Action
    toField  HStoreBuilder
    Empty    = ByteString -> Action
    forall a. ToField a => a -> Action
    toField (ByteString
    BS.empty)
        toField (Comma 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
    $cshowsPrec :: Int -> HStoreList -> ShowS
    showsPrec :: Int -> HStoreList -> ShowS
    $cshow :: HStoreList -> String
    show :: HStoreList -> String
    $cshowList :: [HStoreList] -> ShowS
    showList :: [HStoreList] -> ShowS
    Show)

    -- | hstore
    instance ToHStore HStoreList where
        toHStore :: HStoreList -> HStoreBuilder
    toHStore (HStoreList [(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 HStoreList
    xs = HStoreBuilder -> Action
    forall a. ToField a => a -> Action
    toField (HStoreList -> HStoreBuilder
    forall a. ToHStore a => a -> HStoreBuilder
    toHStore HStoreList
    xs)

    -- | hstore
    instance FromField HStoreList where
        fromField :: FieldParser HStoreList
    fromField Field
    f Maybe ByteString
    mdat = do
          typ <- Field -> Conversion ByteString
    typename Field
    f
          if typ /= "hstore"
            then returnError Incompatible f ""
            else case mdat of
                   Maybe ByteString
    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 String
    ""
                   Just 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 a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    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 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 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 String
    "unicode exception" Conversion HStoreList
    -> Conversion HStoreList -> Conversion HStoreList
    forall a. Conversion a -> Conversion a -> Conversion a
    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 HStoreList
    val) ->
                             HStoreList -> Conversion HStoreList
    forall a. a -> Conversion a
    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
    $c== :: HStoreMap -> HStoreMap -> Bool
    == :: HStoreMap -> HStoreMap -> Bool
    $c/= :: HStoreMap -> HStoreMap -> Bool
    /= :: 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
    $ccompare :: HStoreMap -> HStoreMap -> Ordering
    compare :: HStoreMap -> HStoreMap -> Ordering
    $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
    >= :: HStoreMap -> HStoreMap -> Bool
    $cmax :: HStoreMap -> HStoreMap -> HStoreMap
    max :: HStoreMap -> HStoreMap -> HStoreMap
    $cmin :: HStoreMap -> HStoreMap -> HStoreMap
    min :: HStoreMap -> HStoreMap -> 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
    $cshowsPrec :: Int -> HStoreMap -> ShowS
    showsPrec :: Int -> HStoreMap -> ShowS
    $cshow :: HStoreMap -> String
    show :: HStoreMap -> String
    $cshowList :: [HStoreMap] -> ShowS
    showList :: [HStoreMap] -> ShowS
    Show)

    instance ToHStore HStoreMap where
        toHStore :: HStoreMap -> HStoreBuilder
    toHStore (HStoreMap 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 a
    k b
    v 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 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 Field
    f 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 [(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 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 a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    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 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 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 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
        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 a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    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 a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Word8 -> Parser ByteString Word8
    P.word8 (Char -> Word8
    c2w Char
    ','))
        return $ HStoreList <$> sequence kvs

    parseHStoreKeyVal :: P.Parser (Either UnicodeException (Text,Text))
    parseHStoreKeyVal :: Parser ByteString (Either UnicodeException (Text, Text))
    parseHStoreKeyVal = do
      mkey <- Parser (Either UnicodeException Text)
    parseHStoreText
      case mkey of
        Left UnicodeException
    err -> Either UnicodeException (Text, Text)
    -> Parser ByteString (Either UnicodeException (Text, Text))
    forall a. a -> Parser ByteString a
    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 Text
    key -> do
          Parser ByteString ()
    skipWhiteSpace
          _ <- ByteString -> Parser ByteString
    P.string ByteString
    "=>"
          skipWhiteSpace
          mval <- parseHStoreText
          case mval of
            Left  UnicodeException
    err -> Either UnicodeException (Text, Text)
    -> Parser ByteString (Either UnicodeException (Text, Text))
    forall a. a -> Parser ByteString a
    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 Text
    val -> Either UnicodeException (Text, Text)
    -> Parser ByteString (Either UnicodeException (Text, Text))
    forall a. a -> Parser ByteString a
    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 -> Parser ByteString Word8
    P.word8 (Char -> Word8
    c2w Char
    '"')
      mtexts <- parseHStoreTexts id
      case mtexts of
        Left  UnicodeException
    err   -> Either UnicodeException Text
    -> Parser (Either UnicodeException Text)
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UnicodeException -> Either UnicodeException Text
    forall a b. a -> Either a b
    Left UnicodeException
    err)
        Right [Text]
    texts -> do
                         _ <- Word8 -> Parser ByteString Word8
    P.word8 (Char -> Word8
    c2w Char
    '"')
                         return (Right (TS.concat texts))

    parseHStoreTexts :: ([Text] -> [Text])
                     -> P.Parser (Either UnicodeException [Text])
    parseHStoreTexts :: ([Text] -> [Text]) -> Parser (Either UnicodeException [Text])
    parseHStoreTexts [Text] -> [Text]
    acc = do
      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 mchunk of
        Left UnicodeException
    err    -> Either UnicodeException [Text]
    -> Parser (Either UnicodeException [Text])
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UnicodeException -> Either UnicodeException [Text]
    forall a b. a -> Either a b
    Left UnicodeException
    err)
        Right Text
    chunk ->
            (do
              _ <- Word8 -> Parser ByteString Word8
    P.word8 (Char -> Word8
    c2w Char
    '\\')
              c <- TS.singleton . w2c <$> P.satisfy isSpecialChar
              parseHStoreTexts (acc . (chunk:) . (c:))
            ) Parser (Either UnicodeException [Text])
    -> Parser (Either UnicodeException [Text])
    -> Parser (Either UnicodeException [Text])
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Either UnicodeException [Text]
    -> Parser (Either UnicodeException [Text])
    forall a. a -> Parser ByteString a
    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 Word8
    c = Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    c2w Char
    '\\' Bool -> Bool -> Bool
    || Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    c2w Char
    '"'