{-# 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 :: forall (f :: * -> *) a.
Foldable f =>
TypeInformation a -> f PrimExpr -> PrimExpr
array TypeInformation a
info =
  Name -> PrimExpr -> PrimExpr
Opaleye.CastExpr (forall a. TypeInformation a -> Name
arrayType TypeInformation a
info forall a. Semigroup a => a -> a -> a
<> Name
"[]") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [PrimExpr] -> PrimExpr
Opaleye.ArrayExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. TypeInformation a -> PrimExpr -> PrimExpr
encodeArrayElement TypeInformation a
info) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: 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
    { decode :: Value [a]
decode = case Nullity a
nullity of
        Nullity a
Null ->
          forall element. NullableOrNot Value element -> Value [element]
Hasql.listArray (forall a x.
TypeInformation a -> NullableOrNot Value x -> NullableOrNot Value x
decodeArrayElement TypeInformation (Unnullify a)
info (forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
Hasql.nullable Value (Unnullify a)
decode))
        Nullity a
NotNull ->
          forall element. NullableOrNot Value element -> Value [element]
Hasql.listArray (forall a x.
TypeInformation a -> NullableOrNot Value x -> NullableOrNot Value x
decodeArrayElement TypeInformation (Unnullify a)
info (forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
Hasql.nonNullable Value (Unnullify a)
decode))
    , encode :: [a] -> PrimExpr
encode = case Nullity a
nullity of
        Nullity a
Null ->
          [PrimExpr] -> PrimExpr
Opaleye.ArrayExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. TypeInformation a -> PrimExpr -> PrimExpr
encodeArrayElement TypeInformation (Unnullify a)
info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe PrimExpr
null Unnullify a -> PrimExpr
encode)
        Nullity a
NotNull ->
          [PrimExpr] -> PrimExpr
Opaleye.ArrayExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. TypeInformation a -> PrimExpr -> PrimExpr
encodeArrayElement TypeInformation (Unnullify a)
info forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unnullify a -> PrimExpr
encode)
    , typeName :: Name
typeName = forall a. TypeInformation a -> Name
arrayType TypeInformation (Unnullify a)
info 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 :: forall a.
Nullity a
-> TypeInformation (Unnullify a) -> TypeInformation (NonEmpty a)
nonEmptyTypeInformation Nullity a
nullity =
  forall a b.
(a -> Either Name b)
-> (b -> a) -> TypeInformation a -> TypeInformation b
parseTypeInformation [a] -> Either Name (NonEmpty a)
parse forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Nullity a -> TypeInformation (Unnullify a) -> TypeInformation [a]
listTypeInformation Nullity a
nullity
  where
    parse :: [a] -> Either Name (NonEmpty a)
parse = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Name
message) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
    message :: Name
message = Name
"failed to decode NonEmptyList: got empty list"


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


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


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


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


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