{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Database.Bolt.Extras.DSL.Typed.Instances where import Data.Coerce (coerce) import Data.Function ((&)) import Data.Kind (Type) import Data.Text (Text, pack) import GHC.Exts (proxy#) import GHC.Generics (Rep) import GHC.OverloadedLabels (IsLabel (..)) import GHC.TypeLits (ErrorMessage (..), KnownSymbol, Symbol, TypeError, symbolVal') import qualified Database.Bolt as B import qualified Database.Bolt.Extras.DSL as UT import Database.Bolt.Extras.DSL.Typed.Families import Database.Bolt.Extras.DSL.Typed.Types instance (KnownSymbol x, types ~ '[]) => IsLabel x (NodeSelector types) where fromLabel :: NodeSelector types fromLabel = NodeSelector '[] defN forall a b. a -> (a -> b) -> b & forall k (a :: k -> *) (types :: k). SelectorLike a => Text -> a types -> a types withIdentifier (String -> Text pack forall a b. (a -> b) -> a -> b $ forall (n :: Symbol). KnownSymbol n => Proxy# n -> String symbolVal' @x forall {k} (a :: k). Proxy# a proxy#) instance (KnownSymbol x, types ~ 'Nothing) => IsLabel x (RelSelector types) where fromLabel :: RelSelector types fromLabel = RelSelector 'Nothing defR forall a b. a -> (a -> b) -> b & forall k (a :: k -> *) (types :: k). SelectorLike a => Text -> a types -> a types withIdentifier (String -> Text pack forall a b. (a -> b) -> a -> b $ forall (n :: Symbol). KnownSymbol n => Proxy# n -> String symbolVal' @x forall {k} (a :: k). Proxy# a proxy#) instance (field ~ field1, KnownSymbol field) => IsLabel field (SymbolS field1) where fromLabel :: SymbolS field1 fromLabel = forall (s :: Symbol). String -> SymbolS s SymbolS forall a b. (a -> b) -> a -> b $ forall (n :: Symbol). KnownSymbol n => Proxy# n -> String symbolVal' @field forall {k} (a :: k). Proxy# a proxy# instance SelectorLike NodeSelector where type CanAddType _ = () type AddType (types :: [Type]) (typ :: Type) = typ ': types type HasField (types :: [Type]) (field :: Symbol) (typ :: Type) = Assert (NoFieldError field types) (GetTypeFromList field types) ~ typ type HasField' (types :: [Type]) (field :: Symbol) = AssertC (NoFieldError field types) (GetTypeFromList field types) withIdentifier :: forall (types :: [*]). Text -> NodeSelector types -> NodeSelector types withIdentifier = coerce :: forall a b. Coercible a b => a -> b coerce forall a b. (a -> b) -> a -> b $ forall a. SelectorLike a => Text -> a -> a UT.withIdentifier @UT.NodeSelector withLabel :: forall (typ :: Type) (types :: [Type]) (label :: Symbol) . label ~ GetTypeName (Rep typ) => KnownSymbol label => NodeSelector types -> NodeSelector (typ ': types) withLabel :: forall typ (types :: [*]) (label :: Symbol). (label ~ GetTypeName (Rep typ), KnownSymbol label) => NodeSelector types -> NodeSelector (typ : types) withLabel = coerce :: forall a b. Coercible a b => a -> b coerce forall a b. (a -> b) -> a -> b $ forall a. SelectorLike a => Text -> a -> a UT.withLabel @UT.NodeSelector forall a b. (a -> b) -> a -> b $ String -> Text pack forall a b. (a -> b) -> a -> b $ forall (n :: Symbol). KnownSymbol n => Proxy# n -> String symbolVal' @label forall {k} (a :: k). Proxy# a proxy# withProp :: forall (field :: Symbol) (types :: [Type]) (typ :: Type) . B.IsValue typ => (SymbolS field, typ) -> NodeSelector types -> NodeSelector types withProp :: forall (field :: Symbol) (types :: [*]) typ. IsValue typ => (SymbolS field, typ) -> NodeSelector types -> NodeSelector types withProp (SymbolS String field, typ val) = coerce :: forall a b. Coercible a b => a -> b coerce forall a b. (a -> b) -> a -> b $ forall a. SelectorLike a => (Text, Value) -> a -> a UT.withProp @UT.NodeSelector forall a b. (a -> b) -> a -> b $ String -> Text pack String field forall a. IsValue a => Text -> a -> (Text, Value) B.=: typ val withParam :: forall (field :: Symbol) (types :: [Type]) . (SymbolS field, Text) -> NodeSelector types -> NodeSelector types withParam :: forall (field :: Symbol) (types :: [*]). (SymbolS field, Text) -> NodeSelector types -> NodeSelector types withParam (SymbolS String field, Text name) = coerce :: forall a b. Coercible a b => a -> b coerce forall a b. (a -> b) -> a -> b $ forall a. SelectorLike a => (Text, Text) -> a -> a UT.withParam @UT.NodeSelector (String -> Text pack String field, Text name) instance SelectorLike RelSelector where type CanAddType 'Nothing = () type CanAddType ('Just a) = TypeError ('Text "Can't add a new label to relationship selector that already has label " ':<>: 'ShowType a ':<>: 'Text "!" ) type AddType 'Nothing (typ :: Type) = 'Just typ type HasField 'Nothing (field :: Symbol) _ = TypeError ('Text "Tried to set property " ':<>: 'ShowType field ':<>: 'Text " on a relationship without label!" ) type HasField ('Just record) (field :: Symbol) (typ :: Type) = Assert (NoFieldError field '[record]) (GetTypeFromRecord field (Rep record)) ~ typ type HasField' 'Nothing (field :: Symbol) = TypeError ('Text "Tried to set property " ':<>: 'ShowType field ':<>: 'Text " on a relationship without label!" ) type HasField' ('Just record) (field :: Symbol) = Assert (NoFieldError field '[record]) (RecordHasField field (Rep record)) ~ 'True withIdentifier :: forall (types :: Maybe (*)). Text -> RelSelector types -> RelSelector types withIdentifier = coerce :: forall a b. Coercible a b => a -> b coerce forall a b. (a -> b) -> a -> b $ forall a. SelectorLike a => Text -> a -> a UT.withIdentifier @UT.RelSelector withLabel :: forall (typ :: Type) (types :: Maybe Type) (label :: Symbol) . CanAddType types => GetTypeName (Rep typ) ~ label => KnownSymbol label => RelSelector types -> RelSelector (AddType types typ) withLabel :: forall typ (types :: Maybe (*)) (label :: Symbol). (CanAddType types, GetTypeName (Rep typ) ~ label, KnownSymbol label) => RelSelector types -> RelSelector (AddType types typ) withLabel = coerce :: forall a b. Coercible a b => a -> b coerce forall a b. (a -> b) -> a -> b $ forall a. SelectorLike a => Text -> a -> a UT.withLabel @UT.RelSelector forall a b. (a -> b) -> a -> b $ String -> Text pack forall a b. (a -> b) -> a -> b $ forall (n :: Symbol). KnownSymbol n => Proxy# n -> String symbolVal' @label forall {k} (a :: k). Proxy# a proxy# withProp :: forall (field :: Symbol) (types :: Maybe Type) (typ :: Type) . B.IsValue typ => (SymbolS field, typ) -> RelSelector types -> RelSelector types withProp :: forall (field :: Symbol) (types :: Maybe (*)) typ. IsValue typ => (SymbolS field, typ) -> RelSelector types -> RelSelector types withProp (SymbolS String field, typ val) = coerce :: forall a b. Coercible a b => a -> b coerce forall a b. (a -> b) -> a -> b $ forall a. SelectorLike a => (Text, Value) -> a -> a UT.withProp @UT.RelSelector forall a b. (a -> b) -> a -> b $ String -> Text pack String field forall a. IsValue a => Text -> a -> (Text, Value) B.=: typ val withParam :: forall (field :: Symbol) (types :: Maybe Type) . (SymbolS field, Text) -> RelSelector types -> RelSelector types withParam :: forall (field :: Symbol) (types :: Maybe (*)). (SymbolS field, Text) -> RelSelector types -> RelSelector types withParam (SymbolS String field, Text name) = coerce :: forall a b. Coercible a b => a -> b coerce forall a b. (a -> b) -> a -> b $ forall a. SelectorLike a => (Text, Text) -> a -> a UT.withParam @UT.RelSelector (String -> Text pack String field, Text name)