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

module Rel8.Type.Array
  ( array, quoteArrayElement, 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.Functor.Contravariant ((>$<))
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Prelude hiding (head, last, length, null, repeat, zipWith)

-- bytestring
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder, toLazyByteString)
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as L

-- case-insensitive
import qualified Data.CaseInsensitive as CI

-- hasql
import qualified Hasql.Decoders as Decoders
import qualified Hasql.Encoders as Encoders

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

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

-- text
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Text (toStrict)
import qualified Data.Text.Lazy.Encoding as Lazy (decodeUtf8)


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
quoteArrayElement 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 {Decoder (Unnullify a)
decode :: Decoder (Unnullify a)
decode :: forall a. TypeInformation a -> Decoder a
decode, Encoder (Unnullify a)
encode :: Encoder (Unnullify a)
encode :: forall a. TypeInformation a -> Encoder a
encode, Char
delimiter :: Char
delimiter :: forall a. TypeInformation a -> Char
delimiter} =
  TypeInformation
    { decode :: Decoder [a]
decode =
        Decoder
          { binary :: Value [a]
binary = NullableOrNot Value a -> Value [a]
forall element. NullableOrNot Value element -> Value [element]
Decoders.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)
Decoders.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
Decoders.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)
          , text :: Parser [a]
text = case Nullity a
nullity of
              Nullity a
Null -> Char -> NullableOrNot Decoder a -> Parser [a]
forall a. Char -> NullableOrNot Decoder a -> Parser [a]
arrayParser Char
delimiter (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 -> Char -> NullableOrNot Decoder a -> Parser [a]
forall a. Char -> NullableOrNot Decoder a -> Parser [a]
arrayParser Char
delimiter (Decoder a -> NullableOrNot Decoder a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
NonNullable Decoder a
Decoder (Unnullify a)
decode)
          }
    , encode :: Encoder [a]
encode =
        Encoder
          { binary :: Value [a]
binary = NullableOrNot Value a -> Value [a]
forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
Encoders.foldableArray (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 (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Encoders.nullable (TypeInformation a1 -> Encoder a1 -> Value a1
forall a x. TypeInformation a -> Encoder x -> Value x
encodeArrayElement TypeInformation a1
TypeInformation (Unnullify a)
info Encoder a1
Encoder (Unnullify a)
encode)
              Nullity a
NotNull -> Value a -> NullableOrNot Value a
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
Encoders.nonNullable (TypeInformation a -> Encoder a -> Value a
forall a x. TypeInformation a -> Encoder x -> Value x
encodeArrayElement TypeInformation a
TypeInformation (Unnullify a)
info Encoder a
Encoder (Unnullify a)
encode)
          , text :: [a] -> Builder
text = case Nullity a
nullity of
              Nullity a
Null -> Char -> NullableOrNot Encoder a -> [a] -> Builder
forall a. Char -> NullableOrNot Encoder a -> [a] -> Builder
arrayBuild Char
delimiter (Encoder a1 -> NullableOrNot Encoder (Maybe a1)
forall (decoder :: * -> *) a1.
decoder a1 -> NullableOrNot decoder (Maybe a1)
Nullable Encoder a1
Encoder (Unnullify a)
encode)
              Nullity a
NotNull -> Char -> NullableOrNot Encoder a -> [a] -> Builder
forall a. Char -> NullableOrNot Encoder a -> [a] -> Builder
arrayBuild Char
delimiter (Encoder a -> NullableOrNot Encoder a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
NonNullable Encoder a
Encoder (Unnullify a)
encode)
          , quote :: [a] -> PrimExpr
quote = 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
quoteArrayElement 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 (Encoder a1 -> a1 -> PrimExpr
forall a. Encoder a -> a -> PrimExpr
quote Encoder a1
Encoder (Unnullify a)
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
quoteArrayElement TypeInformation a
TypeInformation (Unnullify a)
info (PrimExpr -> PrimExpr) -> (a -> PrimExpr) -> a -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder a -> a -> PrimExpr
forall a. Encoder a -> a -> PrimExpr
quote Encoder a
Encoder (Unnullify a)
encode)
          }
    , delimiter :: Char
delimiter = Char
','
    , 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 -> Decoders.Value x
decodeArrayElement :: forall a x. TypeInformation a -> Decoder x -> Value x
decodeArrayElement TypeInformation a
info Decoder {Value x
binary :: forall a. Decoder a -> Value a
binary :: Value x
binary, Parser x
text :: forall a. Decoder a -> Parser a
text :: Parser x
text}
  | TypeInformation a -> Bool
forall a. TypeInformation a -> Bool
isArray TypeInformation a
info =
      (ByteString -> Either Text x) -> Value ByteString -> Value x
forall a b. (a -> Either Text b) -> Value a -> Value b
Decoders.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)
-> Parser x -> ByteString -> Either Text x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser x
text) Value ByteString
Decoders.bytea
  | Bool
