{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
module Typson.Beam
( jsonPath
, JNullable(..)
, nullableJsonb
, nullableJson
) where
import qualified Data.Aeson as Aeson
import Data.Coerce (Coercible, coerce)
import Data.Kind (Type)
import Data.List (foldl')
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import Data.String (fromString)
import qualified Database.Beam as B
import qualified Database.Beam.Backend.SQL.SQL92 as B (HasSqlValueSyntax)
import qualified Database.Beam.Postgres as B
import qualified Database.PostgreSQL.Simple.FromField as Pg
import Typson
jsonPath :: ( TypeAtPath o tree path ~ field
, ReflectPath path
, B.IsPgJSON json
, Coercible (json field) (JNullable json' field)
)
=> proxy (path :: k)
-> ObjectTree tree o
-> B.QGenExpr ctxt B.Postgres s (json o)
-> B.QGenExpr ctxt B.Postgres s (JNullable json' field)
jsonPath :: proxy path
-> ObjectTree tree o
-> QGenExpr ctxt Postgres s (json o)
-> QGenExpr ctxt Postgres s (JNullable json' field)
jsonPath proxy path
path ObjectTree tree o
_ QGenExpr ctxt Postgres s (json o)
input = QGenExpr ctxt Postgres s (json Any)
-> QGenExpr ctxt Postgres s (JNullable json' field)
coerce (QGenExpr ctxt Postgres s (json Any)
-> QGenExpr ctxt Postgres s (JNullable json' field))
-> QGenExpr ctxt Postgres s (json Any)
-> QGenExpr ctxt Postgres s (JNullable json' field)
forall a b. (a -> b) -> a -> b
$
case proxy path -> NonEmpty PathComponent
forall k (path :: k) (proxy :: k -> *).
ReflectPath path =>
proxy path -> NonEmpty PathComponent
reflectPath proxy path
path of
PathComponent
p NE.:| [PathComponent]
ps -> (QGenExpr ctxt Postgres s (json Any)
-> PathComponent -> QGenExpr ctxt Postgres s (json Any))
-> QGenExpr ctxt Postgres s (json Any)
-> [PathComponent]
-> QGenExpr ctxt Postgres s (json Any)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' QGenExpr ctxt Postgres s (json Any)
-> PathComponent -> QGenExpr ctxt Postgres s (json Any)
forall (json :: * -> *) ctxt s a b.
IsPgJSON json =>
QGenExpr ctxt Postgres s (json a)
-> PathComponent -> QGenExpr ctxt Postgres s (json b)
buildPath (QGenExpr ctxt Postgres s (json o)
-> PathComponent -> QGenExpr ctxt Postgres s (json Any)
forall (json :: * -> *) ctxt s a b.
IsPgJSON json =>
QGenExpr ctxt Postgres s (json a)
-> PathComponent -> QGenExpr ctxt Postgres s (json b)
buildPath QGenExpr ctxt Postgres s (json o)
input PathComponent
p) [PathComponent]
ps
where
buildPath :: QGenExpr ctxt Postgres s (json a)
-> PathComponent -> QGenExpr ctxt Postgres s (json b)
buildPath QGenExpr ctxt Postgres s (json a)
p (Key String
k) = QGenExpr ctxt Postgres s (json a)
p QGenExpr ctxt Postgres s (json a)
-> QGenExpr ctxt Postgres s Text
-> QGenExpr ctxt Postgres s (json b)
forall (json :: * -> *) ctxt s a b.
IsPgJSON json =>
QGenExpr ctxt Postgres s (json a)
-> QGenExpr ctxt Postgres s Text
-> QGenExpr ctxt Postgres s (json b)
B.->$ String -> QGenExpr ctxt Postgres s Text
forall a. IsString a => String -> a
fromString String
k
buildPath QGenExpr ctxt Postgres s (json a)
p (Idx Integer
i) = QGenExpr ctxt Postgres s (json a)
p QGenExpr ctxt Postgres s (json a)
-> QGenExpr ctxt Postgres s Int32
-> QGenExpr ctxt Postgres s (json b)
forall (json :: * -> *) ctxt s a b.
IsPgJSON json =>
QGenExpr ctxt Postgres s (json a)
-> QGenExpr ctxt Postgres s Int32
-> QGenExpr ctxt Postgres s (json b)
B.-># Integer -> QGenExpr ctxt Postgres s Int32
forall a. Num a => Integer -> a
fromInteger Integer
i
newtype JNullable json a = JNullable (json a)
deriving (Eq (JNullable json a)
Eq (JNullable json a)
-> (JNullable json a -> JNullable json a -> Ordering)
-> (JNullable json a -> JNullable json a -> Bool)
-> (JNullable json a -> JNullable json a -> Bool)
-> (JNullable json a -> JNullable json a -> Bool)
-> (JNullable json a -> JNullable json a -> Bool)
-> (JNullable json a -> JNullable json a -> JNullable json a)
-> (JNullable json a -> JNullable json a -> JNullable json a)
-> Ord (JNullable json a)
JNullable json a -> JNullable json a -> Bool
JNullable json a -> JNullable json a -> Ordering
JNullable json a -> JNullable json a -> JNullable json a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (json :: k -> *) (a :: k).
Ord (json a) =>
Eq (JNullable json a)
forall k (json :: k -> *) (a :: k).
Ord (json a) =>
JNullable json a -> JNullable json a -> Bool
forall k (json :: k -> *) (a :: k).
Ord (json a) =>
JNullable json a -> JNullable json a -> Ordering
forall k (json :: k -> *) (a :: k).
Ord (json a) =>
JNullable json a -> JNullable json a -> JNullable json a
min :: JNullable json a -> JNullable json a -> JNullable json a
$cmin :: forall k (json :: k -> *) (a :: k).
Ord (json a) =>
JNullable json a -> JNullable json a -> JNullable json a
max :: JNullable json a -> JNullable json a -> JNullable json a
$cmax :: forall k (json :: k -> *) (a :: k).
Ord (json a) =>
JNullable json a -> JNullable json a -> JNullable json a
>= :: JNullable json a -> JNullable json a -> Bool
$c>= :: forall k (json :: k -> *) (a :: k).
Ord (json a) =>
JNullable json a -> JNullable json a -> Bool
> :: JNullable json a -> JNullable json a -> Bool
$c> :: forall k (json :: k -> *) (a :: k).
Ord (json a) =>
JNullable json a -> JNullable json a -> Bool
<= :: JNullable json a -> JNullable json a -> Bool
$c<= :: forall k (json :: k -> *) (a :: k).
Ord (json a) =>
JNullable json a -> JNullable json a -> Bool
< :: JNullable json a -> JNullable json a -> Bool
$c< :: forall k (json :: k -> *) (a :: k).
Ord (json a) =>
JNullable json a -> JNullable json a -> Bool
compare :: JNullable json a -> JNullable json a -> Ordering
$ccompare :: forall k (json :: k -> *) (a :: k).
Ord (json a) =>
JNullable json a -> JNullable json a -> Ordering
$cp1Ord :: forall k (json :: k -> *) (a :: k).
Ord (json a) =>
Eq (JNullable json a)
Ord, JNullable json a -> JNullable json a -> Bool
(JNullable json a -> JNullable json a -> Bool)
-> (JNullable json a -> JNullable json a -> Bool)
-> Eq (JNullable json a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (json :: k -> *) (a :: k).
Eq (json a) =>
JNullable json a -> JNullable json a -> Bool
/= :: JNullable json a -> JNullable json a -> Bool
$c/= :: forall k (json :: k -> *) (a :: k).
Eq (json a) =>
JNullable json a -> JNullable json a -> Bool
== :: JNullable json a -> JNullable json a -> Bool
$c== :: forall k (json :: k -> *) (a :: k).
Eq (json a) =>
JNullable json a -> JNullable json a -> Bool
Eq, Int -> JNullable json a -> ShowS
[JNullable json a] -> ShowS
JNullable json a -> String
(Int -> JNullable json a -> ShowS)
-> (JNullable json a -> String)
-> ([JNullable json a] -> ShowS)
-> Show (JNullable json a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (json :: k -> *) (a :: k).
Show (json a) =>
Int -> JNullable json a -> ShowS
forall k (json :: k -> *) (a :: k).
Show (json a) =>
[JNullable json a] -> ShowS
forall k (json :: k -> *) (a :: k).
Show (json a) =>
JNullable json a -> String
showList :: [JNullable json a] -> ShowS
$cshowList :: forall k (json :: k -> *) (a :: k).
Show (json a) =>
[JNullable json a] -> ShowS
show :: JNullable json a -> String
$cshow :: forall k (json :: k -> *) (a :: k).
Show (json a) =>
JNullable json a -> String
showsPrec :: Int -> JNullable json a -> ShowS
$cshowsPrec :: forall k (json :: k -> *) (a :: k).
Show (json a) =>
Int -> JNullable json a -> ShowS
Show) via json a
deriving QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr
ctxt Postgres s (PgSetOf (PgJSONEach (JNullable json Value)))
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONEach Text))
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf PgJSONKey)
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr
ctxt Postgres s (PgSetOf (PgJSONElement (JNullable json Value)))
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONElement Text))
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s Text
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (JNullable json b)
QExpr Postgres s a -> QAgg Postgres s (JNullable json a)
QExpr Postgres s key
-> QExpr Postgres s value -> QAgg Postgres s (JNullable json a)
(forall ctxt s a.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr
ctxt Postgres s (PgSetOf (PgJSONEach (JNullable json Value))))
-> (forall ctxt s a.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONEach Text)))
-> (forall ctxt s a.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf PgJSONKey))
-> (forall ctxt s a.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr
ctxt Postgres s (PgSetOf (PgJSONElement (JNullable json Value))))
-> (forall ctxt s a.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONElement Text)))
-> (forall ctxt s a.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s Text)
-> (forall ctxt s a b.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (JNullable json b))
-> (forall s a.
QExpr Postgres s a -> QAgg Postgres s (JNullable json a))
-> (forall s key value a.
QExpr Postgres s key
-> QExpr Postgres s value -> QAgg Postgres s (JNullable json a))
-> IsPgJSON (JNullable json)
forall s a.
QExpr Postgres s a -> QAgg Postgres s (JNullable json a)
forall ctxt s a.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s Text
forall ctxt s a.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONEach Text))
forall ctxt s a.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr
ctxt Postgres s (PgSetOf (PgJSONEach (JNullable json Value)))
forall ctxt s a.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf PgJSONKey)
forall ctxt s a.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONElement Text))
forall ctxt s a.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr
ctxt Postgres s (PgSetOf (PgJSONElement (JNullable json Value)))
forall ctxt s a b.
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (JNullable json b)
forall s key value a.
QExpr Postgres s key
-> QExpr Postgres s value -> QAgg Postgres s (JNullable json a)
forall (json :: * -> *) s a.
IsPgJSON json =>
QExpr Postgres s a -> QAgg Postgres s (JNullable json a)
forall (json :: * -> *) ctxt s a.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s Text
forall (json :: * -> *) ctxt s a.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONEach Text))
forall (json :: * -> *) ctxt s a.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr
ctxt Postgres s (PgSetOf (PgJSONEach (JNullable json Value)))
forall (json :: * -> *) ctxt s a.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf PgJSONKey)
forall (json :: * -> *) ctxt s a.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONElement Text))
forall (json :: * -> *) ctxt s a.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr
ctxt Postgres s (PgSetOf (PgJSONElement (JNullable json Value)))
forall (json :: * -> *) ctxt s a b.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (JNullable json b)
forall (json :: * -> *) s key value a.
IsPgJSON json =>
QExpr Postgres s key
-> QExpr Postgres s value -> QAgg Postgres s (JNullable json a)
forall (json :: * -> *).
(forall ctxt s a.
QGenExpr ctxt Postgres s (json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONEach (json Value))))
-> (forall ctxt s a.
QGenExpr ctxt Postgres s (json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONEach Text)))
-> (forall ctxt s a.
QGenExpr ctxt Postgres s (json a)
-> QGenExpr ctxt Postgres s (PgSetOf PgJSONKey))
-> (forall ctxt s a.
QGenExpr ctxt Postgres s (json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONElement (json Value))))
-> (forall ctxt s a.
QGenExpr ctxt Postgres s (json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONElement Text)))
-> (forall ctxt s a.
QGenExpr ctxt Postgres s (json a) -> QGenExpr ctxt Postgres s Text)
-> (forall ctxt s a b.
QGenExpr ctxt Postgres s (json a)
-> QGenExpr ctxt Postgres s (json b))
-> (forall s a. QExpr Postgres s a -> QAgg Postgres s (json a))
-> (forall s key value a.
QExpr Postgres s key
-> QExpr Postgres s value -> QAgg Postgres s (json a))
-> IsPgJSON json
pgJsonObjectAgg :: QExpr Postgres s key
-> QExpr Postgres s value -> QAgg Postgres s (JNullable json a)
$cpgJsonObjectAgg :: forall (json :: * -> *) s key value a.
IsPgJSON json =>
QExpr Postgres s key
-> QExpr Postgres s value -> QAgg Postgres s (JNullable json a)
pgJsonAgg :: QExpr Postgres s a -> QAgg Postgres s (JNullable json a)
$cpgJsonAgg :: forall (json :: * -> *) s a.
IsPgJSON json =>
QExpr Postgres s a -> QAgg Postgres s (JNullable json a)
pgJsonStripNulls :: QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (JNullable json b)
$cpgJsonStripNulls :: forall (json :: * -> *) ctxt s a b.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (JNullable json b)
pgJsonTypeOf :: QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s Text
$cpgJsonTypeOf :: forall (json :: * -> *) ctxt s a.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s Text
pgJsonArrayElementsText :: QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONElement Text))
$cpgJsonArrayElementsText :: forall (json :: * -> *) ctxt s a.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONElement Text))
pgJsonArrayElements :: QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr
ctxt Postgres s (PgSetOf (PgJSONElement (JNullable json Value)))
$cpgJsonArrayElements :: forall (json :: * -> *) ctxt s a.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr
ctxt Postgres s (PgSetOf (PgJSONElement (JNullable json Value)))
pgJsonKeys :: QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf PgJSONKey)
$cpgJsonKeys :: forall (json :: * -> *) ctxt s a.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf PgJSONKey)
pgJsonEachText :: QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONEach Text))
$cpgJsonEachText :: forall (json :: * -> *) ctxt s a.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr ctxt Postgres s (PgSetOf (PgJSONEach Text))
pgJsonEach :: QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr
ctxt Postgres s (PgSetOf (PgJSONEach (JNullable json Value)))
$cpgJsonEach :: forall (json :: * -> *) ctxt s a.
IsPgJSON json =>
QGenExpr ctxt Postgres s (JNullable json a)
-> QGenExpr
ctxt Postgres s (PgSetOf (PgJSONEach (JNullable json Value)))
B.IsPgJSON via json
deriving via (json a :: Type) instance (B.HasSqlValueSyntax syn (json a))
=> B.HasSqlValueSyntax syn (JNullable json a)
instance ( Pg.FromField (json a :: Type)
, B.Typeable (a :: Type)
, B.Typeable json
)
=> B.FromBackendRow B.Postgres (JNullable json a)
instance Pg.FromField (json a) => Pg.FromField (JNullable json a) where
fromField :: FieldParser (JNullable json a)
fromField Field
f Maybe ByteString
mbBs = json a -> JNullable json a
forall k (json :: k -> *) (a :: k). json a -> JNullable json a
JNullable
(json a -> JNullable json a)
-> Conversion (json a) -> Conversion (JNullable json a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser (json a)
forall a. FromField a => FieldParser a
Pg.fromField Field
f (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"null" Maybe ByteString
mbBs)
nullableJsonb :: forall a. (Aeson.ToJSON a, Aeson.FromJSON a)
=> B.DataType B.Postgres (JNullable B.PgJSONB a)
nullableJsonb :: DataType Postgres (JNullable PgJSONB a)
nullableJsonb = DataType Postgres (PgJSONB a)
-> DataType Postgres (JNullable PgJSONB a)
coerce (DataType Postgres (PgJSONB a)
forall a. (ToJSON a, FromJSON a) => DataType Postgres (PgJSONB a)
B.jsonb :: B.DataType B.Postgres (B.PgJSONB a))
nullableJson :: forall a. (Aeson.ToJSON a, Aeson.FromJSON a)
=> B.DataType B.Postgres (JNullable B.PgJSON a)
nullableJson :: DataType Postgres (JNullable PgJSON a)
nullableJson = DataType Postgres (PgJSON a)
-> DataType Postgres (JNullable PgJSON a)
coerce (DataType Postgres (PgJSON a)
forall a. (ToJSON a, FromJSON a) => DataType Postgres (PgJSON a)
B.json :: B.DataType B.Postgres (B.PgJSON a))