{-# 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.String (IsString(..))
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 IsString Cond where
fromString :: String -> Cond
fromString String
str = Text -> Cond
TC forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
str
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 (HasCallStack => 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 IsString Conds where
fromString :: String -> Conds
fromString String
str = Cond -> Conds
C forall a b. (a -> b) -> a -> b
$ Text -> Cond
TC forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
str
instance ToCypher Conds where
toCypher :: HasCallStack => Conds -> Text
toCypher (Conds
fcp :&&: Conds
scp) = Text
"(" forall a. Semigroup a => a -> a -> a
<> 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 forall a. Semigroup a => a -> a -> a
<> Text
")"
toCypher (Conds
fcp :||: Conds
scp) = Text
"(" forall a. Semigroup a => a -> a -> a
<> 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 forall a. Semigroup a => a -> a -> a
<> Text
")"
toCypher (Not Conds
cp) = Text
"NOT (" forall a. Semigroup a => a -> a -> a
<> forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher Conds
cp forall a. Semigroup a => a -> a -> a
<> Text
")"
toCypher (C Cond
cp) = forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher Cond
cp