{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE QuasiQuotes          #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Database.Bolt.Extras.Internal.Cypher
  (
    ToCypher (..)
  ) where

-------------------------------------------------------------------------------------------------
-- Queries for neo4j are formatted with `Cypher` language.
-- Read documentation for `Cypher` here: https://neo4j.com/docs/developer-manual/current/cypher/.
-- This file contains some converation rules from 'Database.Bolt' types to `Cypher`.
-------------------------------------------------------------------------------------------------

import Data.Text                           as T (Text, concat, cons, intercalate, pack, replace,
                                                 toUpper)
import Database.Bolt                       (Value (..))
import Database.Bolt.Extras.Internal.Types (Label, Property)
import Database.Bolt.Extras.Utils          (currentLoc)
import GHC.Stack                           (HasCallStack)
import NeatInterpolation                   (text)

-- | The class for convertation into Cypher.
--
class ToCypher a where
  toCypher :: HasCallStack => a -> Text

-- | Convertation for 'Database.Bolt.Value' into Cypher.
--
instance ToCypher Value where
  toCypher :: HasCallStack => Value -> Text
toCypher (N ())     = Text
""
  toCypher (B Bool
bool)   = Text -> Text
toUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ Bool
bool
  toCypher (I Int
int)    = [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ Int
int
  toCypher (F Double
double) = [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ Double
double
  toCypher (T Text
t)      = Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeSpecSymbols Text
t forall a. Semigroup a => a -> a -> a
<> Text
"\""
  toCypher (L [Value]
values) = let cvalues :: Text
cvalues = Text -> [Text] -> Text
T.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher [Value]
values
                        in [text|[$cvalues]|]
  toCypher Value
_          = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ $[Char]
currentLoc forall a. [a] -> [a] -> [a]
++ [Char]
"unacceptable Value type"

escapeSpecSymbols :: Text -> Text
escapeSpecSymbols :: Text -> Text
escapeSpecSymbols = Text -> Text -> Text -> Text
replace Text
"\"" Text
"\\\"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replace Text
"\\" Text
"\\\\"

-- | Label with @name@ are formatted into @:name@
--
instance ToCypher Label where
  toCypher :: HasCallStack => Text -> Text
toCypher = Char -> Text -> Text
cons Char
':'

-- | Several labels are formatted with concatenation.
--
instance ToCypher [Label] where
  toCypher :: HasCallStack => [Text] -> Text
toCypher = [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher

-- | Converts property with @name@ and @value@ to @name:value@.
--
instance ToCypher Property where
  toCypher :: HasCallStack => Property -> Text
toCypher (Text
propTitle, Value
value) = [Text] -> Text
T.concat [Text
propTitle, [Char] -> Text
pack [Char]
":", forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher Value
value]

instance ToCypher (Text, Text) where
  toCypher :: HasCallStack => (Text, Text) -> Text
toCypher (Text
propTitle, Text
param) = Text
propTitle forall a. Semigroup a => a -> a -> a
<> Text
":$" forall a. Semigroup a => a -> a -> a
<> Text
param

-- | Several properties are formatted with concatenation.
--
instance ToCypher [Property] where
  toCypher :: HasCallStack => [Property] -> Text
toCypher = Text -> [Text] -> Text
T.intercalate Text
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher

instance ToCypher [(Text, Text)] where
  toCypher :: HasCallStack => [(Text, Text)] -> Text
toCypher = Text -> [Text] -> Text
T.intercalate Text
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher