{-# 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)
import GHC.Stack            (HasCallStack)

-- | Class for Selectors, which can update identifier, labels and props.
--
class SelectorLike a where
   withIdentifier :: Text -> a -> a
   withLabel      :: Text -> a -> a
   withProp       :: (Text, Value) -> a -> a
   withParam      :: (Text, Text) -> a -> a

-- | Selector for 'Node's.
--
-- This datatype has @OverloadedLabels@ instance to simplify specifying nodes. Labels produce
-- empty nodes.
--
-- > #foo :: NodeSelector
-- > -- foo = NodeSelector (Just "foo") [] []
--
data NodeSelector = NodeSelector { NodeSelector -> Maybe Text
nodeIdentifier :: Maybe Text
                                 , NodeSelector -> [Text]
nodeLabels     :: [Text]
                                 , NodeSelector -> [(Text, Value)]
nodeProperties :: [(Text, Value)]
                                 , NodeSelector -> [(Text, Text)]
nodeParams     :: [(Text, Text)]
                                 }
  deriving (Int -> NodeSelector -> ShowS
[NodeSelector] -> ShowS
NodeSelector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeSelector] -> ShowS
$cshowList :: [NodeSelector] -> ShowS
show :: NodeSelector -> String
$cshow :: NodeSelector -> String
showsPrec :: Int -> NodeSelector -> ShowS
$cshowsPrec :: Int -> NodeSelector -> ShowS
Show, NodeSelector -> NodeSelector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeSelector -> NodeSelector -> Bool
$c/= :: NodeSelector -> NodeSelector -> Bool
== :: NodeSelector -> NodeSelector -> Bool
$c== :: NodeSelector -> NodeSelector -> Bool
Eq)

-- | Selector for 'URelationship's.
--
-- This datatype has @OverloadedLabels@ instance as well, similar to 'NodeSelector'.
data RelSelector = RelSelector { RelSelector -> Maybe Text
relIdentifier :: Maybe Text
                               , RelSelector -> Text
relLabel      :: Text
                               , RelSelector -> [(Text, Value)]
relProperties :: [(Text, Value)]
                               , RelSelector -> [(Text, Text)]
relParams     :: [(Text, Text)]
                               }
  deriving (Int -> RelSelector -> ShowS
[RelSelector] -> ShowS
RelSelector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelSelector] -> ShowS
$cshowList :: [RelSelector] -> ShowS
show :: RelSelector -> String
$cshow :: RelSelector -> String
showsPrec :: Int -> RelSelector -> ShowS
$cshowsPrec :: Int -> RelSelector -> ShowS
Show, RelSelector -> RelSelector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelSelector -> RelSelector -> Bool
$c/= :: RelSelector -> RelSelector -> Bool
== :: RelSelector -> RelSelector -> Bool
$c== :: RelSelector -> RelSelector -> Bool
Eq)

-- | Operator version of 'withLabel'. To be used with @OverloadedLabels@ instances.
--
-- > #foo .: "Foo" :: NodeSelector
--
infixl 9 .:
(.:) :: SelectorLike a => a -> Text -> a
.: :: forall a. SelectorLike a => a -> Text -> a
(.:) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. SelectorLike a => Text -> a -> a
withLabel

