{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | See detailed documentation for PostgreSQL arrays at http://www.postgresql.org/docs/9.2/static/arrays.html and http://www.postgresql.org/docs/9.2/static/functions-array.html
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)

-- | Represents PostgreSQL arrays
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
'}')

-- Borrowed from aeson
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_ #-}

-- Borrowed from aeson
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]

-- | Concatenates array elements using supplied delimiter. array_to_string(ARRAY[1, 2, 3], '~^~') = 1~^~2~^~3
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]

-- | Splits string into array elements using supplied delimiter. string_to_array('xx~^~yy~^~zz', '~^~') = {xx,yy,zz}
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
')']

-- | Contains. ARRAY[1,4,3] \@> ARRAY[3,1] = t
(@>) :: (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

-- | Is contained by. ARRAY[2,7] <\@ ARRAY[1,7,4,2,6] = t
(<@) :: (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

-- | Overlap (have elements in common). ARRAY[1,4,3] && ARRAY[2,1] = t
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