git.iko.soy/rel8
on 4475085 help sign in
rel8/src/Rel8/Type/Array.hs
88 lines 2.4 kB history raw
1{-# language GADTs #-}
2{-# language LambdaCase #-}
3{-# language NamedFieldPuns #-}
4{-# language OverloadedStrings #-}
5{-# language ViewPatterns #-}
7module Rel8.Type.Array
8 ( array, wrap
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 (wrap 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 -> Hasql.listArray (Hasql.nullable (unwrap info decode))
46 NotNull -> Hasql.listArray (Hasql.nonNullable (unwrap info decode))
47 , encode = case nullity of
48 Null -> Opaleye.ArrayExpr . fmap (wrap info . maybe null encode)
49 NotNull -> Opaleye.ArrayExpr . fmap (wrap info . encode)
50 , typeName = arrayType info <> "[]"
51 }
52 where
53 null = Opaleye.ConstExpr Opaleye.NullLit
56nonEmptyTypeInformation :: ()
57 => Nullity a
58 -> TypeInformation (Unnullify a)
59 -> TypeInformation (NonEmpty a)
60nonEmptyTypeInformation nullity =
61 parseTypeInformation parse toList . listTypeInformation nullity
62 where
63 parse = maybe (Left message) Right . nonEmpty
64 message = "failed to decode NonEmptyList: got empty list"
67isArray :: TypeInformation a -> Bool
68isArray = \case
69 (reverse . typeName -> ']' : '[' : _) -> True
70 _ -> False
73arrayType :: TypeInformation a -> String
74arrayType info
75 | isArray info = "record"
76 | otherwise = typeName info
79wrap :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
80wrap info
81 | isArray info = Opaleye.UnExpr (Opaleye.UnOpOther "ROW")
82 | otherwise = id
85unwrap :: TypeInformation a -> Hasql.Value x -> Hasql.Value x
86unwrap info
87 | isArray info = Hasql.composite . Hasql.field . Hasql.nonNullable
88 | otherwise = id