-- | Operator version of 'withProp'. To be used with @OverloadedLabels@ instances.
--
-- See also 'Database.Bolt.=:' from @Database.Bolt@ package.
--
-- > #foo .# ["bar" =: 42, "baz" =: "baz"] :: NodeSelector
--
infixl 9 .#
(.#) :: SelectorLike a => a -> [(Text, Value)] -> a
.# :: forall a. SelectorLike a => a -> [(Text, Value)] -> a
(.#) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. SelectorLike a => (Text, Value) -> a -> a
withProp)

(#) :: a -> (a -> b) -> b
# :: forall a b. a -> (a -> b) -> b
(#) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
($)

-- | Selector for paths.
--
infixl 2 :!->:
infixl 2 :!-:
data PathPart = RelSelector :!->: NodeSelector -- ^ directed relation
              | RelSelector :!-: NodeSelector  -- ^ not directed relation
  deriving (Int -> PathPart -> ShowS
[PathPart] -> ShowS
PathPart -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathPart] -> ShowS
$cshowList :: [PathPart] -> ShowS
show :: PathPart -> String
$cshow :: PathPart -> String
showsPrec :: Int -> PathPart -> ShowS
$cshowsPrec :: Int -> PathPart -> ShowS
Show, PathPart -> PathPart -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathPart -> PathPart -> Bool
$c/= :: PathPart -> PathPart -> Bool
== :: PathPart -> PathPart -> Bool
$c== :: PathPart -> PathPart -> Bool
Eq)

infixl 1 :-!:
infixl 1 :<-!:
data PathSelector = PathSelector :-!: PathPart  -- ^ not directed relation
                  | PathSelector :<-!: PathPart -- ^ directed relation
                  | P NodeSelector              -- ^ starting node of Path
  deriving (Int -> PathSelector -> ShowS
[PathSelector] -> ShowS
PathSelector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathSelector] -> ShowS
$cshowList :: [PathSelector] -> ShowS
show :: PathSelector -> String
$cshow :: PathSelector -> String
showsPrec :: Int -> PathSelector -> ShowS
$cshowsPrec :: Int -> PathSelector -> ShowS
Show, PathSelector -> PathSelector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathSelector -> PathSelector -> Bool
$c/= :: PathSelector -> PathSelector -> Bool
== :: PathSelector -> PathSelector -> Bool
$c== :: PathSelector -> PathSelector -> Bool
Eq)

-- | Combined version of ':-!:' and 'P' for specifying the first node of path.
--
infixl 1 -:
(-:) :: NodeSelector -> PathPart -> PathSelector
NodeSelector
ns -: :: NodeSelector -> PathPart -> PathSelector
-: PathPart
pp = NodeSelector -> PathSelector
P NodeSelector
ns PathSelector -> PathPart -> PathSelector
:-!: PathPart
pp

-- | Combined version of ':<-!:' and 'P' for specifying the first node of path.
--
infixl 1 <-:
(<-:) :: NodeSelector -> PathPart -> PathSelector
NodeSelector
ns <-: :: NodeSelector -> PathPart -> PathSelector
<-: PathPart
pp = NodeSelector -> PathSelector
P NodeSelector
ns PathSelector -> PathPart -> PathSelector
:<-!: PathPart
pp

data Selector = PS PathSelector -- ^ path selector
              | TS Text         -- ^ free text selector
  deriving (Int -> Selector -> ShowS
[Selector] -> ShowS
Selector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selector] -> ShowS
$cshowList :: [Selector] -> ShowS
show :: Selector -> String
$cshow :: Selector -> String
showsPrec :: Int -> Selector -> ShowS
$cshowsPrec :: Int -> Selector -> ShowS
Show, Selector -> Selector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c== :: Selector -> Selector -> Bool
Eq)

type Selectors = [Selector]

-- | Conditions.
--
data Cond = ID Text BoltId    -- ^ ID(txt) = boltId
          | IDs Text [BoltId] -- ^ ID(txt) IN [boltId1, boltId2, ... ]
          | IN Text [Text]    -- ^ txt IN [txt1, txt2, ... ]
          | TC Text           -- ^ free text condition
  deriving (Int -> Cond -> ShowS
[Cond] -> ShowS
Cond -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cond] -> ShowS
$cshowList :: [Cond] -> ShowS
show :: Cond -> String
$cshow :: Cond -> String
showsPrec :: Int -> Cond -> ShowS
$cshowsPrec :: Int -> Cond -> ShowS
Show, Cond -> Cond -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cond -> Cond -> Bool
$c/= :: Cond -> Cond -> Bool
== :: Cond -> Cond -> Bool
$c== :: Cond -> Cond -> Bool
Eq)

infixr 3 :&&:
infixr 2 :||:
data Conds = Conds :&&: Conds -- ^ 'condition' AND 'condition'
           | Conds :||: Conds -- ^ 'condition' OR 'condition'
           | C Cond           -- ^ single 'condition'
           | Not Conds        -- ^ NOT 'condition'
  deriving (Int -> Conds -> ShowS
[Conds] -> ShowS
Conds -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Conds] -> ShowS
$cshowList :: [Conds] -> ShowS
show :: Conds -> String
$cshow :: Conds -> String
showsPrec :: Int -> Conds -> ShowS
$cshowsPrec :: Int -> Conds -> ShowS
Show, Conds -> Conds -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Conds -> Conds -> Bool
$c/= :: Conds -> Conds -> Bool
== :: Conds -> Conds -> Bool
$c== :: Conds -> Conds -> Bool
Eq)

