{-# 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 NodeSelector '[] -> (NodeSelector '[] -> NodeSelector '[]) -> NodeSelector '[] forall a b. a -> (a -> b) -> b & Text -> NodeSelector '[] -> NodeSelector '[] forall k (a :: k -> *) (types :: k). SelectorLike a => Text -> a types -> a types withIdentifier (String -> Text pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ Proxy# x -> String forall (n :: Symbol). KnownSymbol n => Proxy# n -> String symbolVal' @x Proxy# 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 RelSelector 'Nothing -> (RelSelector 'Nothing -> RelSelector 'Nothing) -> RelSelector 'Nothing forall a b. a -> (a -> b) -> b & Text -> RelSelector 'Nothing -> RelSelector 'Nothing forall k (a :: k -> *) (types :: k). SelectorLike a => Text -> a types -> a types withIdentifier (String -> Text pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ Proxy# x -> String forall (n :: Symbol). KnownSymbol n => Proxy# n -> String symbolVal' @x Proxy# x forall k (a :: k). Proxy# a proxy#) instance (field ~ field1, KnownSymbol field) => IsLabel field (SymbolS field1) where fromLabel :: SymbolS field1 fromLabel = String -> SymbolS field1 forall (s :: Symbol). String -> SymbolS s SymbolS (String -> SymbolS field1) -> String -> SymbolS field1 forall a b. (a -> b) -> a -> b $ Proxy# field -> String forall (n :: Symbol). KnownSymbol n => Proxy# n -> String symbolVal' @field Proxy# 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 :: Text -> NodeSelector types -> NodeSelector types withIdentifier = (Text -> NodeSelector -> NodeSelector) -> Text -> NodeSelector types -> NodeSelector types coerce ((Text -> NodeSelector -> NodeSelector) -> Text -> NodeSelector types -> NodeSelector types) -> (Text -> NodeSelector -> NodeSelector) -> Text -> NodeSelector types -> NodeSelector types forall a b. (a -> b) -> a -> b $ SelectorLike NodeSelector => Text -> NodeSelector -> NodeSelector 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 :: NodeSelector types -> NodeSelector (typ : types) withLabel = (NodeSelector -> NodeSelector) -> NodeSelector types -> NodeSelector (typ : types) coerce ((NodeSelector -> NodeSelector) -> NodeSelector types -> NodeSelector (typ : types)) -> (NodeSelector -> NodeSelector) -> NodeSelector types -> NodeSelector (typ : types) forall a b. (a -> b) -> a -> b $ SelectorLike NodeSelector => Text -> NodeSelector -> NodeSelector forall a. SelectorLike a => Text -> a -> a UT.withLabel @UT.NodeSelector (Text -> NodeSelector -> NodeSelector) -> Text -> NodeSelector -> NodeSelector forall a b. (a -> b) -> a -> b $ String -> Text pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ Proxy# label -> String forall (n :: Symbol). KnownSymbol n => Proxy# n -> String symbolVal' @label Proxy# 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 :: (SymbolS field, typ) -> NodeSelector types -> NodeSelector types withProp (SymbolS String field, typ val) = (NodeSelector -> NodeSelector) -> NodeSelector types -> NodeSelector types coerce ((NodeSelector -> NodeSelector) -> NodeSelector types -> NodeSelector types) -> (NodeSelector -> NodeSelector) -> NodeSelector types -> NodeSelector types forall a b. (a -> b) -> a -> b $ SelectorLike NodeSelector => (Text, Value) -> NodeSelector -> NodeSelector forall a. SelectorLike a => (Text, Value) -> a -> a UT.withProp @UT.NodeSelector ((Text, Value) -> NodeSelector -> NodeSelector) -> (Text, Value) -> NodeSelector -> NodeSelector forall a b. (a -> b) -> a -> b $ String -> Text pack String field Text -> typ -> (Text, Value) 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 :: (SymbolS field, Text) -> NodeSelector types -> NodeSelector types withParam (SymbolS String field, Text name) = (NodeSelector -> NodeSelector) -> NodeSelector types -> NodeSelector types coerce ((NodeSelector -> NodeSelector) -> NodeSelector types -> NodeSelector types) -> (NodeSelector -> NodeSelector) -> NodeSelector types -> NodeSelector types forall a b. (a -> b) -> a -> b $ (Text, Text) -> NodeSelector -> NodeSelector 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 :: Text -> RelSelector types -> RelSelector types withIdentifier = (Text -> RelSelector -> RelSelector) -> Text -> RelSelector types -> RelSelector types coerce ((Text -> RelSelector -> RelSelector) -> Text -> RelSelector types -> RelSelector types) -> (Text -> RelSelector -> RelSelector) -> Text -> RelSelector types -> RelSelector types forall a b. (a -> b) -> a -> b $ SelectorLike RelSelector => Text -> RelSelector -> RelSelector 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 :: RelSelector types -> RelSelector (AddType types typ) withLabel = (RelSelector -> RelSelector) -> RelSelector types -> RelSelector (AddType types typ) coerce ((RelSelector -> RelSelector) -> RelSelector types -> RelSelector (AddType types typ)) -> (RelSelector -> RelSelector) -> RelSelector types -> RelSelector (AddType types typ) forall a b. (a -> b) -> a -> b $ SelectorLike RelSelector => Text -> RelSelector -> RelSelector forall a. SelectorLike a => Text -> a -> a UT.withLabel @UT.RelSelector (Text -> RelSelector -> RelSelector) -> Text -> RelSelector -> RelSelector forall a b. (a -> b) -> a -> b $ String -> Text pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ Proxy# label -> String forall (n :: Symbol). KnownSymbol n => Proxy# n -> String symbolVal' @label Proxy# 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 :: (SymbolS field, typ) -> RelSelector types -> RelSelector types withProp (SymbolS String field, typ val) = (RelSelector -> RelSelector) -> RelSelector types -> RelSelector types coerce ((RelSelector -> RelSelector) -> RelSelector types -> RelSelector types) -> (RelSelector -> RelSelector) -> RelSelector types -> RelSelector types forall a b. (a -> b) -> a -> b $ SelectorLike RelSelector => (Text, Value) -> RelSelector -> RelSelector forall a. SelectorLike a => (Text, Value) -> a -> a UT.withProp @UT.RelSelector ((Text, Value) -> RelSelector -> RelSelector) -> (Text, Value) -> RelSelector -> RelSelector forall a b. (a -> b) -> a -> b $ String -> Text pack String field Text -> typ -> (Text, Value) 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 :: (SymbolS field, Text) -> RelSelector types -> RelSelector types withParam (SymbolS String field, Text name) = (RelSelector -> RelSelector) -> RelSelector types -> RelSelector types coerce ((RelSelector -> RelSelector) -> RelSelector types -> RelSelector types) -> (RelSelector -> RelSelector) -> RelSelector types -> RelSelector types forall a b. (a -> b) -> a -> b $ (Text, Text) -> RelSelector -> RelSelector forall a. SelectorLike a => (Text, Text) -> a -> a UT.withParam @UT.RelSelector (String -> Text pack String field, Text name)