{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Database.Groundhog.Postgresql.Array
( Array (..),
(!),
(!:),
append,
prepend,
arrayCat,
arrayDims,
arrayNDims,
arrayLower,
arrayUpper,
arrayLength,
arrayToString,
stringToArray,
any,
all,
(@>),
(<@),
overlaps,
)
where
import Control.Applicative
import Control.Monad (mzero)
import qualified Data.Aeson as A
import qualified Data.Attoparsec.ByteString as A
import Data.Attoparsec.ByteString.Char8
import qualified Data.Attoparsec.Zepto as Z
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Lazy as B (toStrict)
import qualified Data.ByteString.Unsafe as B
import Data.Monoid hiding ((<>))
import qualified Data.Vector as V
import Data.Word
import Database.Groundhog.Core
import Database.Groundhog.Expression
import Database.Groundhog.Generic
import Database.Groundhog.Generic.Sql hiding (append)
import Database.Groundhog.Postgresql hiding (append)
import Prelude hiding (all, any)
newtype Array a = Array [a] deriving (Array a -> Array a -> Bool
(Array a -> Array a -> Bool)
-> (Array a -> Array a -> Bool) -> Eq (Array a)
forall a. Eq a => Array a -> Array a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Array a -> Array a -> Bool
$c/= :: forall a. Eq a => Array a -> Array a -> Bool
== :: Array a -> Array a -> Bool
$c== :: forall a. Eq a => Array a -> Array a -> Bool
Eq, Int -> Array a -> ShowS
[Array a] -> ShowS
Array a -> String
(Int -> Array a -> ShowS)
-> (Array a -> String) -> ([Array a] -> ShowS) -> Show (Array a)
forall a. Show a => Int -> Array a -> ShowS
forall a. Show a => [Array a] -> ShowS
forall a. Show a => Array a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Array a] -> ShowS
$cshowList :: forall a. Show a => [Array a] -> ShowS
show :: Array a -> String
$cshow :: forall a. Show a => Array a -> String
showsPrec :: Int -> Array a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Array a -> ShowS
Show)
instance A.ToJSON a => A.ToJSON (Array a) where
toJSON :: Array a -> Value
toJSON (Array [a]
xs) = [a] -> Value
forall a. ToJSON a => a -> Value
A.toJSON [a]
xs
instance A.FromJSON a => A.FromJSON (Array a) where
parseJSON :: Value -> Parser (Array a)
parseJSON (A.Array Array
xs) = (Vector a -> Array a) -> Parser (Vector a) -> Parser (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a] -> Array a
forall a. [a] -> Array a
Array ([a] -> Array a) -> (Vector a -> [a]) -> Vector a -> Array a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Vector a -> [a]
V.toList) ((Value -> Parser a) -> Array -> Parser (Vector a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser a
forall a. FromJSON a => Value -> Parser a
A.parseJSON Array
xs)
parseJSON Value
_ = Parser (Array a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance (ArrayElem a, PrimitivePersistField a) => PersistField (Array a) where
persistName :: Array a -> String
persistName Array a
a = String
"Array" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> ShowS
forall a. a -> [a] -> [a]
: a -> String
forall a. PersistField a => a -> String
persistName ((forall a. Array a -> a
forall a. HasCallStack => a
undefined :: Array a -> a) Array a
a)
toPersistValues :: Array a -> m ([PersistValue] -> [PersistValue])
toPersistValues = Array a -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
fromPersistValues :: [PersistValue] -> m (Array a, [PersistValue])
fromPersistValues = [PersistValue] -> m (Array a, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
dbType :: proxy db -> Array a -> DbType
dbType proxy db
p Array a
a = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive (proxy db -> Array a -> DbTypePrimitive
forall db a (proxy :: * -> *).
(DbDescriptor db, ArrayElem a, PrimitivePersistField a) =>
proxy db -> Array a -> DbTypePrimitive
arrayType proxy db
p Array a
a) Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing
arrayType :: (DbDescriptor db, ArrayElem a, PrimitivePersistField a) => proxy db -> Array a -> DbTypePrimitive
arrayType :: proxy db -> Array a -> DbTypePrimitive
arrayType proxy db
p Array a
a = 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 [DbTypePrimitive -> Either String DbTypePrimitive
forall a b. b -> Either a b
Right DbTypePrimitive
elemType, String -> Either String DbTypePrimitive
forall a b. a -> Either a b
Left String
"[]"]
where
elemType :: DbTypePrimitive
elemType = case proxy db -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
p ((forall a. Array a -> a
forall a. HasCallStack => a
undefined :: Array a -> a) Array a
a) of
DbTypePrimitive DbTypePrimitive
t Bool
_ Maybe String
_ Maybe ParentTableReference
_ -> DbTypePrimitive
t
DbType
t -> String -> DbTypePrimitive
forall a. HasCallStack => String -> a
error (String -> DbTypePrimitive) -> String -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ String
"arrayType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Array a -> String
forall a. PersistField a => a -> String
persistName Array a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": expected DbTypePrimitive, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DbType -> String
forall a. Show a => a -> String
show DbType
t
class ArrayElem a where
parseElem :: Parser a
instance {-# OVERLAPPABLE #-} ArrayElem a => ArrayElem (Array a) where
parseElem :: Parser (Array a)
parseElem = Parser (Array a)
forall a. ArrayElem a => Parser (Array a)
parseArr
instance {-# OVERLAPPABLE #-} PrimitivePersistField a => ArrayElem a where
parseElem :: Parser a
parseElem = (ByteString -> a) -> Parser ByteString ByteString -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PersistValue -> a
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue (PersistValue -> a)
-> (ByteString -> PersistValue) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PersistValue
PersistByteString) Parser ByteString ByteString
parseString
instance (ArrayElem a, PrimitivePersistField a) => PrimitivePersistField (Array a) where
toPrimitivePersistValue :: Array a -> PersistValue
toPrimitivePersistValue (Array [a]
xs) = Utf8 -> [PersistValue] -> PersistValue
PersistCustom Utf8
arr ([PersistValue] -> [PersistValue]
vals [])
where
arr :: Utf8
arr = Utf8
"ARRAY[" Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
query Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
"]::" Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> String -> Utf8
forall a. IsString a => String -> a
fromString String
typ
RenderS Utf8
query [PersistValue] -> [PersistValue]
vals = [RenderS Any Any] -> RenderS Any Any
forall s. StringLike s => [s] -> s
commasJoin ([RenderS Any Any] -> RenderS Any Any)
-> [RenderS Any Any] -> RenderS Any Any
forall a b. (a -> b) -> a -> b
$ (a -> RenderS Any Any) -> [a] -> [RenderS Any Any]
forall a b. (a -> b) -> [a] -> [b]
map (PersistValue -> RenderS Any Any
forall db r. PersistValue -> RenderS db r
renderPersistValue (PersistValue -> RenderS Any Any)
-> (a -> PersistValue) -> a -> RenderS Any Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue) [a]
xs
typ :: String
typ = DbTypePrimitive -> String
showSqlType (DbTypePrimitive -> String) -> DbTypePrimitive -> String
forall a b. (a -> b) -> a -> b
$ Any Postgresql -> Array a -> DbTypePrimitive
forall db a (proxy :: * -> *).
(DbDescriptor db, ArrayElem a, PrimitivePersistField a) =>
proxy db -> Array a -> DbTypePrimitive
arrayType (forall a. HasCallStack => a
forall (p :: * -> *). p Postgresql
undefined :: p Postgresql) (Array a -> DbTypePrimitive) -> Array a -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ [a] -> Array a
forall a. [a] -> Array a
Array [a]
xs
fromPrimitivePersistValue :: PersistValue -> Array a
fromPrimitivePersistValue PersistValue
a = Parser (Array a) -> PersistValue -> Array a
forall a. Parser a -> PersistValue -> a
parseHelper Parser (Array a)
parser PersistValue
a
where
dimensions :: Parser ByteString Char
dimensions = Char -> Parser ByteString Char
char Char
'[' Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=') Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString Char
char Char
'='
parser :: Parser (Array a)
parser = Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Char
dimensions Parser ByteString (Maybe Char)
-> Parser (Array a) -> Parser (Array a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Array a)
forall a. ArrayElem a => Parser (Array a)
parseArr
parseString :: Parser ByteString
parseString :: Parser ByteString ByteString
parseString =
(Char -> Parser ByteString Char
char Char
'"' Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
jstring_)
Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser ByteString ByteString
takeWhile1 (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}')
jstring_ :: Parser ByteString
jstring_ :: Parser ByteString ByteString
jstring_ =
{-# SCC "jstring_" #-}
do
ByteString
s <- Bool
-> (Bool -> Word8 -> Maybe Bool) -> Parser ByteString ByteString
forall s.
s -> (s -> Word8 -> Maybe s) -> Parser ByteString ByteString
A.scan Bool
False ((Bool -> Word8 -> Maybe Bool) -> Parser ByteString ByteString)
-> (Bool -> Word8 -> Maybe Bool) -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \Bool
s Word8
c ->
if Bool
s
then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
else
if Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
doubleQuote
then Maybe Bool
forall a. Maybe a
Nothing
else Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
backslash)
Word8
_ <- Word8 -> Parser Word8
A.word8 Word8
doubleQuote
if Word8
backslash Word8 -> ByteString -> Bool
`B.elem` ByteString
s
then case Parser ByteString -> ByteString -> Either String ByteString
forall a. Parser a -> ByteString -> Either String a
Z.parse Parser ByteString
unescape ByteString
s of
Right ByteString
r -> ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
r
Left String
err -> String -> Parser ByteString ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
else ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
{-# INLINE jstring_ #-}
unescape :: Z.Parser ByteString
unescape :: Parser ByteString
unescape = ByteString -> ByteString
B.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> ZeptoT Identity Builder -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Builder -> ZeptoT Identity Builder
forall (m :: * -> *). Monad m => Builder -> ZeptoT m Builder
go Builder
forall a. Monoid a => a
mempty
where
go :: Builder -> ZeptoT m Builder
go Builder
acc = do
ByteString
h <- (Word8 -> Bool) -> ZeptoT m ByteString
forall (m :: * -> *).
Monad m =>
(Word8 -> Bool) -> ZeptoT m ByteString
Z.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
backslash)
let rest :: ZeptoT m Builder
rest = do
ByteString
start <- Int -> ZeptoT m ByteString
forall (m :: * -> *). Monad m => Int -> ZeptoT m ByteString
Z.take Int
2
let !slash :: Word8
slash = ByteString -> Word8
B.unsafeHead ByteString
start
!t :: Word8
t = ByteString -> Int -> Word8
B.unsafeIndex ByteString
start Int
1
escape :: Word8
escape =
if Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
doubleQuote Bool -> Bool -> Bool
|| Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
backslash
then Word8
t
else Word8
255
if Word8
slash Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
backslash Bool -> Bool -> Bool
|| Word8
escape Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
255
then String -> ZeptoT m Builder
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid array escape sequence"
else do
let cont :: Builder -> ZeptoT m Builder
cont Builder
m = Builder -> ZeptoT m Builder
go (Builder
acc Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
B.byteString ByteString
h Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
m)
{-# INLINE cont #-}
Builder -> ZeptoT m Builder
cont (Word8 -> Builder
B.word8 Word8
escape)
Bool
done <- ZeptoT m Bool
forall (m :: * -> *). Monad m => ZeptoT m Bool
Z.atEnd
if Bool
done
then Builder -> ZeptoT m Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder
acc Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
B.byteString ByteString
h)
else ZeptoT m Builder
rest
doubleQuote, backslash :: Word8
doubleQuote :: Word8
doubleQuote = Word8
34
backslash :: Word8
backslash = Word8
92
parseArr :: ArrayElem a => Parser (Array a)
parseArr :: Parser (Array a)
parseArr = [a] -> Array a
forall a. [a] -> Array a
Array ([a] -> Array a) -> Parser ByteString [a] -> Parser (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser ByteString Char
char Char
'{' Parser ByteString Char
-> Parser ByteString [a] -> Parser ByteString [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
forall a. ArrayElem a => Parser a
parseElem Parser a -> Parser ByteString Char -> Parser ByteString [a]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Char -> Parser ByteString Char
char Char
',' Parser ByteString [a]
-> Parser ByteString Char -> Parser ByteString [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
char Char
'}')
(!) :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r b Int, PersistField elem) => a -> b -> Expr Postgresql r elem
(!) a
arr b
i = Snippet Postgresql r -> Expr Postgresql r elem
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r elem)
-> Snippet Postgresql r -> Expr Postgresql r elem
forall a b. (a -> b) -> a -> b
$ (RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r)
-> (RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
_ -> [RenderConfig -> UntypedExpr Postgresql r -> RenderS Postgresql r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
arr) RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
"[" RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderConfig -> UntypedExpr Postgresql r -> RenderS Postgresql r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (b -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr b
i) RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
"]"]
(!:) :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r i1 Int, ExpressionOf Postgresql r i2 Int) => a -> (i1, i2) -> Expr Postgresql r (Array elem)
!: :: a -> (i1, i2) -> Expr Postgresql r (Array elem)
(!:) a
arr (i1
i1, i2
i2) = Snippet Postgresql r -> Expr Postgresql r (Array elem)
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r (Array elem))
-> Snippet Postgresql r -> Expr Postgresql r (Array elem)
forall a b. (a -> b) -> a -> b
$ (RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r)
-> (RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
_ -> [RenderConfig -> UntypedExpr Postgresql r -> RenderS Postgresql r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
arr) RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
"[" RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderConfig -> UntypedExpr Postgresql r -> RenderS Postgresql r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (i1 -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr i1
i1) RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
":" RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderConfig -> UntypedExpr Postgresql r -> RenderS Postgresql r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (i2 -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr i2
i2) RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
"]"]
prepend :: (ExpressionOf Postgresql r a elem, ExpressionOf Postgresql r b (Array elem)) => a -> b -> Expr Postgresql r (Array elem)
prepend :: a -> b -> Expr Postgresql r (Array elem)
prepend a
a b
b = Snippet Postgresql r -> Expr Postgresql r (Array elem)
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r (Array elem))
-> Snippet Postgresql r -> Expr Postgresql r (Array elem)
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
"array_prepend" [a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a, b -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr b
b]
append :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r b elem) => a -> b -> Expr Postgresql r (Array elem)
append :: a -> b -> Expr Postgresql r (Array elem)
append a
a b
b = Snippet Postgresql r -> Expr Postgresql r (Array elem)
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r (Array elem))
-> Snippet Postgresql r -> Expr Postgresql r (Array elem)
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
"array_append" [a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a, b -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr b
b]
arrayCat :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r b (Array elem)) => a -> b -> Expr Postgresql r (Array elem)
arrayCat :: a -> b -> Expr Postgresql r (Array elem)
arrayCat a
a b
b = Snippet Postgresql r -> Expr Postgresql r (Array elem)
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r (Array elem))
-> Snippet Postgresql r -> Expr Postgresql r (Array elem)
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
"array_cat" [a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a, b -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr b
b]
arrayDims :: (ExpressionOf Postgresql r a (Array elem)) => a -> Expr Postgresql r String
arrayDims :: a -> Expr Postgresql r String
arrayDims a
arr = Snippet Postgresql r -> Expr Postgresql r String
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r String)
-> Snippet Postgresql r -> Expr Postgresql r String
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
"array_dims" [a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
arr]
arrayNDims :: (ExpressionOf Postgresql r a (Array elem)) => a -> Expr Postgresql r Int
arrayNDims :: a -> Expr Postgresql r Int
arrayNDims a
arr = Snippet Postgresql r -> Expr Postgresql r Int
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r Int)
-> Snippet Postgresql r -> Expr Postgresql r Int
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
"array_ndims" [a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
arr]
arrayLower :: (ExpressionOf Postgresql r a (Array elem)) => a -> Int -> Expr Postgresql r Int
arrayLower :: a -> Int -> Expr Postgresql r Int
arrayLower a
arr Int
dim = Snippet Postgresql r -> Expr Postgresql r Int
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r Int)
-> Snippet Postgresql r -> Expr Postgresql r Int
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
"array_lower" [a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
arr, Int -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Int
dim]
arrayUpper :: (ExpressionOf Postgresql r a (Array elem)) => a -> Int -> Expr Postgresql r Int
arrayUpper :: a -> Int -> Expr Postgresql r Int
arrayUpper a
arr Int
dim = Snippet Postgresql r -> Expr Postgresql r Int
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r Int)
-> Snippet Postgresql r -> Expr Postgresql r Int
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
"array_upper" [a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
arr, Int -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Int
dim]
arrayLength :: (ExpressionOf Postgresql r a (Array elem)) => a -> Int -> Expr Postgresql r Int
arrayLength :: a -> Int -> Expr Postgresql r Int
arrayLength a
arr Int
dim = Snippet Postgresql r -> Expr Postgresql r Int
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r Int)
-> Snippet Postgresql r -> Expr Postgresql r Int
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
"array_length" [a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
arr, Int -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Int
dim]
arrayToString :: (ExpressionOf Postgresql r a (Array elem)) => a -> String -> Expr Postgresql r String
arrayToString :: a -> String -> Expr Postgresql r String
arrayToString a
arr String
sep = Snippet Postgresql r -> Expr Postgresql r String
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r String)
-> Snippet Postgresql r -> Expr Postgresql r String
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
"array_to_string" [a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
arr, String -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr String
sep]
stringToArray :: (ExpressionOf Postgresql r a String) => a -> String -> Expr Postgresql r (Array String)
stringToArray :: a -> String -> Expr Postgresql r (Array String)
stringToArray a
arr String
sep = Snippet Postgresql r -> Expr Postgresql r (Array String)
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r (Array String))
-> Snippet Postgresql r -> Expr Postgresql r (Array String)
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
"string_to_array" [a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
arr, String -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr String
sep]
any :: (ExpressionOf Postgresql r a elem, ExpressionOf Postgresql r b (Array elem)) => a -> b -> Cond Postgresql r
any :: a -> b -> Cond Postgresql r
any a
a b
arr = QueryRaw Postgresql r -> Cond Postgresql r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw Postgresql r -> Cond Postgresql r)
-> QueryRaw Postgresql r -> Cond Postgresql r
forall a b. (a -> b) -> a -> b
$ (RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r)
-> (RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
_ -> [RenderConfig
-> Int -> UntypedExpr Postgresql r -> RenderS Postgresql r
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> RenderS db r
renderExprPriority RenderConfig
conf Int
37 (a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a) RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
"=ANY" RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS Postgresql r
forall a. StringLike a => Char -> a
fromChar Char
'(' RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderConfig -> UntypedExpr Postgresql r -> RenderS Postgresql r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (b -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr b
arr) RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS Postgresql r
forall a. StringLike a => Char -> a
fromChar Char
')']
all :: (ExpressionOf Postgresql r a elem, ExpressionOf Postgresql r b (Array elem)) => a -> b -> Cond Postgresql r
all :: a -> b -> Cond Postgresql r
all a
a b
arr = QueryRaw Postgresql r -> Cond Postgresql r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw Postgresql r -> Cond Postgresql r)
-> QueryRaw Postgresql r -> Cond Postgresql r
forall a b. (a -> b) -> a -> b
$ (RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r)
-> (RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
_ -> [RenderConfig
-> Int -> UntypedExpr Postgresql r -> RenderS Postgresql r
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> RenderS db r
renderExprPriority RenderConfig
conf Int
37 (a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a) RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
"=ALL" RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS Postgresql r
forall a. StringLike a => Char -> a
fromChar Char
'(' RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderConfig -> UntypedExpr Postgresql r -> RenderS Postgresql r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (b -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr b
arr) RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> Char -> RenderS Postgresql r
forall a. StringLike a => Char -> a
fromChar Char
')']
(@>) :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r b (Array elem)) => a -> b -> Cond Postgresql r
@> :: a -> b -> Cond Postgresql r
(@>) a
a b
b = QueryRaw Postgresql r -> Cond Postgresql r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw Postgresql r -> Cond Postgresql r)
-> QueryRaw Postgresql r -> Cond Postgresql 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
"@>" a
a b
b
(<@) :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r b (Array elem)) => a -> b -> Cond Postgresql r
<@ :: a -> b -> Cond Postgresql r
(<@) a
a b
b = QueryRaw Postgresql r -> Cond Postgresql r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw Postgresql r -> Cond Postgresql r)
-> QueryRaw Postgresql r -> Cond Postgresql 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
"<@" a
a b
b
overlaps :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r b (Array elem)) => a -> b -> Cond Postgresql r
overlaps :: a -> b -> Cond Postgresql r
overlaps a
a b
b = QueryRaw Postgresql r -> Cond Postgresql r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw Postgresql r -> Cond Postgresql r)
-> QueryRaw Postgresql r -> Cond Postgresql 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
"&&" a
a b
b
parseHelper :: Parser a -> PersistValue -> a
parseHelper :: Parser a -> PersistValue -> a
parseHelper Parser a
p (PersistByteString ByteString
bs) = (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> a
forall a. HasCallStack => String -> a
error a -> a
forall a. a -> a
id (Either String a -> a) -> Either String a -> a
forall a b. (a -> b) -> a -> b
$ Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser a
p ByteString
bs
parseHelper Parser a
_ PersistValue
a = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"parseHelper: expected PersistByteString, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
a