{-# language GADTs #-}
{-# language LambdaCase #-}
{-# language NamedFieldPuns #-}
{-# language OverloadedStrings #-}
{-# language TypeApplications #-}
{-# language ViewPatterns #-}

module Rel8.Type.Array
  ( array, encodeArrayElement, extractArrayElement
  , arrayTypeName
  , listTypeInformation
  , nonEmptyTypeInformation
  , head, index, last, length
  )
where

-- attoparsec
import qualified Data.Attoparsec.ByteString.Char8 as A

-- base
import Control.Applicative ((<|>), many)
import Data.Bifunctor (first)
import Data.Foldable (fold, toList)
import Data.List.NonEmpty ( NonEmpty, nonEmpty )
import Prelude hiding ( head, last, length, null, repeat, zipWith )

-- bytestring
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS

-- hasql
import qualified Hasql.Decoders as Hasql

-- opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

-- rel8
import Rel8.Schema.Null ( Unnullify, Nullity( Null, NotNull ) )
import Rel8.Type.Decoder (Decoder (..), NullableOrNot (..), Parser)
import Rel8.Type.Information ( TypeInformation(..), parseTypeInformation )
import Rel8.Type.Name (TypeName (..), showTypeName)
import Rel8.Type.Parser (parse)

-- text
import qualified Data.Text as Text


array :: Foldable f
  => TypeInformation a -> f Opaleye.PrimExpr -> Opaleye.PrimExpr
array :: forall (f :: * -> *) a.
Foldable f =>
TypeInformation a -> f PrimExpr -> PrimExpr
array TypeInformation a
info =
  [Char] -> PrimExpr -> PrimExpr
Opaleye.CastExpr (TypeName -> [Char]
showTypeName (TypeInformation a -> TypeName
forall a. TypeInformation a -> TypeName
arrayType TypeInformation a
info) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"[]") (PrimExpr -> PrimExpr)
-> (f PrimExpr -> PrimExpr) -> f PrimExpr -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [PrimExpr] -> PrimExpr
Opaleye.ArrayExpr ([PrimExpr] -> PrimExpr)
-> (f PrimExpr -> [PrimExpr]) -> f PrimExpr -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrimExpr -> PrimExpr) -> [PrimExpr] -> [PrimExpr]
forall a b. (a -> b) -> [a] -> [b]
map (TypeInformation a -> PrimExpr -> PrimExpr
forall a. TypeInformation a -> PrimExpr -> PrimExpr
encodeArrayElement TypeInformation a
info) ([PrimExpr] -> [PrimExpr])
-> (f PrimExpr -> [PrimExpr]) -> f PrimExpr -> [PrimExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f PrimExpr -> [PrimExpr]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# INLINABLE array #-}


listTypeInformation :: ()
  => Nullity a
  -> TypeInformation (Unnullify a)
  -> TypeInformation [a]
listTypeInformation :: forall a.
Nullity a -> TypeInformation (Unnullify a) -> TypeInformation [a]
listTypeInformation Nullity a
nullity info :: TypeInformation (Unnullify a)
info@TypeInformation {Unnullify a -> PrimExpr
encode :: Unnullify a -> PrimExpr
encode :: forall a. TypeInformation a -> a -> PrimExpr
encode, Decoder (Unnullify a)
decode :: Decoder (Unnullify a)
decode :: forall a. TypeInformation a -> Decoder a
decode} =
  TypeInformation
    { decode :: Decoder [a]
decode =
        Decoder
          { binary :: Value [a]
binary = NullableOrNot Value a -> Value [a]
forall element. NullableOrNot Value element -> Value [element]
Hasql.listArray (NullableOrNot Value a -> Value [a])
-> NullableOrNot Value a -> Value [a]
forall a b. (a -> b) -> a -> b
$ case Nullity a
nullity of
              Nullity a
Null -> Value a1 -> NullableOrNot Value (Maybe a1)
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
Hasql.nullable (TypeInformation a1 -> Decoder a1 -> Value a1
forall a x. TypeInformation a -> Decoder x -> Value x
decodeArrayElement TypeInformation a1
TypeInformation (Unnullify a)
info Decoder a1
Decoder (Unnullify a)
decode)
              Nullity a
NotNull -> Value a -> NullableOrNot Value a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
Hasql.nonNullable (TypeInformation a -> Decoder a -> Value a
forall a x. TypeInformation a -> Decoder x -> Value x
decodeArrayElement TypeInformation a
TypeInformation (Unnullify a)
info Decoder a
Decoder (Unnullify a)
decode)
          , parser :: Parser [a]
parser = case Nullity a
nullity of
              Nullity a
Null -> NullableOrNot Decoder a -> Parser [a]
forall a. NullableOrNot Decoder a -> Parser [a]
arrayParser (Decoder a1 -> NullableOrNot Decoder (Maybe a1)
forall (decoder :: * -> *) a1.
decoder a1 -> NullableOrNot decoder (Maybe a1)
Nullable Decoder a1
Decoder (Unnullify a)
decode)
              Nullity a
NotNull -> NullableOrNot Decoder a -> Parser [a]
forall a. NullableOrNot Decoder a -> Parser [a]
arrayParser (Decoder a -> NullableOrNot Decoder a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
NonNullable Decoder a
Decoder (Unnullify a)
decode)
          , delimiter :: Char
delimiter = Char
','
          }
    , encode :: [a] -> PrimExpr
encode = case Nullity a
nullity of
        Nullity a
Null ->
          [PrimExpr] -> PrimExpr
Opaleye.ArrayExpr ([PrimExpr] -> PrimExpr) -> ([a] -> [PrimExpr]) -> [a] -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (a -> PrimExpr) -> [a] -> [PrimExpr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeInformation a1 -> PrimExpr -> PrimExpr
forall a. TypeInformation a -> PrimExpr -> PrimExpr
encodeArrayElement TypeInformation a1
TypeInformation (Unnullify a)
info (PrimExpr -> PrimExpr) -> (a -> PrimExpr) -> a -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimExpr -> (a1 -> PrimExpr) -> Maybe a1 -> PrimExpr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PrimExpr
null a1 -> PrimExpr
Unnullify a -> PrimExpr
encode)
        Nullity a
NotNull ->
          [PrimExpr] -> PrimExpr
Opaleye.ArrayExpr ([PrimExpr] -> PrimExpr) -> ([a] -> [PrimExpr]) -> [a] -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (a -> PrimExpr) -> [a] -> [PrimExpr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeInformation a -> PrimExpr -> PrimExpr
forall a. TypeInformation a -> PrimExpr -> PrimExpr
encodeArrayElement TypeInformation a
TypeInformation (Unnullify a)
info (PrimExpr -> PrimExpr) -> (a -> PrimExpr) -> a -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PrimExpr
Unnullify a -> PrimExpr
encode)
    , typeName :: TypeName
typeName = TypeInformation (Unnullify a) -> TypeName
forall a. TypeInformation a -> TypeName
arrayTypeName TypeInformation (Unnullify a)
info
    }
  where
    null :: PrimExpr
null = Literal -> PrimExpr
Opaleye.ConstExpr Literal
Opaleye.NullLit


nonEmptyTypeInformation :: ()
  => Nullity a
  -> TypeInformation (Unnullify a)
  -> TypeInformation (NonEmpty a)
nonEmptyTypeInformation :: forall a.
Nullity a
-> TypeInformation (Unnullify a) -> TypeInformation (NonEmpty a)
nonEmptyTypeInformation Nullity a
nullity =
  ([a] -> Either [Char] (NonEmpty a))
-> (NonEmpty a -> [a])
-> TypeInformation [a]
-> TypeInformation (NonEmpty a)
forall a b.
(a -> Either [Char] b)
-> (b -> a) -> TypeInformation a -> TypeInformation b
parseTypeInformation [a] -> Either [Char] (NonEmpty a)
fromList NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TypeInformation [a] -> TypeInformation (NonEmpty a))
-> (TypeInformation (Unnullify' (IsMaybe a) a)
    -> TypeInformation [a])
-> TypeInformation (Unnullify' (IsMaybe a) a)
-> TypeInformation (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nullity a
-> TypeInformation (Unnullify' (IsMaybe a) a)
-> TypeInformation [a]
forall a.
Nullity a -> TypeInformation (Unnullify a) -> TypeInformation [a]
listTypeInformation Nullity a
nullity
  where
    fromList :: [a] -> Either [Char] (NonEmpty a)
fromList = Either [Char] (NonEmpty a)
-> (NonEmpty a -> Either [Char] (NonEmpty a))
-> Maybe (NonEmpty a)
-> Either [Char] (NonEmpty a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] (NonEmpty a)
forall a b. a -> Either a b
Left [Char]
message) NonEmpty a -> Either [Char] (NonEmpty a)
forall a b. b -> Either a b
Right (Maybe (NonEmpty a) -> Either [Char] (NonEmpty a))
-> ([a] -> Maybe (NonEmpty a)) -> [a] -> Either [Char] (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
    message :: [Char]
message = [Char]
"failed to decode NonEmptyList: got empty list"


arrayTypeName :: TypeInformation a -> TypeName
arrayTypeName :: forall a. TypeInformation a -> TypeName
arrayTypeName TypeInformation a
info = (TypeInformation a -> TypeName
forall a. TypeInformation a -> TypeName
arrayType TypeInformation a
info) {arrayDepth = 1}


isArray :: TypeInformation a -> Bool
isArray :: forall a. TypeInformation a -> Bool
isArray = (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0) (Word -> Bool)
-> (TypeInformation a -> Word) -> TypeInformation a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Word
arrayDepth (TypeName -> Word)
-> (TypeInformation a -> TypeName) -> TypeInformation a -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInformation a -> TypeName
forall a. TypeInformation a -> TypeName
typeName


arrayType :: TypeInformation a -> TypeName
arrayType :: forall a. TypeInformation a -> TypeName
arrayType TypeInformation a
info
  | TypeInformation a -> Bool
forall a. TypeInformation a -> Bool
isArray TypeInformation a
info = TypeName
"text"
  | Bool
otherwise = TypeInformation a -> TypeName
forall a. TypeInformation a -> TypeName
typeName TypeInformation a
info


decodeArrayElement :: TypeInformation a -> Decoder x -> Hasql.Value x
decodeArrayElement :: forall a x. TypeInformation a -> Decoder x -> Value x
decodeArrayElement TypeInformation a
info
  | TypeInformation a -> Bool
forall a. TypeInformation a -> Bool
isArray TypeInformation a
info = \Decoder x
decoder ->
      (ByteString -> Either Text x) -> Value ByteString -> Value x
forall a b. (a -> Either Text b) -> Value a -> Value b
Hasql.refine (([Char] -> Text) -> Either [Char] x -> Either Text x
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> Text
Text.pack (Either [Char] x -> Either Text x)
-> (ByteString -> Either [Char] x) -> ByteString -> Either Text x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder x -> ByteString -> Either [Char] x
forall a. Decoder a -> Parser a
parser Decoder x
decoder) Value ByteString
Hasql.bytea
  | Bool
otherwise = Decoder x -> Value x
forall a. Decoder a -> Value a
binary


encodeArrayElement :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
encodeArrayElement :: forall a. TypeInformation a -> PrimExpr -> PrimExpr
encodeArrayElement TypeInformation a
info
  | TypeInformation a -> Bool
forall a. TypeInformation a -> Bool
isArray TypeInformation a
info = [Char] -> PrimExpr -> PrimExpr
Opaleye.CastExpr [Char]
"text" (PrimExpr -> PrimExpr)
-> (PrimExpr -> PrimExpr) -> PrimExpr -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> PrimExpr -> PrimExpr
Opaleye.CastExpr (TypeName -> [Char]
showTypeName (TypeInformation a -> TypeName
forall a. TypeInformation a -> TypeName
typeName TypeInformation a
info))
  | Bool
otherwise = PrimExpr -> PrimExpr
forall a. a -> a
id


extractArrayElement :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
extractArrayElement :: forall a. TypeInformation a -> PrimExpr -> PrimExpr
extractArrayElement TypeInformation a
info
  | TypeInformation a -> Bool
forall a. TypeInformation a -> Bool
isArray TypeInformation a
info = [Char] -> PrimExpr -> PrimExpr
Opaleye.CastExpr (TypeName -> [Char]
showTypeName (TypeInformation a -> TypeName
forall a. TypeInformation a -> TypeName
typeName TypeInformation a
info))
  | Bool
otherwise = PrimExpr -> PrimExpr
forall a. a -> a
id


parseArray :: Char -> ByteString -> Either String [Maybe ByteString]
parseArray :: Char -> ByteString -> Either [Char] [Maybe ByteString]
parseArray Char
delimiter = Parser [Maybe ByteString]
-> ByteString -> Either [Char] [Maybe ByteString]
forall a. Parser a -> ByteString -> Either [Char] a
parse (Parser [Maybe ByteString]
 -> ByteString -> Either [Char] [Maybe ByteString])
-> Parser [Maybe ByteString]
-> ByteString
-> Either [Char] [Maybe ByteString]
forall a b. (a -> b) -> a -> b
$ do
  Char -> Parser Char
A.char Char
'{' Parser Char
-> Parser [Maybe ByteString] -> Parser [Maybe ByteString]
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 (Maybe ByteString)
-> Parser Char -> Parser [Maybe ByteString]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
A.sepBy Parser ByteString (Maybe ByteString)
element (Char -> Parser Char
A.char Char
delimiter) Parser [Maybe ByteString]
-> Parser Char -> Parser [Maybe ByteString]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
'}'
  where
    element :: Parser ByteString (Maybe ByteString)
element = Parser ByteString (Maybe ByteString)
forall {a}. Parser ByteString (Maybe a)
null Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString (Maybe ByteString)
nonNull
      where
        null :: Parser ByteString (Maybe a)
null = Maybe a
forall a. Maybe a
Nothing Maybe a
-> Parser ByteString ByteString -> Parser ByteString (Maybe a)
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
A.string ByteString
"NULL"
        nonNull :: Parser ByteString (Maybe ByteString)
nonNull = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Parser ByteString ByteString
-> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
quoted Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
unquoted)
          where
            unquoted :: Parser ByteString ByteString
unquoted = (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 ([Char] -> Char -> Bool
A.notInClass (Char
delimiter Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
"\"{}"))
            quoted :: Parser ByteString ByteString
quoted = Char -> Parser Char
A.char Char
'"' Parser Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
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 ByteString
contents Parser ByteString ByteString
-> Parser Char -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
'"'
              where
                contents :: Parser ByteString ByteString
contents = [ByteString] -> ByteString
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString -> Parser ByteString [ByteString]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString ByteString
unquote Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
unescape)
                  where
                    unquote :: Parser ByteString ByteString
unquote = (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 ([Char] -> Char -> Bool
A.notInClass [Char]
"\"\\")
                    unescape :: Parser ByteString ByteString
unescape = Char -> Parser Char
A.char Char
'\\' Parser Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
                      Char -> ByteString
BS.singleton (Char -> ByteString) -> Parser Char -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
                        Char -> Parser Char
A.char Char
'\\' Parser Char -> Parser Char -> Parser Char
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
A.char Char
'"'


arrayParser :: NullableOrNot Decoder a -> Parser [a]
arrayParser :: forall a. NullableOrNot Decoder a -> Parser [a]
arrayParser = \case
  Nullable Decoder {Parser a1
parser :: forall a. Decoder a -> Parser a
parser :: Parser a1
parser, Char
delimiter :: forall a. Decoder a -> Char
delimiter :: Char
delimiter} -> \ByteString
input -> do
    [Maybe ByteString]
elements <- Char -> ByteString -> Either [Char] [Maybe ByteString]
parseArray Char
delimiter ByteString
input
    (Maybe ByteString -> Either [Char] a)
-> [Maybe ByteString] -> Either [Char] [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Parser a1 -> Maybe ByteString -> Either [Char] (Maybe a1)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Parser a1
parser) [Maybe ByteString]
elements
  NonNullable Decoder {Parser a
parser :: forall a. Decoder a -> Parser a
parser :: Parser a
parser, Char
delimiter :: forall a. Decoder a -> Char
delimiter :: Char
delimiter} -> \ByteString
input -> do
    [Maybe ByteString]
elements <- Char -> ByteString -> Either [Char] [Maybe ByteString]
parseArray Char
delimiter ByteString
input
    (Maybe ByteString -> Either [Char] a)
-> [Maybe ByteString] -> Either [Char] [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Either [Char] a -> Parser a -> Maybe ByteString -> Either [Char] a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
"array: unexpected null") Parser a
parser) [Maybe ByteString]
elements


head :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
head :: forall a. TypeInformation a -> PrimExpr -> PrimExpr
head TypeInformation a
info PrimExpr
a = TypeInformation a -> PrimExpr -> PrimExpr
forall a. TypeInformation a -> PrimExpr -> PrimExpr
extractArrayElement TypeInformation a
info (PrimExpr -> PrimExpr) -> PrimExpr -> PrimExpr
forall a b. (a -> b) -> a -> b
$ PrimExpr -> PrimExpr -> PrimExpr
subscript (PrimExpr -> PrimExpr
lower PrimExpr
a) PrimExpr
a


last :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
last :: forall a. TypeInformation a -> PrimExpr -> PrimExpr
last TypeInformation a
info PrimExpr
a = TypeInformation a -> PrimExpr -> PrimExpr
forall a. TypeInformation a -> PrimExpr -> PrimExpr
extractArrayElement TypeInformation a
info (PrimExpr -> PrimExpr) -> PrimExpr -> PrimExpr
forall a b. (a -> b) -> a -> b
$ PrimExpr -> PrimExpr -> PrimExpr
subscript (PrimExpr -> PrimExpr
upper PrimExpr
a) PrimExpr
a


subscript :: Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr
subscript :: PrimExpr -> PrimExpr -> PrimExpr
subscript PrimExpr
i PrimExpr
a = PrimExpr -> PrimExpr -> PrimExpr
Opaleye.ArrayIndex PrimExpr
a PrimExpr
i


index :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr
index :: forall a. TypeInformation a -> PrimExpr -> PrimExpr -> PrimExpr
index TypeInformation a
info PrimExpr
i PrimExpr
a = TypeInformation a -> PrimExpr -> PrimExpr
forall a. TypeInformation a -> PrimExpr -> PrimExpr
extractArrayElement TypeInformation a
info (PrimExpr -> PrimExpr) -> PrimExpr -> PrimExpr
forall a b. (a -> b) -> a -> b
$ PrimExpr -> PrimExpr -> PrimExpr
subscript (PrimExpr -> PrimExpr -> PrimExpr
plus (PrimExpr -> PrimExpr
lower PrimExpr
a) PrimExpr
i) PrimExpr
a


lower :: Opaleye.PrimExpr -> Opaleye.PrimExpr
lower :: PrimExpr -> PrimExpr
lower PrimExpr
a = [Char] -> [PrimExpr] -> PrimExpr
Opaleye.FunExpr [Char]
"array_lower" [PrimExpr
a, PrimExpr
one]


upper :: Opaleye.PrimExpr -> Opaleye.PrimExpr
upper :: PrimExpr -> PrimExpr
upper PrimExpr
a = [Char] -> [PrimExpr] -> PrimExpr
Opaleye.FunExpr [Char]
"array_lower" [PrimExpr
a, PrimExpr
one]


length :: Opaleye.PrimExpr -> Opaleye.PrimExpr
length :: PrimExpr -> PrimExpr
length PrimExpr
a = [Char] -> [PrimExpr] -> PrimExpr
Opaleye.FunExpr [Char]
"coalesce" [[Char] -> [PrimExpr] -> PrimExpr
Opaleye.FunExpr [Char]
"array_length" [PrimExpr
a, PrimExpr
one], PrimExpr
zero]


one :: Opaleye.PrimExpr
one :: PrimExpr
one = Literal -> PrimExpr
Opaleye.ConstExpr (Integer -> Literal
Opaleye.IntegerLit Integer
1)


zero :: Opaleye.PrimExpr
zero :: PrimExpr
zero = Literal -> PrimExpr
Opaleye.ConstExpr (Integer -> Literal
Opaleye.IntegerLit Integer
0)


plus :: Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr
plus :: PrimExpr -> PrimExpr -> PrimExpr
plus = BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
(Opaleye.:+)