git.iko.soy/rel8
on beca9e0 help sign in
rel8/src/Rel8/Type/Array.hs
80 lines 2.4 kB history raw
1{-# language GADTs #-}
2{-# language NamedFieldPuns #-}
3{-# language OverloadedStrings #-}
5module Rel8.Type.Array
6 ( array
7 , listTypeInformation
8 , nonEmptyTypeInformation
9 , fromPrimArray, toPrimArray, zipPrimArraysWith
10 )
11where
13-- base
14import Data.Foldable ( toList )
15import Data.List.NonEmpty ( NonEmpty, nonEmpty )
16import Prelude hiding ( null, repeat, zipWith )
18-- hasql
19import qualified Hasql.Decoders as Hasql
21-- opaleye
22import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
24-- rel8
25import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
26import Rel8.Type.Information ( TypeInformation(..), parseTypeInformation )
29array :: Foldable f
30 => TypeInformation a -> f Opaleye.PrimExpr -> Opaleye.PrimExpr
31array TypeInformation {typeName} =
32 fromPrimArray .
33 Opaleye.CastExpr (typeName <> "[]") .
34 Opaleye.ArrayExpr . toList
37listTypeInformation :: ()
38 => Nullability a ma
39 -> TypeInformation a
40 -> TypeInformation [ma]
41listTypeInformation nullability info =
42 case info of
43 TypeInformation{ encode, decode, out } -> TypeInformation
44 { decode = row $ case nullability of
45 Nullable -> Hasql.listArray (Hasql.nullable (out <$> decode))
46 NonNullable -> Hasql.listArray (Hasql.nonNullable (out <$> decode))
47 , encode = case nullability of
48 Nullable -> array info . fmap (maybe null encode)
49 NonNullable -> array info . fmap encode
50 , typeName = "record"
51 , out = id
52 }
53 where
54 row = Hasql.composite . Hasql.field . Hasql.nonNullable
55 null = Opaleye.ConstExpr Opaleye.NullLit
58nonEmptyTypeInformation :: ()
59 => Nullability a ma
60 -> TypeInformation a
61 -> TypeInformation (NonEmpty ma)
62nonEmptyTypeInformation nullability =
63 parseTypeInformation parse toList . listTypeInformation nullability
64 where
65 parse = maybe (Left message) Right . nonEmpty
66 message = "failed to decode NonEmptyList: got empty list"
69fromPrimArray :: Opaleye.PrimExpr -> Opaleye.PrimExpr
70fromPrimArray = Opaleye.UnExpr (Opaleye.UnOpOther "ROW")
73toPrimArray :: Opaleye.PrimExpr -> Opaleye.PrimExpr
74toPrimArray a = Opaleye.CompositeExpr a "f1"
77zipPrimArraysWith :: ()
78 => (Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr)
79 -> Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr
80zipPrimArraysWith f a b = fromPrimArray (f (toPrimArray a) (toPrimArray b))