{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeApplications    #-}

module Main where

import           Control.Exception             (bracket)
import           Control.Monad.State           (execState, modify)
import           Data.Aeson                    (encode)
import qualified Data.ByteString.Lazy.Char8    as B (putStrLn)
import           Data.Default                  (def)
import           Data.Text                     (Text)
import           Database.Bolt                 (BoltActionT, BoltCfg (..),
                                                Value (..), close, connect, run)
import           Database.Bolt.Extras          (NodeLike (..),
                                                URelationLike (..))
import           Database.Bolt.Extras.Graph
import           Database.Bolt.Extras.Template (makeNodeLike, makeURelationLike)
import           GHC.Generics                  (Generic)

-- | Configuration for connection to local database.
boltCfg :: BoltCfg
boltCfg = def { host = "localhost"
              , user = "neo4j"
              , password = "12345"
              }

-- | Helper to run queries in Neo4j DB.
--
runQueryDB :: BoltActionT IO a -> IO a
runQueryDB act = bracket (connect boltCfg) close (`run` act)

data ExampleNode = ExampleNode { exampleFieldT :: Text
                               , exampleFieldI :: Int
                               }
  deriving (Show, Generic)

data EXAMPLE_RELATION = EXAMPLE_RELATION
  deriving (Show, Generic)

makeNodeLike ''ExampleNode
makeURelationLike ''EXAMPLE_RELATION

exNodeAVar :: Text
exNodeAVar = "nodeA"

exNodeBVar :: Text
exNodeBVar = "nodeB"

-- | Builds query:
-- CREATE (nodeA:ExampleNode { exampleFieldT: "A" , exampleFieldI: 1}) WITH nodeA
-- MERGE  (nodeB:ExampleNode { exampleFieldT: "B" , exampleFieldI: 2}) WITH nodeB
-- MERGE  (nodeA)-[nodeA0nodeB:EXAMPLE_RELATION]-(nodeB) WITH nodeA, nodeB, nodeA0nodeB
-- RETURN ID(nodeA), ID(nodeB), ID(nodeA0nodeB)
--
examplePutGraph :: GraphPutRequest
examplePutGraph = flip execState emptyGraph $ do
    modify $ addNode exNodeAVar (CreateN . toNode $ exNodeA)
    modify $ addNode exNodeBVar (MergeN  . toNode $ exNodeB)

    modify $ addRelation exNodeAVar exNodeBVar (MergeR . toURelation $ exRel)
  where
    exNodeA = ExampleNode "A" 1
    exNodeB = ExampleNode "B" 2
    exRel   = EXAMPLE_RELATION

-- | Builds query:
-- MATCH (nodeA)-[:EXAMPLE_RELATION]-(nodeB),
-- (nodeA:ExampleNode { exampleField: "A" }),
-- (nodeB:ExampleNode { exampleField: "B" })
-- RETURN { id: ID(nodeA), labels: labels(nodeA), props: properties(nodeA) }
--
exampleGetGraphB :: GraphGetRequest
exampleGetGraphB = flip execState emptyGraph $ do
    modify $ addNode exNodeAVar exNodeA
    modify $ addNode exNodeBVar exNodeB

    modify $ addRelation exNodeAVar exNodeBVar exRel
  where
    exNodeA = defaultNodeReturn    # withLabelQ ''ExampleNode
                                   # withProp   ("exampleFieldT", T "A")
                                   # withReturn allProps

    exNodeB = defaultNodeNotReturn # withLabelQ ''ExampleNode
                                   # withProp   ("exampleFieldT", T "B")

    exRel   = defaultRelNotReturn  # withLabelQ ''EXAMPLE_RELATION

-- | Builds query:
-- MATCH (nodeA:ExampleNode { exampleField: "A" })
-- RETURN { id: ID(nodeA), labels: labels(nodeA), props: nodeA {.exampleFieldI} }
--
exampleGetGraphA :: GraphGetRequest
exampleGetGraphA = flip execState emptyGraph $
    modify $ addNode exNodeAVar exNodeA
  where
    exNodeA = defaultNodeReturn    # withLabelQ ''ExampleNode
                                   # withProp   ("exampleFieldT", T "A")
                                   # withReturn ["exampleFieldI"]

-- | Put 'examplePutGraph' to the database.
--
putGraph :: IO ()
putGraph = do
    putGraphR <- runQueryDB $ makeRequest @PutRequest [] examplePutGraph
    putStrLn "Uploaded graph: "
    print putGraphR

-- Get 'exampleGetGraphB' and parse it to Haskell object.
--
getGraphB :: IO ()
getGraphB = do
    getGraphsR                  <- runQueryDB $ makeRequest @GetRequest [] exampleGetGraphB
    let nodesA :: [ExampleNode] = extractNode exNodeAVar <$> getGraphsR
    putStrLn "Downloaded graph and converted to Haskell object: "
    print nodesA

-- Get 'exampleGetGraphA' and parse it to JSON.
--
getGraphA :: IO ()
getGraphA = do
    getGraphsR <- runQueryDB $ makeRequest @GetRequest [] exampleGetGraphA
    let nodesA = extractNodeAeson exNodeAVar <$> getGraphsR
    putStrLn "Downloaded graph and converted to JSON: "
    B.putStrLn . encode $ nodesA

main :: IO ()
main = putGraph >> getGraphB >> getGraphA