{-# LANGUAGE OverloadedStrings #-}

module Database.Bolt.Extras.DSL.Internal.Executer
  (
    formQuery
  ) where

import           Control.Monad.Free                          (Free (..),
                                                              foldFree)
import           Control.Monad.Writer                        (Writer,
                                                              execWriter, tell)
import           Data.Text                                   as T (Text,
                                                                   intercalate,
                                                                   unwords)
import           Database.Bolt.Extras                        (ToCypher (..))
import           Database.Bolt.Extras.DSL.Internal.Instances ()
import           Database.Bolt.Extras.DSL.Internal.Types     (Expr (..))

-- | Translates 'Expr' to cypher query.
--
execute :: Expr a -> Writer [Text] a
execute :: Expr a -> Writer [Text] a
execute (Create Selectors
s a
n)        = Text -> Selectors -> a -> Writer [Text] a
forall a b. ToCypher a => Text -> a -> b -> Writer [Text] b
executeHelperC Text
"CREATE " Selectors
s a
n
execute (Match Selectors
s a
n)         = Text -> Selectors -> a -> Writer [Text] a
forall a b. ToCypher a => Text -> a -> b -> Writer [Text] b
executeHelperC Text
"MATCH " Selectors
s a
n
execute (OptionalMatch Selectors
s a
n) = Text -> Selectors -> a -> Writer [Text] a
forall a b. ToCypher a => Text -> a -> b -> Writer [Text] b
executeHelperC Text
"OPTIONAL MATCH " Selectors
s a
n
execute (Merge Selectors
s a
n)         = Text -> Selectors -> a -> Writer [Text] a
forall a b. ToCypher a => Text -> a -> b -> Writer [Text] b
executeHelperC Text
"MERGE " Selectors
s a
n
execute (Where Conds
c a
n)         = Text -> Conds -> a -> Writer [Text] a
forall a b. ToCypher a => Text -> a -> b -> Writer [Text] b
executeHelperC Text
"WHERE " Conds
c a
n
execute (Set [Text]
t a
n)           = Text -> [Text] -> a -> Writer [Text] a
forall b. Text -> [Text] -> b -> Writer [Text] b
executeHelperT Text
"SET " [Text]
t a
n
execute (Delete [Text]
t a
n)        = Text -> [Text] -> a -> Writer [Text] a
forall b. Text -> [Text] -> b -> Writer [Text] b
executeHelperT Text
"DELETE " [Text]
t a
n
execute (DetachDelete [Text]
t a
n)  = Text -> [Text] -> a -> Writer [Text] a
forall b. Text -> [Text] -> b -> Writer [Text] b
executeHelperT Text
"DETACH DELETE " [Text]
t a
n
execute (Remove [Text]
t a
n)        = Text -> [Text] -> a -> Writer [Text] a
forall b. Text -> [Text] -> b -> Writer [Text] b
executeHelperT Text
"REMOVE " [Text]
t a
n
execute (Return [Text]
t a
n)        = Text -> [Text] -> a -> Writer [Text] a
forall b. Text -> [Text] -> b -> Writer [Text] b
executeHelperT Text
"RETURN " [Text]
t a
n
execute (With [Text]
t a
n)          = Text -> [Text] -> a -> Writer [Text] a
forall b. Text -> [Text] -> b -> Writer [Text] b
executeHelperT Text
"WITH " [Text]
t a
n
execute (Text Text
t a
n)          = [Text] -> WriterT [Text] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text
t] WriterT [Text] Identity () -> Writer [Text] a -> Writer [Text] a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Writer [Text] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
n

-- | Helper to translate 'Expr' with something, which can be translated to cypher.
--
executeHelperC :: ToCypher a => Text -> a -> b -> Writer [Text] b
executeHelperC :: Text -> a -> b -> Writer [Text] b
executeHelperC Text
txt a
s b
n = [Text] -> WriterT [Text] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. ToCypher a => a -> Text
toCypher a
s] WriterT [Text] Identity () -> Writer [Text] b -> Writer [Text] b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Writer [Text] b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
n

-- | Helper to translate 'Expr' with 'Text's.
--
executeHelperT :: Text -> [Text] -> b -> Writer [Text] b
executeHelperT :: Text -> [Text] -> b -> Writer [Text] b
executeHelperT Text
txt [Text]
t b
n = [Text] -> WriterT [Text] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " [Text]
t] WriterT [Text] Identity () -> Writer [Text] b -> Writer [Text] b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Writer [Text] b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
n

formQueryW :: Free Expr () -> Writer [Text] ()
formQueryW :: Free Expr () -> WriterT [Text] Identity ()
formQueryW = (forall x. Expr x -> WriterT [Text] Identity x)
-> Free Expr () -> WriterT [Text] Identity ()
forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
(forall x. f x -> m x) -> Free f a -> m a
foldFree forall x. Expr x -> WriterT [Text] Identity x
execute

formQuery :: Free Expr () -> Text
formQuery :: Free Expr () -> Text
formQuery = [Text] -> Text
T.unwords ([Text] -> Text)
-> (Free Expr () -> [Text]) -> Free Expr () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [Text] Identity () -> [Text]
forall w a. Writer w a -> w
execWriter (WriterT [Text] Identity () -> [Text])
-> (Free Expr () -> WriterT [Text] Identity ())
-> Free Expr ()
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Free Expr () -> WriterT [Text] Identity ()
formQueryW