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

module Rel8.Type.Array
  ( array, encodeArrayElement, extractArrayElement
  , listTypeInformation
  , nonEmptyTypeInformation
  )
where

-- base
import Data.Foldable ( toList )
import Data.List.NonEmpty ( NonEmpty, nonEmpty )
import Prelude hiding ( null, repeat, zipWith )

-- 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.Information ( TypeInformation(..), parseTypeInformation )


array :: Foldable f
  => TypeInformation a -> f Opaleye.PrimExpr -> Opaleye.PrimExpr
array :: TypeInformation a -> f PrimExpr -> PrimExpr
array TypeInformation a
info =
  Name -> PrimExpr -> PrimExpr
Opaleye.CastExpr (TypeInformation a -> Name
forall a. TypeInformation a -> Name
arrayType TypeInformation a
info Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"[]") (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 (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# INLINABLE array #-}


listTypeInformation :: ()
  => Nullity a
  -> TypeInformation (Unnullify a)
  -> TypeInformation [a]
listTypeInformation :: Nullity a -> TypeInformation (Unnullify a) -> TypeInformation [a]
listTypeInformation Nullity a
nullity info :: TypeInformation (Unnullify a)
info@TypeInformation {Unnullify a -> PrimExpr
encode :: forall a. TypeInformation a -> a -> PrimExpr
encode :: Unnullify a -> PrimExpr
encode, Value (Unnullify a)
decode :: forall a. TypeInformation a -> Value a
decode :: Value (Unnullify a)
decode} =
  TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> Name -> TypeInformation a
TypeInformation
    { decode :: Value [a]
decode = case Nullity a
nullity of
        Nullity a
Null ->
          NullableOrNot Value (Maybe a) -> Value [Maybe a]
forall element. NullableOrNot Value element -> Value [element]
Hasql.listArray (TypeInformation a
-> NullableOrNot Value (Maybe a) -> NullableOrNot Value (Maybe a)
forall a x.
TypeInformation a -> NullableOrNot Value x -> NullableOrNot Value x
decodeArrayElement TypeInformation a
TypeInformation (Unnullify a)
info (Value a -> NullableOrNot Value (Maybe a)
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
Hasql.nullable Value a
Value (Unnullify a)
decode))
        Nullity a
NotNull ->
          NullableOrNot Value a -> Value [a]
forall element. NullableOrNot Value element -> Value [element]
Hasql.listArray (TypeInformation a -> NullableOrNot Value a -> NullableOrNot Value a
forall a x.
TypeInformation a -> NullableOrNot Value x -> NullableOrNot Value x
decodeArrayElement TypeInformation a
TypeInformation (Unnullify a)
info (Value a -> NullableOrNot Value a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
Hasql.nonNullable Value a
Value (Unnullify a)
decode))
    , encode :: [a] -> PrimExpr
encode = case Nullity a
nullity of
        Nullity a
Null ->
          [PrimExpr] -> PrimExpr
Opaleye.ArrayExpr ([PrimExpr] -> PrimExpr)
-> ([Maybe a] -> [PrimExpr]) -> [Maybe a] -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (Maybe a -> PrimExpr) -> [Maybe a] -> [PrimExpr]
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)
-> (Maybe a -> PrimExpr) -> Maybe a -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimExpr -> (a -> PrimExpr) -> Maybe a -> PrimExpr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PrimExpr
null a -> 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 (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 :: Name
typeName = TypeInformation (Unnullify a) -> Name
forall a. TypeInformation a -> Name
arrayType TypeInformation (Unnullify a)
info Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"[]"
    }
  where
    null :: PrimExpr
null = Literal -> PrimExpr
Opaleye.ConstExpr Literal
Opaleye.NullLit


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


isArray :: TypeInformation a -> Bool
isArray :: TypeInformation a -> Bool
isArray = \case
  (Name -> Name
forall a. [a] -> [a]
reverse (Name -> Name)
-> (TypeInformation a -> Name) -> TypeInformation a -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInformation a -> Name
forall a. TypeInformation a -> Name
typeName -> Char
']' : Char
'[' : Name
_) -> Bool
True
  TypeInformation a
_ -> Bool
False


arrayType :: TypeInformation a -> String
arrayType :: TypeInformation a -> Name
arrayType TypeInformation a
info
  | TypeInformation a -> Bool
forall a. TypeInformation a -> Bool
isArray TypeInformation a
info = Name
"record"
  | Bool
otherwise = TypeInformation a -> Name
forall a. TypeInformation a -> Name
typeName TypeInformation a
info


decodeArrayElement :: TypeInformation a -> Hasql.NullableOrNot Hasql.Value x -> Hasql.NullableOrNot Hasql.Value x
decodeArrayElement :: TypeInformation a -> NullableOrNot Value x -> NullableOrNot Value x
decodeArrayElement TypeInformation a
info
  | TypeInformation a -> Bool
forall a. TypeInformation a -> Bool
isArray TypeInformation a
info = Value x -> NullableOrNot Value x
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
Hasql.nonNullable (Value x -> NullableOrNot Value x)
-> (NullableOrNot Value x -> Value x)
-> NullableOrNot Value x
-> NullableOrNot Value x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Composite x -> Value x
forall a. Composite a -> Value a
Hasql.composite (Composite x -> Value x)
-> (NullableOrNot Value x -> Composite x)
-> NullableOrNot Value x
-> Value x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NullableOrNot Value x -> Composite x
forall a. NullableOrNot Value a -> Composite a
Hasql.field
  | Bool
otherwise = NullableOrNot Value x -> NullableOrNot Value x
forall a. a -> a
id


encodeArrayElement :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
encodeArrayElement :: TypeInformation a -> PrimExpr -> PrimExpr
encodeArrayElement TypeInformation a
info
  | TypeInformation a -> Bool
forall a. TypeInformation a -> Bool
isArray TypeInformation a
info = UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr (Name -> UnOp
Opaleye.UnOpOther Name
"ROW")
  | Bool
otherwise = PrimExpr -> PrimExpr
forall a. a -> a
id


extractArrayElement :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
extractArrayElement :: TypeInformation a -> PrimExpr -> PrimExpr
extractArrayElement TypeInformation a
info
  | TypeInformation a -> Bool
forall a. TypeInformation a -> Bool
isArray TypeInformation a
info = (PrimExpr -> Name -> PrimExpr) -> Name -> PrimExpr -> PrimExpr
forall a b c. (a -> b -> c) -> b -> a -> c
flip PrimExpr -> Name -> PrimExpr
Opaleye.CompositeExpr Name
"f1"
  | Bool
otherwise = PrimExpr -> PrimExpr
forall a. a -> a
id