{-# 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 forall a b. a -> (a -> b) -> b
& forall a. SelectorLike a => Text -> a -> a
withIdentifier (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @x forall {k} (t :: k). Proxy t
Proxy)

instance KnownSymbol x => IsLabel x RelSelector where
  fromLabel :: RelSelector
fromLabel = RelSelector
defaultRel forall a b. a -> (a -> b) -> b
& forall a. SelectorLike a => Text -> a -> a
withIdentifier (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @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 = forall a. a -> Maybe a
Just Text
idx }
    withLabel :: Text -> NodeSelector -> NodeSelector
withLabel Text
lbl NodeSelector
node      = NodeSelector
node { nodeLabels :: [Text]
nodeLabels = Text
lbl 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 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 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 = 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 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 forall a. a -> [a] -> [a]
: RelSelector -> [(Text, Text)]
relParams RelSelector
rel }

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

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

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

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

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

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

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

instance ToCypher Cond where
  toCypher :: HasCallStack => Cond -> Text
toCypher (ID Text
t BoltId
bId)   = String -> Text
pack forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"ID(%s) in [%s]" Text
t (Text -> [Text] -> Text
intercalate Text
", " forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [BoltId]
bIds)
  toCypher (IN Text
t [Text]
txts)  = String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%s in [%s]" Text
t (Text -> [Text] -> Text
intercalate Text
", " forall a b. (a -> b) -> a -> b
$ 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 :: HasCallStack => Conds -> Text
toCypher (Conds
fcp :&&: Conds
scp) = forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher Conds
fcp forall a. Semigroup a => a -> a -> a
<> Text
" AND " forall a. Semigroup a => a -> a -> a
<> forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher Conds
scp
  toCypher (Conds
fcp :||: Conds
scp) = forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher Conds
fcp forall a. Semigroup a => a -> a -> a
<> Text
" OR " forall a. Semigroup a => a -> a -> a
<> forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher Conds
scp
  toCypher (Not Conds
cp)       = Text
"NOT " forall a. Semigroup a => a -> a -> a
<> forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher Conds
cp
  toCypher (C Cond
cp)         = forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher Cond
cp