HDBC-postgresql-hstore-0.0.1.2: Database/HDBC/PostgreSQL/HStore.hs

-- | Read and write stuff in hstore columns.
--
-- Insert crap into table:
--
-- @
-- let myStuff = [(\"test\", \"shmest\"), (\"spam\", \"eggs\"), (\"sausage\", \"salad\")]
-- withTransaction conn $ \trans -> run trans (\"INSERT INTO test_hstore (stuff) VALUES (\" ++ hsQuery myStuff  ++ \");\") (hsParams myStuff)
-- @
--
-- Parse hstore data:
--
-- @
-- rows <- quickQuery conn \"SELECT * FROM test_hstore;\" []
-- forM_ rows $ \[pk, hstuff] -> print $ (fromSql pk :: Integer, hsParse hstuff)
-- @
--

module Database.HDBC.PostgreSQL.HStore where

import Database.HDBC

import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import qualified Data.Text as T
import qualified Data.Attoparsec.Text as AP

import qualified Data.List as L
import qualified Data.Map as M

-- * Make a query

-- | Generate a placeholder string.
hsQuery :: [(String, String)] -> String
hsQuery = L.intercalate " || " . map (\(_, _) -> "hstore(?, ?)")

-- | Generate a parameter list.
hsParams :: [(String, String)] -> [SqlValue]
hsParams = L.concatMap (\(k, v) -> [toSql k, toSql v])

-- * Parse results

-- | Parse a SqlByteString with hstore data to a Map Text Text.
hsParse :: SqlValue -> M.Map Text Text
hsParse (SqlByteString bs) = case hstoreParser `AP.parseOnly` decodeUtf8 bs of
                                 Left err -> error err
                                 Right val -> val

-- ** Parser internals

-- | Parse hstore-formatted value.
hstoreParser :: AP.Parser (M.Map Text Text)
hstoreParser = do
    pairs <- kvPair `AP.sepBy` AP.string (T.pack ", ")
    return $! M.fromList pairs

-- | Parse one key-value pair.
kvPair :: AP.Parser (Text, Text)
kvPair = do
    key <- doubleQuoted
    AP.string $ T.pack "=>"
    value <- doubleQuoted
    return (key, value)

-- | Grab a value, unquote, unslash.
doubleQuoted :: AP.Parser Text
doubleQuoted = do
    AP.char '"'
    str <- AP.scan False $ \s c -> if s then Just False
                                        else if c == '"'
                                             then Nothing
                                             else Just (c == '\\')
    AP.char '"'

    return $! T.replace (T.pack "\\\"") (T.singleton '"') str