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