mirror of
https://github.com/circuithub/rel8.git
synced 2024-09-11 16:05:41 +03:00
Eliminate the need for Array1D (i.e., unify with [])
To implement the `DBType` instance for `[]`, we wrapped the underlying Postgres array with `ROW()`. This is to allow nesting `[]` inside `[]` (Postgres treats a bare `foo[][]` as a multidimensional array). However, instead of unconditionally wrapping the list itself with `ROW()`, we could instead wrap individual list elements. And even better, we can wrap them *conditionally*, i.e., only if they have an array type (e.g., `foo[]`). This makes our lists much closer to Postgres arrays, and eliminates the need for `Array1D`. It also means our lists can be concatenated with a bare `||` operator; no need for the flaky `(foo).f1` unwrapping step.
This commit is contained in:
parent
bdb75e6580
commit
447508578d
@ -168,7 +168,6 @@ library
|
||||
|
||||
Rel8.Type
|
||||
Rel8.Type.Array
|
||||
Rel8.Type.Array1D
|
||||
Rel8.Type.Composite
|
||||
Rel8.Type.Eq
|
||||
Rel8.Type.Enum
|
||||
|
@ -218,7 +218,6 @@ module Rel8
|
||||
, countRows
|
||||
, groupBy
|
||||
, headAgg
|
||||
, array1DAggExpr
|
||||
, listAgg, listAggExpr
|
||||
, nonEmptyAgg, nonEmptyAggExpr
|
||||
, DBMax, max
|
||||
@ -272,8 +271,6 @@ module Rel8
|
||||
-- TODO
|
||||
-- These need organizing, but are reachable from Rel8's documentation so we
|
||||
-- do need to export and document them.
|
||||
, Array1D( Array1D )
|
||||
, NotArray
|
||||
, Nullable
|
||||
, NotNull
|
||||
, HTable
|
||||
@ -358,7 +355,6 @@ import Rel8.Table.Rel8able ()
|
||||
import Rel8.Table.Serialize
|
||||
import Rel8.Table.These
|
||||
import Rel8.Type
|
||||
import Rel8.Type.Array1D
|
||||
import Rel8.Type.Composite
|
||||
import Rel8.Type.Eq
|
||||
import Rel8.Type.Enum
|
||||
|
@ -1,6 +1,7 @@
|
||||
{-# language AllowAmbiguousTypes #-}
|
||||
{-# language DataKinds #-}
|
||||
{-# language FlexibleContexts #-}
|
||||
{-# language NamedFieldPuns #-}
|
||||
{-# language RankNTypes #-}
|
||||
{-# language ScopedTypeVariables #-}
|
||||
{-# language StandaloneKindSignatures #-}
|
||||
@ -37,7 +38,8 @@ import Rel8.Expr ( Col( E ), Expr )
|
||||
import Rel8.Expr.Aggregate
|
||||
( groupByExpr
|
||||
, headAggExpr
|
||||
, listAggExpr, nonEmptyAggExpr
|
||||
, slistAggExpr
|
||||
, snonEmptyAggExpr
|
||||
)
|
||||
import Rel8.Generic.Construction ( GGAggregate', ggaggregate' )
|
||||
import Rel8.Generic.Table ( GAlgebra )
|
||||
@ -48,6 +50,7 @@ import Rel8.Schema.Dict ( Dict( Dict ) )
|
||||
import Rel8.Schema.HTable ( hmap, hfield, htabulate )
|
||||
import Rel8.Schema.HTable.Vectorize ( hvectorize )
|
||||
import Rel8.Schema.Kind ( Rel8able )
|
||||
import Rel8.Schema.Spec ( SSpec( SSpec, info ) )
|
||||
import Rel8.Table ( toColumns, fromColumns )
|
||||
import Rel8.Table.ADT ( ConstructableADT, ADT( ADT ), ADTRep )
|
||||
import Rel8.Table.Eq ( EqTable, eqTable )
|
||||
@ -105,7 +108,7 @@ headAgg = fromColumns . hmap (\(E a) -> A $ headAggExpr a) . toColumns
|
||||
listAgg :: Aggregates aggregates exprs => exprs -> ListTable aggregates
|
||||
listAgg (toColumns -> exprs) = fromColumns $
|
||||
hvectorize
|
||||
(\_ (Identity (E a)) -> A $ listAggExpr a)
|
||||
(\SSpec {info} (Identity (E a)) -> A $ slistAggExpr info a)
|
||||
(pure exprs)
|
||||
|
||||
|
||||
@ -113,7 +116,7 @@ listAgg (toColumns -> exprs) = fromColumns $
|
||||
nonEmptyAgg :: Aggregates aggregates exprs => exprs -> NonEmptyTable aggregates
|
||||
nonEmptyAgg (toColumns -> exprs) = fromColumns $
|
||||
hvectorize
|
||||
(\_ (Identity (E a)) -> A $ nonEmptyAggExpr a)
|
||||
(\SSpec {info} (Identity (E a)) -> A $ snonEmptyAggExpr info a)
|
||||
(pure exprs)
|
||||
|
||||
|
||||
|
@ -13,7 +13,8 @@ module Rel8.Expr.Aggregate
|
||||
, stringAgg
|
||||
, groupByExpr
|
||||
, headAggExpr
|
||||
, array1DAggExpr, listAggExpr, nonEmptyAggExpr
|
||||
, listAggExpr, nonEmptyAggExpr
|
||||
, slistAggExpr, snonEmptyAggExpr
|
||||
)
|
||||
where
|
||||
|
||||
@ -37,10 +38,11 @@ import Rel8.Expr.Opaleye
|
||||
)
|
||||
import Rel8.Expr.Null ( null )
|
||||
import Rel8.Expr.Serialize ( litExpr )
|
||||
import Rel8.Schema.Null ( Sql )
|
||||
import Rel8.Type.Array ( fromPrimArray )
|
||||
import Rel8.Type.Array1D ( Array1D, NotArray )
|
||||
import Rel8.Schema.Null ( Sql, Unnullify )
|
||||
import Rel8.Type ( DBType, typeInformation )
|
||||
import Rel8.Type.Array ( wrap )
|
||||
import Rel8.Type.Eq ( DBEq )
|
||||
import Rel8.Type.Information ( TypeInformation )
|
||||
import Rel8.Type.Num ( DBNum )
|
||||
import Rel8.Type.Ord ( DBMax, DBMin )
|
||||
import Rel8.Type.String ( DBString )
|
||||
@ -168,35 +170,35 @@ headAggExpr = unsafeMakeAggregate toPrimExpr from $ Just
|
||||
one = Opaleye.ConstExpr (Opaleye.NumericLit 1)
|
||||
|
||||
|
||||
-- | Collect expressions values as an array.
|
||||
array1DAggExpr :: NotArray a => Expr a -> Aggregate (Expr (Array1D a))
|
||||
array1DAggExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr $ Just
|
||||
Aggregator
|
||||
{ operation = Opaleye.AggrArr
|
||||
, ordering = []
|
||||
, distinction = Opaleye.AggrAll
|
||||
}
|
||||
|
||||
|
||||
-- | Collect expressions values as a list.
|
||||
listAggExpr :: Expr a -> Aggregate (Expr [a])
|
||||
listAggExpr = unsafeMakeAggregate toPrimExpr from $ Just
|
||||
Aggregator
|
||||
{ operation = Opaleye.AggrArr
|
||||
, ordering = []
|
||||
, distinction = Opaleye.AggrAll
|
||||
}
|
||||
where
|
||||
from = fromPrimExpr . fromPrimArray
|
||||
listAggExpr :: Sql DBType a => Expr a -> Aggregate (Expr [a])
|
||||
listAggExpr = slistAggExpr typeInformation
|
||||
|
||||
|
||||
-- | Collect expressions values as a non-empty list.
|
||||
nonEmptyAggExpr :: Expr a -> Aggregate (Expr (NonEmpty a))
|
||||
nonEmptyAggExpr = unsafeMakeAggregate toPrimExpr from $ Just
|
||||
nonEmptyAggExpr :: Sql DBType a => Expr a -> Aggregate (Expr (NonEmpty a))
|
||||
nonEmptyAggExpr = snonEmptyAggExpr typeInformation
|
||||
|
||||
|
||||
slistAggExpr :: ()
|
||||
=> TypeInformation (Unnullify a) -> Expr a -> Aggregate (Expr [a])
|
||||
slistAggExpr info = unsafeMakeAggregate to fromPrimExpr $ Just
|
||||
Aggregator
|
||||
{ operation = Opaleye.AggrArr
|
||||
, ordering = []
|
||||
, distinction = Opaleye.AggrAll
|
||||
}
|
||||
where
|
||||
from = fromPrimExpr . fromPrimArray
|
||||
to = wrap info . toPrimExpr
|
||||
|
||||
|
||||
snonEmptyAggExpr :: ()
|
||||
=> TypeInformation (Unnullify a) -> Expr a -> Aggregate (Expr (NonEmpty a))
|
||||
snonEmptyAggExpr info = unsafeMakeAggregate to fromPrimExpr $ Just
|
||||
Aggregator
|
||||
{ operation = Opaleye.AggrArr
|
||||
, ordering = []
|
||||
, distinction = Opaleye.AggrAll
|
||||
}
|
||||
where
|
||||
to = wrap info . toPrimExpr
|
||||
|
@ -25,21 +25,21 @@ import Rel8.Expr.Opaleye
|
||||
, zipPrimExprsWith
|
||||
)
|
||||
import Rel8.Type ( DBType, typeInformation )
|
||||
import Rel8.Type.Array ( array, zipPrimArraysWith )
|
||||
import Rel8.Type.Array ( array )
|
||||
import Rel8.Type.Information ( TypeInformation(..) )
|
||||
import Rel8.Schema.Null ( Unnullify, Nullity, Sql )
|
||||
import Rel8.Schema.Null ( Unnullify, Sql )
|
||||
|
||||
|
||||
sappend :: Expr [a] -> Expr [a] -> Expr [a]
|
||||
sappend = zipPrimExprsWith (zipPrimArraysWith (Opaleye.BinExpr (Opaleye.:||)))
|
||||
sappend = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))
|
||||
|
||||
|
||||
sappend1 :: Expr (NonEmpty a) -> Expr (NonEmpty a) -> Expr (NonEmpty a)
|
||||
sappend1 = zipPrimExprsWith (zipPrimArraysWith (Opaleye.BinExpr (Opaleye.:||)))
|
||||
sappend1 = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))
|
||||
|
||||
|
||||
sempty :: Nullity a -> TypeInformation (Unnullify a) -> Expr [a]
|
||||
sempty _ info = fromPrimExpr $ array info []
|
||||
sempty :: TypeInformation (Unnullify a) -> Expr [a]
|
||||
sempty info = fromPrimExpr $ array info []
|
||||
|
||||
|
||||
slistOf :: TypeInformation (Unnullify a) -> [Expr a] -> Expr [a]
|
||||
|
@ -32,7 +32,6 @@ import Data.ByteString ( ByteString )
|
||||
-- rel8
|
||||
import Rel8.Expr ( Expr )
|
||||
import Rel8.Expr.Function ( binaryOperator, function, nullaryFunction )
|
||||
import Rel8.Type.Array1D ( Array1D )
|
||||
|
||||
-- text
|
||||
import Data.Text (Text)
|
||||
@ -218,7 +217,7 @@ regexpReplace a b c Nothing = function "regexp_replace" a b c
|
||||
|
||||
-- | Corresponds to the @regexp_split_to_array@ function.
|
||||
regexpSplitToArray :: ()
|
||||
=> Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr (Array1D Text)
|
||||
=> Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr [Text]
|
||||
regexpSplitToArray a b (Just c) = function "regexp_split_to_array" a b c
|
||||
regexpSplitToArray a b Nothing = function "regexp_split_to_array" a b
|
||||
|
||||
|
@ -55,5 +55,5 @@ manyExpr = fmap (maybeTable mempty id) . optional . aggregate . fmap listAggExpr
|
||||
|
||||
|
||||
-- | A version of 'many' specialised to single expressions.
|
||||
someExpr :: Query (Expr a) -> Query (Expr (NonEmpty a))
|
||||
someExpr :: Sql DBType a => Query (Expr a) -> Query (Expr (NonEmpty a))
|
||||
someExpr = aggregate . fmap nonEmptyAggExpr
|
||||
|
@ -1,4 +1,5 @@
|
||||
{-# language FlexibleContexts #-}
|
||||
{-# language NamedFieldPuns #-}
|
||||
{-# language ScopedTypeVariables #-}
|
||||
{-# language TypeApplications #-}
|
||||
{-# language TypeFamilies #-}
|
||||
@ -21,12 +22,13 @@ import Rel8.Expr ( Expr, Col( E ) )
|
||||
import Rel8.Expr.Aggregate
|
||||
( groupByExpr
|
||||
, headAggExpr
|
||||
, listAggExpr
|
||||
, nonEmptyAggExpr
|
||||
, slistAggExpr
|
||||
, snonEmptyAggExpr
|
||||
)
|
||||
import Rel8.Schema.Dict ( Dict( Dict ) )
|
||||
import Rel8.Schema.HTable ( hfield, hmap, htabulate )
|
||||
import Rel8.Schema.HTable.Vectorize ( hvectorize )
|
||||
import Rel8.Schema.Spec ( SSpec( SSpec, info ) )
|
||||
import Rel8.Table ( Table, toColumns, fromColumns )
|
||||
import Rel8.Table.Eq ( EqTable, eqTable )
|
||||
import Rel8.Table.List ( ListTable )
|
||||
@ -66,7 +68,7 @@ headAgg = fromColumns . hmap (\(E a) -> A $ headAggExpr a) . toColumns
|
||||
listAgg :: Table Expr a => a -> Aggregate (ListTable a)
|
||||
listAgg (toColumns -> exprs) = fromColumns $
|
||||
hvectorize
|
||||
(\_ (Identity (E a)) -> A $ listAggExpr a)
|
||||
(\SSpec {info} (Identity (E a)) -> A $ slistAggExpr info a)
|
||||
(pure exprs)
|
||||
|
||||
|
||||
@ -74,5 +76,5 @@ listAgg (toColumns -> exprs) = fromColumns $
|
||||
nonEmptyAgg :: Table Expr a => a -> Aggregate (NonEmptyTable a)
|
||||
nonEmptyAgg (toColumns -> exprs) = fromColumns $
|
||||
hvectorize
|
||||
(\_ (Identity (E a)) -> A $ nonEmptyAggExpr a)
|
||||
(\SSpec {info} (Identity (E a)) -> A $ snonEmptyAggExpr info a)
|
||||
(pure exprs)
|
||||
|
@ -116,8 +116,7 @@ instance Table Expr a => Semigroup (ListTable a) where
|
||||
|
||||
|
||||
instance Table Expr a => Monoid (ListTable a) where
|
||||
mempty = ListTable $ hempty $ \nullability info ->
|
||||
E (sempty nullability info)
|
||||
mempty = ListTable $ hempty $ \_ -> E . sempty
|
||||
|
||||
|
||||
listTable :: Table Expr a => [a] -> ListTable a
|
||||
|
@ -1,12 +1,13 @@
|
||||
{-# language GADTs #-}
|
||||
{-# language LambdaCase #-}
|
||||
{-# language NamedFieldPuns #-}
|
||||
{-# language OverloadedStrings #-}
|
||||
{-# language ViewPatterns #-}
|
||||
|
||||
module Rel8.Type.Array
|
||||
( array
|
||||
( array, wrap
|
||||
, listTypeInformation
|
||||
, nonEmptyTypeInformation
|
||||
, fromPrimArray, toPrimArray, zipPrimArraysWith
|
||||
)
|
||||
where
|
||||
|
||||
@ -28,10 +29,9 @@ import Rel8.Type.Information ( TypeInformation(..), parseTypeInformation )
|
||||
|
||||
array :: Foldable f
|
||||
=> TypeInformation a -> f Opaleye.PrimExpr -> Opaleye.PrimExpr
|
||||
array TypeInformation {typeName} =
|
||||
fromPrimArray .
|
||||
Opaleye.CastExpr (typeName <> "[]") .
|
||||
Opaleye.ArrayExpr . toList
|
||||
array info =
|
||||
Opaleye.CastExpr (arrayType info <> "[]") .
|
||||
Opaleye.ArrayExpr . map (wrap info) . toList
|
||||
{-# INLINABLE array #-}
|
||||
|
||||
|
||||
@ -39,19 +39,17 @@ listTypeInformation :: ()
|
||||
=> Nullity a
|
||||
-> TypeInformation (Unnullify a)
|
||||
-> TypeInformation [a]
|
||||
listTypeInformation nullity info =
|
||||
case info of
|
||||
TypeInformation{ encode, decode } -> TypeInformation
|
||||
{ decode = row $ case nullity of
|
||||
Null -> Hasql.listArray (Hasql.nullable decode)
|
||||
NotNull -> Hasql.listArray (Hasql.nonNullable decode)
|
||||
, encode = case nullity of
|
||||
Null -> array info . fmap (maybe null encode)
|
||||
NotNull -> array info . fmap encode
|
||||
, typeName = "record"
|
||||
}
|
||||
listTypeInformation nullity info@TypeInformation {encode, decode} =
|
||||
TypeInformation
|
||||
{ decode = case nullity of
|
||||
Null -> Hasql.listArray (Hasql.nullable (unwrap info decode))
|
||||
NotNull -> Hasql.listArray (Hasql.nonNullable (unwrap info decode))
|
||||
, encode = case nullity of
|
||||
Null -> Opaleye.ArrayExpr . fmap (wrap info . maybe null encode)
|
||||
NotNull -> Opaleye.ArrayExpr . fmap (wrap info . encode)
|
||||
, typeName = arrayType info <> "[]"
|
||||
}
|
||||
where
|
||||
row = Hasql.composite . Hasql.field . Hasql.nonNullable
|
||||
null = Opaleye.ConstExpr Opaleye.NullLit
|
||||
|
||||
|
||||
@ -66,15 +64,25 @@ nonEmptyTypeInformation nullity =
|
||||
message = "failed to decode NonEmptyList: got empty list"
|
||||
|
||||
|
||||
fromPrimArray :: Opaleye.PrimExpr -> Opaleye.PrimExpr
|
||||
fromPrimArray = Opaleye.UnExpr (Opaleye.UnOpOther "ROW")
|
||||
isArray :: TypeInformation a -> Bool
|
||||
isArray = \case
|
||||
(reverse . typeName -> ']' : '[' : _) -> True
|
||||
_ -> False
|
||||
|
||||
|
||||
toPrimArray :: Opaleye.PrimExpr -> Opaleye.PrimExpr
|
||||
toPrimArray a = Opaleye.CompositeExpr a "f1"
|
||||
arrayType :: TypeInformation a -> String
|
||||
arrayType info
|
||||
| isArray info = "record"
|
||||
| otherwise = typeName info
|
||||
|
||||
|
||||
zipPrimArraysWith :: ()
|
||||
=> (Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr)
|
||||
-> Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr
|
||||
zipPrimArraysWith f a b = fromPrimArray (f (toPrimArray a) (toPrimArray b))
|
||||
wrap :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
|
||||
wrap info
|
||||
| isArray info = Opaleye.UnExpr (Opaleye.UnOpOther "ROW")
|
||||
| otherwise = id
|
||||
|
||||
|
||||
unwrap :: TypeInformation a -> Hasql.Value x -> Hasql.Value x
|
||||
unwrap info
|
||||
| isArray info = Hasql.composite . Hasql.field . Hasql.nonNullable
|
||||
| otherwise = id
|
||||
|
@ -1,139 +0,0 @@
|
||||
{-# language DataKinds #-}
|
||||
{-# language DeriveTraversable #-}
|
||||
{-# language DerivingStrategies #-}
|
||||
{-# language FlexibleContexts #-}
|
||||
{-# language FlexibleInstances #-}
|
||||
{-# language GeneralizedNewtypeDeriving #-}
|
||||
{-# language NamedFieldPuns #-}
|
||||
{-# language StandaloneKindSignatures #-}
|
||||
{-# language TypeFamilies #-}
|
||||
{-# language UndecidableInstances #-}
|
||||
|
||||
{-# options_ghc -fno-warn-redundant-constraints #-}
|
||||
|
||||
module Rel8.Type.Array1D
|
||||
( Array1D( Array1D )
|
||||
, NotArray
|
||||
, getArray1D
|
||||
)
|
||||
where
|
||||
|
||||
-- aeson
|
||||
import Data.Aeson
|
||||
( ToJSON
|
||||
, ToJSON1
|
||||
, ToJSONKey
|
||||
, FromJSON
|
||||
, FromJSON1
|
||||
, FromJSONKey
|
||||
)
|
||||
|
||||
-- base
|
||||
import Control.Applicative ( Alternative, (<|>) )
|
||||
import Control.Monad ( MonadPlus )
|
||||
import Data.Functor.Classes ( Eq1, Ord1, Read1, Show1 )
|
||||
import Data.Kind ( Type )
|
||||
import GHC.Exts ( IsList )
|
||||
import Prelude hiding ( null )
|
||||
|
||||
-- hasql
|
||||
import qualified Hasql.Decoders as Hasql
|
||||
|
||||
-- opaleye
|
||||
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
|
||||
|
||||
-- rel8
|
||||
import Rel8.Expr.Opaleye ( zipPrimExprsWith )
|
||||
import Rel8.Expr.Serialize ( litExpr )
|
||||
import Rel8.Schema.Null ( Unnullify, Nullity( Null, NotNull ), Sql, nullable )
|
||||
import Rel8.Type ( DBType, typeInformation )
|
||||
import Rel8.Type.Eq ( DBEq )
|
||||
import Rel8.Type.Information ( TypeInformation(..) )
|
||||
import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
|
||||
import Rel8.Type.Ord ( DBMax, DBMin, DBOrd )
|
||||
import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )
|
||||
|
||||
-- semigroupoids
|
||||
import Data.Functor.Alt ( Alt, (<!>) )
|
||||
import Data.Functor.Apply ( Apply )
|
||||
import Data.Functor.Bind ( Bind )
|
||||
import Data.Functor.Plus ( Plus )
|
||||
|
||||
-- semialign
|
||||
import Data.Align ( Align )
|
||||
import Data.Semialign ( Semialign )
|
||||
import Data.Zip ( Repeat, Unzip, Zip )
|
||||
|
||||
|
||||
-- | A one dimensional array.
|
||||
newtype Array1D a = Array1D [a]
|
||||
deriving stock Traversable
|
||||
deriving newtype
|
||||
( Eq, Ord, Read, Show, Semigroup, Monoid, IsList
|
||||
, Functor, Foldable
|
||||
, Eq1, Ord1, Read1, Show1
|
||||
, FromJSON1, ToJSON1, FromJSON, FromJSONKey, ToJSON, ToJSONKey
|
||||
, Apply, Applicative, Alternative, Plus, Bind, Monad, MonadPlus
|
||||
, Align, Semialign, Repeat, Unzip, Zip
|
||||
)
|
||||
|
||||
|
||||
instance Alt Array1D where
|
||||
(<!>) = (<|>)
|
||||
|
||||
|
||||
getArray1D :: Array1D a -> [a]
|
||||
getArray1D (Array1D a) = a
|
||||
|
||||
|
||||
type IsArray1D :: Type -> Bool
|
||||
type family IsArray1D a where
|
||||
IsArray1D (Array1D _) = 'True
|
||||
IsArray1D _ = 'False
|
||||
|
||||
|
||||
class IsArray1D a ~ 'False => NotArray a
|
||||
instance IsArray1D a ~ 'False => NotArray a
|
||||
|
||||
|
||||
array1DTypeInformation :: Sql NotArray a
|
||||
=> Nullity a
|
||||
-> TypeInformation (Unnullify a)
|
||||
-> TypeInformation (Array1D a)
|
||||
array1DTypeInformation nullity info =
|
||||
case info of
|
||||
TypeInformation{ encode, decode, typeName } -> TypeInformation
|
||||
{ decode = case nullity of
|
||||
Null -> Array1D <$> Hasql.listArray (Hasql.nullable decode)
|
||||
NotNull -> Array1D <$> Hasql.listArray (Hasql.nonNullable decode)
|
||||
, encode = case nullity of
|
||||
Null -> Opaleye.ArrayExpr . fmap (maybe null encode) . getArray1D
|
||||
NotNull -> Opaleye.ArrayExpr . fmap encode . getArray1D
|
||||
, typeName = typeName <> "[]"
|
||||
}
|
||||
where
|
||||
null = Opaleye.ConstExpr Opaleye.NullLit
|
||||
|
||||
|
||||
instance (Sql DBType a, Sql NotArray a) => DBType (Array1D a) where
|
||||
typeInformation = array1DTypeInformation nullable typeInformation
|
||||
|
||||
|
||||
instance (Sql DBEq a, Sql NotArray a) => DBEq (Array1D a)
|
||||
|
||||
|
||||
instance (Sql DBOrd a, Sql NotArray a) => DBOrd (Array1D a)
|
||||
|
||||
|
||||
instance (Sql DBMax a, Sql NotArray a) => DBMax (Array1D a)
|
||||
|
||||
|
||||
instance (Sql DBMin a, Sql NotArray a) => DBMin (Array1D a)
|
||||
|
||||
|
||||
instance (Sql DBType a, Sql NotArray a) => DBSemigroup (Array1D a) where
|
||||
(<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))
|
||||
|
||||
|
||||
instance (Sql DBType a, Sql NotArray a) => DBMonoid (Array1D a) where
|
||||
memptyExpr = litExpr mempty
|
@ -27,7 +27,7 @@ import Data.CaseInsensitive ( CI )
|
||||
import {-# SOURCE #-} Rel8.Expr ( Expr )
|
||||
import Rel8.Expr.Array ( sempty )
|
||||
import Rel8.Expr.Serialize ( litExpr )
|
||||
import Rel8.Schema.Null ( Sql, nullable )
|
||||
import Rel8.Schema.Null ( Sql )
|
||||
import Rel8.Type ( DBType, typeInformation )
|
||||
import Rel8.Type.Semigroup ( DBSemigroup )
|
||||
|
||||
@ -48,7 +48,7 @@ class DBSemigroup a => DBMonoid a where
|
||||
|
||||
|
||||
instance Sql DBType a => DBMonoid [a] where
|
||||
memptyExpr = sempty nullable typeInformation
|
||||
memptyExpr = sempty typeInformation
|
||||
|
||||
|
||||
instance DBMonoid CalendarDiffTime where
|
||||
|
@ -13,10 +13,9 @@ module Rel8.Type.Semigroup
|
||||
where
|
||||
|
||||
-- base
|
||||
import Data.Function ( on )
|
||||
import Data.Kind ( Constraint, Type )
|
||||
import Data.List.NonEmpty ( NonEmpty )
|
||||
import Prelude
|
||||
import Prelude ()
|
||||
|
||||
-- bytestring
|
||||
import Data.ByteString ( ByteString )
|
||||
@ -30,10 +29,10 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
|
||||
|
||||
-- rel8
|
||||
import {-# SOURCE #-} Rel8.Expr ( Expr )
|
||||
import Rel8.Expr.Array ( sappend, sappend1 )
|
||||
import Rel8.Expr.Opaleye ( zipPrimExprsWith )
|
||||
import Rel8.Schema.Null ( Sql )
|
||||
import Rel8.Type ( DBType )
|
||||
import Rel8.Type.Array ( fromPrimArray, toPrimArray )
|
||||
|
||||
-- text
|
||||
import Data.Text ( Text )
|
||||
@ -53,13 +52,11 @@ class DBType a => DBSemigroup a where
|
||||
|
||||
|
||||
instance Sql DBType a => DBSemigroup [a] where
|
||||
(<>.) = zipPrimExprsWith do
|
||||
(fromPrimArray .) . Opaleye.BinExpr (Opaleye.:||) `on` toPrimArray
|
||||
(<>.) = sappend
|
||||
|
||||
|
||||
instance Sql DBType a => DBSemigroup (NonEmpty a) where
|
||||
(<>.) = zipPrimExprsWith do
|
||||
(fromPrimArray .) . Opaleye.BinExpr (Opaleye.:||) `on` toPrimArray
|
||||
(<>.) = sappend1
|
||||
|
||||
|
||||
instance DBSemigroup CalendarDiffTime where
|
||||
|
Loading…
Reference in New Issue
Block a user