otherwise = Value x
binary


encodeArrayElement :: TypeInformation a -> Encoder x -> Encoders.Value x
encodeArrayElement :: forall a x. TypeInformation a -> Encoder x -> Value x
encodeArrayElement TypeInformation a
info Encoder {Value x
binary :: forall a. Encoder a -> Value a
binary :: Value x
binary, x -> Builder
text :: forall a. Encoder a -> a -> Builder
text :: x -> Builder
text}
  | TypeInformation a -> Bool
forall a. TypeInformation a -> Bool
isArray TypeInformation a
info = LazyText -> Text
Text.toStrict (LazyText -> Text) -> (x -> LazyText) -> x -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LazyText
Lazy.decodeUtf8 (ByteString -> LazyText) -> (x -> ByteString) -> x -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> (x -> Builder) -> x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Builder
text (x -> Text) -> Value Text -> Value x
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Value Text
Encoders.text
  | Bool
otherwise = Value x
binary


quoteArrayElement :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
quoteArrayElement :: forall a. TypeInformation a -> PrimExpr -> PrimExpr
quoteArrayElement 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 :: Char -> NullableOrNot Decoder a -> Parser [a]
arrayParser :: forall a. Char -> NullableOrNot Decoder a -> Parser [a]
arrayParser Char
delimiter = \case
  Nullable Decoder {Parser a1
text :: forall a. Decoder a -> Parser a
text :: Parser a1
text} -> \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
text) [Maybe ByteString]
elements
  NonNullable Decoder {Parser a
text :: forall a. Decoder a -> Parser a
text :: Parser a
text} -> \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
text) [Maybe ByteString]
elements


buildArray :: Char -> [Maybe ByteString] -> Builder
buildArray :: Char -> [Maybe ByteString] -> Builder
buildArray Char
delimiter [Maybe ByteString]
elements =
  Char -> Builder
B.char8 Char
'{' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Builder
-> (Maybe ByteString -> Builder) -> [Maybe ByteString] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
m -> (a -> m) -> t a -> m
interfoldMap (Char -> Builder
B.char8 Char
delimiter) Maybe ByteString -> Builder
element [Maybe ByteString]
elements Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Char -> Builder
B.char8 Char
'}'
  where
    element :: Maybe ByteString -> Builder
element = \case
      Maybe ByteString
Nothing -> [Char] -> Builder
B.string7 [Char]
"NULL"
      Just ByteString
a
        | ByteString -> Bool
BS.null ByteString
a -> Builder
"\"\""
        | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
a CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"null" -> Builder
escaped
        | (Char -> Bool) -> ByteString -> Bool
BS.any ([Char] -> Char -> Bool
A.inClass [Char]
escapeClass) ByteString
a -> Builder
escaped
        | Bool
otherwise -> Builder
unescaped
        where
          escapeClass :: [Char]
escapeClass = Char
delimiter Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
"\\\"{}\t\n"
          unescaped :: Builder
unescaped = ByteString -> Builder
B.byteString ByteString
a
          escaped :: Builder
escaped =
            Char -> Builder
B.char8 Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Char -> Builder -> Builder) -> Builder -> ByteString -> Builder
forall a. (Char -> a -> a) -> a -> ByteString -> a
BS.foldr (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> (Char -> Builder) -> Char -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
escape) Builder
forall a. Monoid a => a
mempty ByteString
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char8 Char
'"'
            where
              escape :: Char -> Builder
escape = \case
                Char
'"' -> [Char] -> Builder
B.string7 [Char]
"\\\""
                Char
'\\' -> [Char] -> Builder
B.string7 [Char]
"\\\\"
                Char
c -> Char -> Builder
B.char8 Char
c


arrayBuild :: Char -> NullableOrNot Encoder a -> [a] -> Builder
arrayBuild :: forall a. Char -> NullableOrNot Encoder a -> [a] -> Builder
arrayBuild Char
delimiter = \case
  Nullable Encoder {a1 -> Builder
text :: forall a. Encoder a -> a -> Builder
text :: a1 -> Builder
text} ->
    Char -> [Maybe ByteString] -> Builder
buildArray Char
delimiter ([Maybe ByteString] -> Builder)
-> ([a] -> [Maybe ByteString]) -> [a] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (a -> Maybe ByteString) -> [a] -> [Maybe ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ((a1 -> ByteString) -> Maybe a1 -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (a1 -> ByteString) -> a1 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> (a1 -> Builder) -> a1 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a1 -> Builder
text))
  NonNullable Encoder {a -> Builder
text :: forall a. Encoder a -> a -> Builder
text :: a -> Builder
text} ->
    Char -> [Maybe ByteString] -> Builder
buildArray Char
delimiter ([Maybe ByteString] -> Builder)
-> ([a] -> [Maybe ByteString]) -> [a] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (a -> Maybe ByteString) -> [a] -> [Maybe ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (a -> ByteString) -> a -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
text)


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.:+)