{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Database.Bolt.Extras.DSL.Internal.Instances () where

import           Control.Monad.Writer                    (execWriter, tell)
import           Data.Function                           ((&))
import           Data.Proxy                              (Proxy (..))
import           Data.Text                               (intercalate, pack)
import           Database.Bolt.Extras                    (ToCypher (..),
                                                          fromInt)
import           GHC.OverloadedLabels                    (IsLabel (..))
import           GHC.TypeLits                            (KnownSymbol,
                                                          symbolVal)
import           NeatInterpolation                       (text)
import           Text.Printf                             (printf)

import           Database.Bolt.Extras.DSL.Internal.Types

instance KnownSymbol x => IsLabel x NodeSelector where
  fromLabel :: NodeSelector
fromLabel = NodeSelector
defaultNode NodeSelector -> (NodeSelector -> NodeSelector) -> NodeSelector
forall a b. a -> (a -> b) -> b
& Text -> NodeSelector -> NodeSelector
forall a. SelectorLike a => Text -> a -> a
withIdentifier (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy x -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @x Proxy x
forall k (t :: k). Proxy t
Proxy)

instance KnownSymbol x => IsLabel x RelSelector where
  fromLabel :: RelSelector
fromLabel = RelSelector
defaultRel RelSelector -> (RelSelector -> RelSelector) -> RelSelector
forall a b. a -> (a -> b) -> b
& Text -> RelSelector -> RelSelector
forall a. SelectorLike a => Text -> a -> a
withIdentifier (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy x -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @x Proxy x
forall k (t :: k). Proxy t
Proxy)

instance SelectorLike NodeSelector where
    withIdentifier :: Text -> NodeSelector -> NodeSelector
withIdentifier Text
idx NodeSelector
node = NodeSelector
node { nodeIdentifier :: Maybe Text
nodeIdentifier = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
idx }
    withLabel :: Text -> NodeSelector -> NodeSelector
withLabel Text
lbl NodeSelector
node      = NodeSelector
node { nodeLabels :: [Text]
nodeLabels = Text
lbl Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: NodeSelector -> [Text]
nodeLabels NodeSelector
node }
    withProp :: (Text, Value) -> NodeSelector -> NodeSelector
withProp (Text, Value)
prop NodeSelector
node      = NodeSelector
node { nodeProperties :: [(Text, Value)]
nodeProperties = (Text, Value)
prop (Text, Value) -> [(Text, Value)] -> [(Text, Value)]
forall a. a -> [a] -> [a]
: NodeSelector -> [(Text, Value)]
nodeProperties NodeSelector
node }
    withParam :: (Text, Text) -> NodeSelector -> NodeSelector
withParam (Text, Text)
prop NodeSelector
node     = NodeSelector
node { nodeParams :: [(Text, Text)]
nodeParams = (Text, Text)
prop (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: NodeSelector -> [(Text, Text)]
nodeParams NodeSelector
node }

instance SelectorLike RelSelector where
    withIdentifier :: Text -> RelSelector -> RelSelector
withIdentifier Text
idx RelSelector
rel = RelSelector
rel { relIdentifier :: Maybe Text
relIdentifier = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
idx }
    withLabel :: Text -> RelSelector -> RelSelector
withLabel Text
lbl RelSelector
rel      = RelSelector
rel { relLabel :: Text
relLabel = Text
lbl }
    withProp :: (Text, Value) -> RelSelector -> RelSelector
withProp (Text, Value)
prop RelSelector
rel      = RelSelector
rel { relProperties :: [(Text, Value)]
relProperties = (Text, Value)
prop (Text, Value) -> [(Text, Value)] -> [(Text, Value)]
forall a. a -> [a] -> [a]
: RelSelector -> [(Text, Value)]
relProperties RelSelector
rel }
    withParam :: (Text, Text) -> RelSelector -> RelSelector
withParam (Text, Text)
prop RelSelector
rel     = RelSelector
rel { relParams :: [(Text, Text)]
relParams = (Text, Text)
prop (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: RelSelector -> [(Text, Text)]
relParams RelSelector
rel }

instance ToCypher NodeSelector where
  toCypher :: NodeSelector -> Text
toCypher NodeSelector{[(Text, Text)]
[(Text, Value)]
[Text]
Maybe Text
nodeParams :: [(Text, Text)]
nodeProperties :: [(Text, Value)]
nodeLabels :: [Text]
nodeIdentifier :: Maybe Text
nodeParams :: NodeSelector -> [(Text, Text)]
nodeProperties :: NodeSelector -> [(Text, Value)]
nodeLabels :: NodeSelector -> [Text]
nodeIdentifier :: NodeSelector -> Maybe Text
..} = Writer Text () -> Text
forall w a. Writer w a -> w
execWriter (Writer Text () -> Text) -> Writer Text () -> Text
forall a b. (a -> b) -> a -> b
$ do
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"("
    case Maybe Text
nodeIdentifier of
      Just Text
idx -> Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
idx
      Maybe Text
Nothing  -> () -> Writer Text ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    case [Text]
nodeLabels of
      [] -> () -> Writer Text ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [Text]
_  -> Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. ToCypher a => a -> Text
toCypher [Text]
nodeLabels
    case [(Text, Value)]
nodeProperties of
      [] -> case [(Text, Text)]
nodeParams of
              [] -> () -> Writer Text ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              [(Text, Text)]
_ -> do
                Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"{"
                Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Text
forall a. ToCypher a => a -> Text
toCypher [(Text, Text)]
nodeParams
                Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"}"
      [(Text, Value)]
_ -> do
        Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"{"
        Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> Text
forall a. ToCypher a => a -> Text
toCypher [(Text, Value)]
nodeProperties
        case [(Text, Text)]
nodeParams of
          [] -> () -> Writer Text ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          [(Text, Text)]
_ -> do
            Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
","
            Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Text
forall a. ToCypher a => a -> Text
toCypher [(Text, Text)]
nodeParams
        Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"}"

    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
")"

instance ToCypher RelSelector where
  toCypher :: RelSelector -> Text
toCypher RelSelector{[(Text, Text)]
[(Text, Value)]
Maybe Text
Text
relParams :: [(Text, Text)]
relProperties :: [(Text, Value)]
relLabel :: Text
relIdentifier :: Maybe Text
relParams :: RelSelector -> [(Text, Text)]
relProperties :: RelSelector -> [(Text, Value)]
relLabel :: RelSelector -> Text
relIdentifier :: RelSelector -> Maybe Text
..} = Writer Text () -> Text
forall w a. Writer w a -> w
execWriter (Writer Text () -> Text) -> Writer Text () -> Text
forall a b. (a -> b) -> a -> b
$ do
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"["
    case Maybe Text
relIdentifier of
      Just Text
idx -> Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
idx
      Maybe Text
Nothing  -> () -> Writer Text ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    case Text
relLabel of
      Text
"" -> () -> Writer Text ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Text
_  -> Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
forall a. ToCypher a => a -> Text
toCypher Text
relLabel
    case [(Text, Value)]
relProperties of
      [] -> case [(Text, Text)]
relParams of
              [] -> () -> Writer Text ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              [(Text, Text)]
_ -> do
                Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"{"
                Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Text
forall a. ToCypher a => a -> Text
toCypher [(Text, Text)]
relParams
                Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"}"
      [(Text, Value)]
_ -> do
        Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"{"
        Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> Text
forall a. ToCypher a => a -> Text
toCypher [(Text, Value)]
relProperties
        case [(Text, Text)]
relParams of
          [] -> () -> Writer Text ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          [(Text, Text)]
_ -> do
            Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
","
            Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Text
forall a. ToCypher a => a -> Text
toCypher [(Text, Text)]
relParams
        Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"}"

    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"]"

instance ToCypher PathSelector where
  toCypher :: PathSelector -> Text
toCypher (PathSelector
ps :-!: RelSelector
rs :!->: NodeSelector
ns) = Writer Text () -> Text
forall w a. Writer w a -> w
execWriter (Writer Text () -> Text) -> Writer Text () -> Text
forall a b. (a -> b) -> a -> b
$ do
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ PathSelector -> Text
forall a. ToCypher a => a -> Text
toCypher PathSelector
ps
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"-"
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ RelSelector -> Text
forall a. ToCypher a => a -> Text
toCypher RelSelector
rs
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"->"
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ NodeSelector -> Text
forall a. ToCypher a => a -> Text
toCypher NodeSelector
ns
  toCypher (PathSelector
ps :<-!: RelSelector
rs :!-: NodeSelector
ns) = Writer Text () -> Text
forall w a. Writer w a -> w
execWriter (Writer Text () -> Text) -> Writer Text () -> Text
forall a b. (a -> b) -> a -> b
$ do
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ PathSelector -> Text
forall a. ToCypher a => a -> Text
toCypher PathSelector
ps
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"<-"
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ RelSelector -> Text
forall a. ToCypher a => a -> Text
toCypher RelSelector
rs
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"-"
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ NodeSelector -> Text
forall a. ToCypher a => a -> Text
toCypher NodeSelector
ns
  toCypher (PathSelector
ps :-!: RelSelector
rs :!-: NodeSelector
ns) = Writer Text () -> Text
forall w a. Writer w a -> w
execWriter (Writer Text () -> Text) -> Writer Text () -> Text
forall a b. (a -> b) -> a -> b
$ do
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ PathSelector -> Text
forall a. ToCypher a => a -> Text
toCypher PathSelector
ps
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"-"
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ RelSelector -> Text
forall a. ToCypher a => a -> Text
toCypher RelSelector
rs
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"-"
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ NodeSelector -> Text
forall a. ToCypher a => a -> Text
toCypher NodeSelector
ns
  toCypher (P NodeSelector
ns) = Writer Text () -> Text
forall w a. Writer w a -> w
execWriter (Writer Text () -> Text) -> Writer Text () -> Text
forall a b. (a -> b) -> a -> b
$
    Text -> Writer Text ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Writer Text ()) -> Text -> Writer Text ()
forall a b. (a -> b) -> a -> b
$ NodeSelector -> Text
forall a. ToCypher a => a -> Text
toCypher NodeSelector
ns
  toCypher (PathSelector
_ :<-!: RelSelector
_ :!->: NodeSelector
_) = String -> Text
forall a. HasCallStack => String -> a
error String
"Database.Bolt.Extras.DSL: incorrect path"

instance ToCypher Selector where
  toCypher :: Selector -> Text
toCypher (PS PathSelector
ps)  = PathSelector -> Text
forall a. ToCypher a => a -> Text
toCypher PathSelector
ps
  toCypher (TS Text
txt) = Text
txt

instance ToCypher Selectors where
  toCypher :: Selectors -> Text
toCypher = Text -> [Text] -> Text
intercalate Text
", " ([Text] -> Text) -> (Selectors -> [Text]) -> Selectors -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Selector -> Text) -> Selectors -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Selector -> Text
forall a. ToCypher a => a -> Text
toCypher

instance ToCypher Cond where
  toCypher :: Cond -> Text
toCypher (ID Text
t BoltId
bId)   = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text -> BoltId -> String
forall r. PrintfType r => String -> r
printf String
"ID(%s)=%d" Text
t (BoltId -> BoltId
fromInt BoltId
bId)
  toCypher (IDs Text
t [BoltId]
bIds) = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text -> Text -> String
forall r. PrintfType r => String -> r
printf String
"ID(%s) in [%s]" Text
t (Text -> [Text] -> Text
intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (BoltId -> Text) -> [BoltId] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
pack (String -> Text) -> (BoltId -> String) -> BoltId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoltId -> String
forall a. Show a => a -> String
show) [BoltId]
bIds)
  toCypher (IN Text
t [Text]
txts)  = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text -> Text -> String
forall r. PrintfType r => String -> r
printf String
"%s in [%s]" Text
t (Text -> [Text] -> Text
intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
s -> [text|"$s"|]) [Text]
txts)
  toCypher (TC Text
txt)     = Text
txt

instance ToCypher Conds where
  toCypher :: Conds -> Text
toCypher (Conds
fcp :&&: Conds
scp) = Conds -> Text
forall a. ToCypher a => a -> Text
toCypher Conds
fcp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" AND " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Conds -> Text
forall a. ToCypher a => a -> Text
toCypher Conds
scp
  toCypher (Conds
fcp :||: Conds
scp) = Conds -> Text
forall a. ToCypher a => a -> Text
toCypher Conds
fcp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" OR " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Conds -> Text
forall a. ToCypher a => a -> Text
toCypher Conds
scp
  toCypher (Not Conds
cp)       = Text
"NOT " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Conds -> Text
forall a. ToCypher a => a -> Text
toCypher Conds
cp
  toCypher (C Cond
cp)         = Cond -> Text
forall a. ToCypher a => a -> Text
toCypher Cond
cp