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