{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Database.Bolt.Extras.DSL.Internal.Types
(
NodeSelector (..)
, RelSelector (..)
, PathPart (..)
, PathSelector (..)
, Selector (..)
, Selectors
, Cond (..)
, Conds (..)
, Expr (..)
, SelectorLike (..)
, (.:)
, (.#)
, (#)
, (-:)
, (<-:)
, defaultNode
, defN
, defaultRel
, defR
, toNodeSelector
, toRelSelector
) where
import Data.Foldable (foldl')
import Data.Map.Strict (toList)
import Data.Text (Text)
import Database.Bolt (Node (..), URelationship (..),
Value (..))
import Database.Bolt.Extras (BoltId)
class SelectorLike a where
withIdentifier :: Text -> a -> a
withLabel :: Text -> a -> a
withProp :: (Text, Value) -> a -> a
data NodeSelector = NodeSelector { nodeIdentifier :: Maybe Text
, nodeLabels :: [Text]
, nodeProperties :: [(Text, Value)]
}
deriving (Show, Eq)
data RelSelector = RelSelector { relIdentifier :: Maybe Text
, relLabel :: Text
, relProperties :: [(Text, Value)]
}
deriving (Show, Eq)
infixl 9 .:
(.:) :: SelectorLike a => a -> Text -> a
(.:) = flip withLabel
infixl 9 .#
(.#) :: SelectorLike a => a -> [(Text, Value)] -> a
(.#) = foldl' (flip withProp)
(#) :: a -> (a -> b) -> b
(#) = flip ($)
infixl 2 :!->:
infixl 2 :!-:
data PathPart = RelSelector :!->: NodeSelector
| RelSelector :!-: NodeSelector
deriving (Show, Eq)
infixl 1 :-!:
infixl 1 :<-!:
data PathSelector = PathSelector :-!: PathPart
| PathSelector :<-!: PathPart
| P NodeSelector
deriving (Show, Eq)
infixl 1 -:
(-:) :: NodeSelector -> PathPart -> PathSelector
ns -: pp = P ns :-!: pp
infixl 1 <-:
(<-:) :: NodeSelector -> PathPart -> PathSelector
ns <-: pp = P ns :<-!: pp
data Selector = PS PathSelector
| TS Text
deriving (Show, Eq)
type Selectors = [Selector]
data Cond = ID Text BoltId
| IDs Text [BoltId]
| IN Text [Text]
| TC Text
deriving (Show, Eq)
infixr 3 :&&:
infixr 2 :||:
data Conds = Conds :&&: Conds
| Conds :||: Conds
| C Cond
| Not Conds
deriving (Show, Eq)
data Expr next = Create Selectors next
| Match Selectors next
| OptionalMatch Selectors next
| Merge Selectors next
| Where Conds next
| Set [Text] next
| Delete [Text] next
| DetachDelete [Text] next
| Remove [Text] next
| Return [Text] next
| With [Text] next
| Text Text next
deriving (Show, Eq, Functor)
defaultNode :: NodeSelector
defaultNode = NodeSelector Nothing [] []
defN :: NodeSelector
defN = defaultNode
defaultRel :: RelSelector
defaultRel = RelSelector Nothing "" []
defR :: RelSelector
defR = defaultRel
toNodeSelector :: Node -> NodeSelector
toNodeSelector Node{..} = defaultNode { nodeLabels = labels
, nodeProperties = filter ((/= N ()) . snd) (toList nodeProps)
}
toRelSelector :: URelationship -> RelSelector
toRelSelector URelationship{..} = defaultRel { relLabel = urelType
, relProperties = toList urelProps
}