{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.Groundhog.Postgresql.HStore
(
HStore (..),
(->.),
lookupArr,
hstoreConcat,
deleteKey,
deleteKeys,
difference,
hstore_to_array,
hstore_to_matrix,
akeys,
avals,
slice,
hstore_to_json,
hstore_to_json_loose,
exist,
defined,
(?&),
(?|),
(@>),
(<@),
)
where
import Data.Aeson (Value)
import qualified Data.ByteString.Lazy as B (toStrict)
import qualified Data.Map as Map
import Data.String
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import Database.Groundhog.Core
import Database.Groundhog.Expression
import Database.Groundhog.Generic
import Database.Groundhog.Generic.Sql
import Database.Groundhog.Postgresql
import Database.Groundhog.Postgresql.Array (Array)
import Database.PostgreSQL.Simple.HStore
newtype HStore = HStore (Map.Map Text Text)
deriving (HStore -> HStore -> Bool
(HStore -> HStore -> Bool)
-> (HStore -> HStore -> Bool) -> Eq HStore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HStore -> HStore -> Bool
$c/= :: HStore -> HStore -> Bool
== :: HStore -> HStore -> Bool
$c== :: HStore -> HStore -> Bool
Eq, Eq HStore
Eq HStore
-> (HStore -> HStore -> Ordering)
-> (HStore -> HStore -> Bool)
-> (HStore -> HStore -> Bool)
-> (HStore -> HStore -> Bool)
-> (HStore -> HStore -> Bool)
-> (HStore -> HStore -> HStore)
-> (HStore -> HStore -> HStore)
-> Ord HStore
HStore -> HStore -> Bool
HStore -> HStore -> Ordering
HStore -> HStore -> HStore
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 :: HStore -> HStore -> HStore
$cmin :: HStore -> HStore -> HStore
max :: HStore -> HStore -> HStore
$cmax :: HStore -> HStore -> HStore
>= :: HStore -> HStore -> Bool
$c>= :: HStore -> HStore -> Bool
> :: HStore -> HStore -> Bool
$c> :: HStore -> HStore -> Bool
<= :: HStore -> HStore -> Bool
$c<= :: HStore -> HStore -> Bool
< :: HStore -> HStore -> Bool
$c< :: HStore -> HStore -> Bool
compare :: HStore -> HStore -> Ordering
$ccompare :: HStore -> HStore -> Ordering
$cp1Ord :: Eq HStore
Ord, Int -> HStore -> ShowS
[HStore] -> ShowS
HStore -> String
(Int -> HStore -> ShowS)
-> (HStore -> String) -> ([HStore] -> ShowS) -> Show HStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HStore] -> ShowS
$cshowList :: [HStore] -> ShowS
show :: HStore -> String
$cshow :: HStore -> String
showsPrec :: Int -> HStore -> ShowS
$cshowsPrec :: Int -> HStore -> ShowS
Show)
instance PersistField HStore where
persistName :: HStore -> String
persistName HStore
_ = String
"HStore"
toPersistValues :: HStore -> m ([PersistValue] -> [PersistValue])
toPersistValues = HStore -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
fromPersistValues :: [PersistValue] -> m (HStore, [PersistValue])
fromPersistValues = [PersistValue] -> m (HStore, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
dbType :: proxy db -> HStore -> DbType
dbType proxy db
_ HStore
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive (OtherTypeDef' String -> DbTypePrimitive
forall str. OtherTypeDef' str -> DbTypePrimitive' str
DbOther (OtherTypeDef' String -> DbTypePrimitive)
-> OtherTypeDef' String -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ [Either String DbTypePrimitive] -> OtherTypeDef' String
forall str.
[Either str (DbTypePrimitive' str)] -> OtherTypeDef' str
OtherTypeDef [String -> Either String DbTypePrimitive
forall a b. a -> Either a b
Left String
"hstore"]) Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing
instance PrimitivePersistField HStore where
toPrimitivePersistValue :: HStore -> PersistValue
toPrimitivePersistValue (HStore Map Text Text
a) = Utf8 -> [PersistValue] -> PersistValue
PersistCustom Utf8
"E?::hstore" [Text -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HStoreBuilder -> ByteString
toLazyByteString (HStoreMap -> HStoreBuilder
forall a. ToHStore a => a -> HStoreBuilder
toHStore (Map Text Text -> HStoreMap
HStoreMap Map Text Text
a))]
fromPrimitivePersistValue :: PersistValue -> HStore
fromPrimitivePersistValue PersistValue
x = case ByteString -> Either String HStoreList
parseHStoreList (ByteString -> Either String HStoreList)
-> ByteString -> Either String HStoreList
forall a b. (a -> b) -> a -> b
$ PersistValue -> ByteString
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue PersistValue
x of
Left String
err -> String -> HStore
forall a. HasCallStack => String -> a
error (String -> HStore) -> String -> HStore
forall a b. (a -> b) -> a -> b
$ String
"HStore: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
Right (HStoreList [(Text, Text)]
val) -> Map Text Text -> HStore
HStore (Map Text Text -> HStore) -> Map Text Text -> HStore
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
val
psqlOperatorExpr :: (db ~ Postgresql, Expression db r a, Expression db r b, PersistField c) => String -> a -> b -> Expr db r c
psqlOperatorExpr :: String -> a -> b -> Expr db r c
psqlOperatorExpr String
op a
x b
y = Snippet db r -> Expr db r c
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r c) -> Snippet db r -> Expr db r c
forall a b. (a -> b) -> a -> b
$ Int -> String -> a -> b -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
50 String
op a
x b
y
psqlOperatorCond :: (db ~ Postgresql, Expression db r a, Expression db r b) => String -> a -> b -> Cond db r
psqlOperatorCond :: String -> a -> b -> Cond db r
psqlOperatorCond String
op a
x b
y = QueryRaw db r -> Cond db r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw db r -> Cond db r) -> QueryRaw db r -> Cond db r
forall a b. (a -> b) -> a -> b
$ Int -> String -> a -> b -> Snippet Postgresql r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
50 String
op a
x b
y
(->.) ::
(db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r key key', IsString key') =>
hstore ->
key ->
Expr db r (Maybe Text)
->. :: hstore -> key -> Expr db r (Maybe Text)
(->.) = String -> hstore -> key -> Expr db r (Maybe Text)
forall db r a b c.
(db ~ Postgresql, Expression db r a, Expression db r b,
PersistField c) =>
String -> a -> b -> Expr db r c
psqlOperatorExpr String
"->"
lookupArr ::
(db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text)) =>
hstore ->
keys ->
Expr db r (Array Text)
lookupArr :: hstore -> keys -> Expr db r (Array Text)
lookupArr = String -> hstore -> keys -> Expr db r (Array Text)
forall db r a b c.
(db ~ Postgresql, Expression db r a, Expression db r b,
PersistField c) =>
String -> a -> b -> Expr db r c
psqlOperatorExpr String
"->"
hstoreConcat ::
(db ~ Postgresql, ExpressionOf db r hstore1 HStore, ExpressionOf db r hstore2 HStore) =>
hstore1 ->
hstore2 ->
Expr db r HStore
hstoreConcat :: hstore1 -> hstore2 -> Expr db r HStore
hstoreConcat = String -> hstore1 -> hstore2 -> Expr db r HStore
forall db r a b c.
(db ~ Postgresql, Expression db r a, Expression db r b,
PersistField c) =>
String -> a -> b -> Expr db r c
psqlOperatorExpr String
"||"
exist ::
(db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r key key', IsString key') =>
hstore ->
key ->
Cond db r
exist :: hstore -> key -> Cond db r
exist hstore
h key
k = QueryRaw db r -> Cond db r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw db r -> Cond db r) -> QueryRaw db r -> Cond db r
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr Postgresql r] -> Snippet Postgresql r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"exist" [hstore -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore
h, key -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr key
k]
defined ::
(db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r key key', IsString key') =>
hstore ->
key ->
Cond db r
defined :: hstore -> key -> Cond db r
defined hstore
h key
k = QueryRaw db r -> Cond db r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw db r -> Cond db r) -> QueryRaw db r -> Cond db r
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr Postgresql r] -> Snippet Postgresql r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"defined" [hstore -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore
h, key -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr key
k]
(?&) ::
(db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text)) =>
hstore ->
keys ->
Cond db r
?& :: hstore -> keys -> Cond db r
(?&) = String -> hstore -> keys -> Cond db r
forall db r a b.
(db ~ Postgresql, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"?&"
(?|) ::
(db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text)) =>
hstore ->
keys ->
Cond db r
?| :: hstore -> keys -> Cond db r
(?|) = String -> hstore -> keys -> Cond db r
forall db r a b.
(db ~ Postgresql, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"?|"
(@>) ::
(db ~ Postgresql, ExpressionOf db r hstore1 HStore, ExpressionOf db r hstore2 HStore) =>
hstore1 ->
hstore2 ->
Cond db r
@> :: hstore1 -> hstore2 -> Cond db r
(@>) = String -> hstore1 -> hstore2 -> Cond db r
forall db r a b.
(db ~ Postgresql, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"@>"
(<@) ::
(db ~ Postgresql, ExpressionOf db r hstore1 HStore, ExpressionOf db r hstore2 HStore) =>
hstore1 ->
hstore2 ->
Cond db r
<@ :: hstore1 -> hstore2 -> Cond db r
(<@) = String -> hstore1 -> hstore2 -> Cond db r
forall db r a b.
(db ~ Postgresql, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"<@"
deleteKey ::
(db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r key key', IsString key') =>
hstore ->
key ->
Expr db r HStore
deleteKey :: hstore -> key -> Expr db r HStore
deleteKey hstore
h key
k = Snippet db r -> Expr db r HStore
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r HStore)
-> Snippet db r -> Expr db r HStore
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"delete" [hstore -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore
h, key -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr key
k]
deleteKeys ::
(db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text)) =>
hstore ->
keys ->
Expr db r HStore
deleteKeys :: hstore -> keys -> Expr db r HStore
deleteKeys hstore
h keys
k = Snippet db r -> Expr db r HStore
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r HStore)
-> Snippet db r -> Expr db r HStore
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"delete" [hstore -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore
h, keys -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr keys
k]
difference ::
(db ~ Postgresql, ExpressionOf db r hstore1 HStore, ExpressionOf db r hstore2 HStore) =>
hstore1 ->
hstore2 ->
Expr db r HStore
difference :: hstore1 -> hstore2 -> Expr db r HStore
difference hstore1
h1 hstore2
h2 = Snippet db r -> Expr db r HStore
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r HStore)
-> Snippet db r -> Expr db r HStore
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"delete" [hstore1 -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore1
h1, hstore2 -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore2
h2]
hstore_to_array ::
(db ~ Postgresql, ExpressionOf db r hstore HStore) =>
hstore ->
Expr db r (Array Text)
hstore_to_array :: hstore -> Expr db r (Array Text)
hstore_to_array hstore
h = Snippet db r -> Expr db r (Array Text)
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r (Array Text))
-> Snippet db r -> Expr db r (Array Text)
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"hstore_to_array" [hstore -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore
h]
hstore_to_matrix ::
(db ~ Postgresql, ExpressionOf db r hstore HStore) =>
hstore ->
Expr db r (Array (Array Text))
hstore_to_matrix :: hstore -> Expr db r (Array (Array Text))
hstore_to_matrix hstore
h = Snippet db r -> Expr db r (Array (Array Text))
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r (Array (Array Text)))
-> Snippet db r -> Expr db r (Array (Array Text))
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"hstore_to_matrix" [hstore -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore
h]
akeys ::
(db ~ Postgresql, ExpressionOf db r hstore HStore) =>
hstore ->
Expr db r (Array Text)
akeys :: hstore -> Expr db r (Array Text)
akeys hstore
h = Snippet db r -> Expr db r (Array Text)
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r (Array Text))
-> Snippet db r -> Expr db r (Array Text)
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"akeys" [hstore -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore
h]
avals ::
(db ~ Postgresql, ExpressionOf db r hstore HStore) =>
hstore ->
Expr db r (Array Text)
avals :: hstore -> Expr db r (Array Text)
avals hstore
h = Snippet db r -> Expr db r (Array Text)
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r (Array Text))
-> Snippet db r -> Expr db r (Array Text)
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"vals" [hstore -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore
h]
hstore_to_json ::
(db ~ Postgresql, ExpressionOf db r hstore HStore) =>
hstore ->
Expr db r Value
hstore_to_json :: hstore -> Expr db r Value
hstore_to_json hstore
h = Snippet db r -> Expr db r Value
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r Value)
-> Snippet db r -> Expr db r Value
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"hstore_to_json" [hstore -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore
h]
hstore_to_json_loose ::
(db ~ Postgresql, ExpressionOf db r hstore HStore) =>
hstore ->
Expr db r Value
hstore_to_json_loose :: hstore -> Expr db r Value
hstore_to_json_loose hstore
h = Snippet db r -> Expr db r Value
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r Value)
-> Snippet db r -> Expr db r Value
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"hstore_to_json_loose" [hstore -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore
h]
slice ::
(db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text)) =>
hstore ->
keys ->
Expr db r HStore
slice :: hstore -> keys -> Expr db r HStore
slice hstore
h keys
k = Snippet db r -> Expr db r HStore
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r HStore)
-> Snippet db r -> Expr db r HStore
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"slice" [hstore -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr hstore
h, keys -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr keys
k]