-- | Expression in Cypher language.
--
data Expr next = Create Selectors next        -- ^ CREATE query
               | Match Selectors next         -- ^ MATCH query
               | OptionalMatch Selectors next -- ^ OPTIONAL MATCH query
               | Merge Selectors next         -- ^ MERGE query
               | Where Conds next             -- ^ WHERE query
               | Set [Text] next              -- ^ SET query
               | Delete [Text] next           -- ^ DELETE query
               | DetachDelete [Text] next     -- ^ DETACH DELETE query
               | Remove [Text] next           -- ^ REMOVE query
               | Return [Text] next           -- ^ RETURN query
               | With [Text] next             -- ^ WITH query
               | Text Text next               -- ^ free text query
  deriving (Int -> Expr next -> ShowS
forall next. Show next => Int -> Expr next -> ShowS
forall next. Show next => [Expr next] -> ShowS
forall next. Show next => Expr next -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr next] -> ShowS
$cshowList :: forall next. Show next => [Expr next] -> ShowS
show :: Expr next -> String
$cshow :: forall next. Show next => Expr next -> String
showsPrec :: Int -> Expr next -> ShowS
$cshowsPrec :: forall next. Show next => Int -> Expr next -> ShowS
Show, Expr next -> Expr next -> Bool
forall next. Eq next => Expr next -> Expr next -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr next -> Expr next -> Bool
$c/= :: forall next. Eq next => Expr next -> Expr next -> Bool
== :: Expr next -> Expr next -> Bool
$c== :: forall next. Eq next => Expr next -> Expr next -> Bool
Eq, forall a b. a -> Expr b -> Expr a
forall a b. (a -> b) -> Expr a -> Expr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Expr b -> Expr a
$c<$ :: forall a b. a -> Expr b -> Expr a
fmap :: forall a b. (a -> b) -> Expr a -> Expr b
$cfmap :: forall a b. (a -> b) -> Expr a -> Expr b
Functor)

-- | Empty 'NodeSelector'.
defaultNode :: NodeSelector
defaultNode :: NodeSelector
defaultNode = Maybe Text
-> [Text] -> [(Text, Value)] -> [(Text, Text)] -> NodeSelector
NodeSelector forall a. Maybe a
Nothing [] [] []

-- | Shorter synonym for 'defaultRel'.
defN :: NodeSelector
defN :: NodeSelector
defN = NodeSelector
defaultNode

-- | Empty 'RelSelector'.
defaultRel :: RelSelector
defaultRel :: RelSelector
defaultRel = Maybe Text
-> Text -> [(Text, Value)] -> [(Text, Text)] -> RelSelector
RelSelector forall a. Maybe a
Nothing Text
"" [] []

-- | Shorter synonym for 'defaultRel'.
defR :: RelSelector
defR :: RelSelector
defR = RelSelector
defaultRel

toNodeSelector :: HasCallStack => Node -> NodeSelector
toNodeSelector :: HasCallStack => Node -> NodeSelector
toNodeSelector Node{Int
[Text]
Map Text Value
nodeIdentity :: Node -> Int
labels :: Node -> [Text]
nodeProps :: Node -> Map Text Value
nodeProps :: Map Text Value
labels :: [Text]
nodeIdentity :: Int
..} = NodeSelector
defaultNode { nodeLabels :: [Text]
nodeLabels      = [Text]
labels
                                      , nodeProperties :: [(Text, Value)]
nodeProperties  = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= () -> Value
N ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall k a. Map k a -> [(k, a)]
toList Map Text Value
nodeProps)
                                      }

toRelSelector :: HasCallStack => URelationship -> RelSelector
toRelSelector :: HasCallStack => URelationship -> RelSelector
toRelSelector URelationship{Int
Text
Map Text Value
urelIdentity :: URelationship -> Int
urelType :: URelationship -> Text
urelProps :: URelationship -> Map Text Value
urelProps :: Map Text Value
urelType :: Text
urelIdentity :: Int
..} = RelSelector
defaultRel { relLabel :: Text
relLabel      = Text
urelType
                                             , relProperties :: [(Text, Value)]
relProperties = forall k a. Map k a -> [(k, a)]
toList Map Text Value
urelProps
                                             }