{-# 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)