git.iko.soy/rel8
on 6a3913b help sign in
rel8/src/Rel8/Type/Array.hs
79 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 ( Unnullify, 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
39 -> TypeInformation (Unnullify a)
40 -> TypeInformation [a]
41listTypeInformation nullability info =
42 case info of
43 TypeInformation{ encode, decode } -> TypeInformation
44 { decode = row $ case nullability of
45 Nullable -> Hasql.listArray (Hasql.nullable decode)
46 NonNullable -> Hasql.listArray (Hasql.nonNullable decode)
47 , encode = case nullability of
48 Nullable -> array info . fmap (maybe null encode)
49 NonNullable -> array info . fmap encode
50 , typeName = "record"
51 }
52 where
53 row = Hasql.composite . Hasql.field . Hasql.nonNullable
54 null = Opaleye.ConstExpr Opaleye.NullLit
57nonEmptyTypeInformation :: ()
58 => Nullability a
59 -> TypeInformation (Unnullify a)
60 -> TypeInformation (NonEmpty a)
61nonEmptyTypeInformation nullability =
62 parseTypeInformation parse toList . listTypeInformation nullability
63 where
64 parse = maybe (Left message) Right . nonEmpty
65 message = "failed to decode NonEmptyList: got empty list"
68fromPrimArray :: Opaleye.PrimExpr -> Opaleye.PrimExpr
69fromPrimArray = Opaleye.UnExpr (Opaleye.UnOpOther "ROW")
72toPrimArray :: Opaleye.PrimExpr -> Opaleye.PrimExpr
73toPrimArray a = Opaleye.CompositeExpr a "f1"
76zipPrimArraysWith :: ()
77 => (Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr)
78 -> Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr
79zipPrimArraysWith f a b = fromPrimArray (f (toPrimArray a) (toPrimArray b))