git.iko.soy/rel8
on ef28940 help sign in
rel8/src/Rel8/Type/Array.hs
100 lines 2.8 kB history raw
1{-# language GADTs #-}
2{-# language LambdaCase #-}
3{-# language NamedFieldPuns #-}
4{-# language OverloadedStrings #-}
5{-# language ViewPatterns #-}
7module Rel8.Type.Array
8 ( array, encodeArrayElement, extractArrayElement
9 , listTypeInformation
10 , nonEmptyTypeInformation
11 )
12where
14-- base
15import Data.Foldable ( toList )
16import Data.List.NonEmpty ( NonEmpty, nonEmpty )
17import Prelude hiding ( null, repeat, zipWith )
19-- hasql
20import qualified Hasql.Decoders as Hasql
22-- opaleye
23import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
25-- rel8
26import Rel8.Schema.Null ( Unnullify, Nullity( Null, NotNull ) )
27import Rel8.Type.Information ( TypeInformation(..), parseTypeInformation )
30array :: Foldable f
31 => TypeInformation a -> f Opaleye.PrimExpr -> Opaleye.PrimExpr
32array info =
33 Opaleye.CastExpr (arrayType info <> "[]") .
34 Opaleye.ArrayExpr . map (encodeArrayElement info) . toList
35{-# INLINABLE array #-}
38listTypeInformation :: ()
39 => Nullity a
40 -> TypeInformation (Unnullify a)
41 -> TypeInformation [a]
42listTypeInformation nullity info@TypeInformation {encode, decode} =
43 TypeInformation
44 { decode = case nullity of
45 Null ->
46 Hasql.listArray (decodeArrayElement info (Hasql.nullable decode))
47 NotNull ->
48 Hasql.listArray (decodeArrayElement info (Hasql.nonNullable decode))
49 , encode = case nullity of
50 Null ->
51 Opaleye.ArrayExpr .
52 fmap (encodeArrayElement info . maybe null encode)
53 NotNull ->
54 Opaleye.ArrayExpr .
55 fmap (encodeArrayElement info . encode)
56 , typeName = arrayType info <> "[]"
57 }
58 where
59 null = Opaleye.ConstExpr Opaleye.NullLit
62nonEmptyTypeInformation :: ()
63 => Nullity a
64 -> TypeInformation (Unnullify a)
65 -> TypeInformation (NonEmpty a)
66nonEmptyTypeInformation nullity =
67 parseTypeInformation parse toList . listTypeInformation nullity
68 where
69 parse = maybe (Left message) Right . nonEmpty
70 message = "failed to decode NonEmptyList: got empty list"
73isArray :: TypeInformation a -> Bool
74isArray = \case
75 (reverse . typeName -> ']' : '[' : _) -> True
76 _ -> False
79arrayType :: TypeInformation a -> String
80arrayType info
81 | isArray info = "record"
82 | otherwise = typeName info
85decodeArrayElement :: TypeInformation a -> Hasql.NullableOrNot Hasql.Value x -> Hasql.NullableOrNot Hasql.Value x
86decodeArrayElement info
87 | isArray info = Hasql.nonNullable . Hasql.composite . Hasql.field
88 | otherwise = id
91encodeArrayElement :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
92encodeArrayElement info
93 | isArray info = Opaleye.UnExpr (Opaleye.UnOpOther "ROW")
94 | otherwise = id
97extractArrayElement :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
98extractArrayElement info
99 | isArray info = flip Opaleye.CompositeExpr "f1"
100 | otherwise = id