git.iko.soy/rel8
on cf8bdc7 help sign in
rel8/src/Rel8/Type/Array.hs
80 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.Null ( Unnullify, Nullity( Null, NotNull ) )
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
35{-# INLINABLE array #-}
38listTypeInformation :: ()
39 => Nullity a
40 -> TypeInformation (Unnullify a)
41 -> TypeInformation [a]
42listTypeInformation nullity info =
43 case info of
44 TypeInformation{ encode, decode } -> TypeInformation
45 { decode = row $ case nullity of
46 Null -> Hasql.listArray (Hasql.nullable decode)
47 NotNull -> Hasql.listArray (Hasql.nonNullable decode)
48 , encode = case nullity of
49 Null -> array info . fmap (maybe null encode)
50 NotNull -> array info . fmap encode
51 , typeName = "record"
52 }
53 where
54 row = Hasql.composite . Hasql.field . Hasql.nonNullable
55 null = Opaleye.ConstExpr Opaleye.NullLit
58nonEmptyTypeInformation :: ()
59 => Nullity a
60 -> TypeInformation (Unnullify a)
61 -> TypeInformation (NonEmpty a)
62nonEmptyTypeInformation nullity =
63 parseTypeInformation parse toList . listTypeInformation nullity
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))