{-# LANGUAGE OverloadedStrings #-}

import Database.Bolt

import Data.Default
import Data.Text
import Control.Monad
import Control.Monad.Except

-- Simple request can be done by using 'query' function. It returns a list of 'Record's which
-- are special dictionaries from 'Text' to any serializable 'Value'. You can extract this values by key using 'at' function.
nineties :: BoltActionT IO [Text]
nineties = do records <- query "MATCH (nineties:Movie) WHERE nineties.released >= 1990 AND nineties.released < 2000 RETURN nineties.title"
              forM records $ \record -> record `at` "nineties.title"

-- All types that can be processed by 'at' are instances of 'RecordValue' classtype.
-- You can implement new unpackers by your own.
--
-- If you want to perform some request multiple times with neo4j caching speedup,
-- you can use 'queryP' function that takes not only the Cypher request but also
-- a parameters dictionary.
genericABN :: RecordValue a => Text -> BoltActionT IO [a]
genericABN name = do toms' <- queryP "MATCH (tom:Person) WHERE tom.name CONTAINS {name} RETURN tom"
                                     (props ["name" =: name])
                     nodes <- forM toms' $ \record -> record `at` "tom"
                     forM nodes $ \node -> nodeProps node `at` "name"

-- Hasbolt has a special 'Node' type to unpack graph nodes. You also can find 'Relationship',
-- 'URelationship' and 'Path' as built-in types.
actorsByNameYear :: Text -> Int -> BoltActionT IO [Node]
actorsByNameYear name year = do toms' <- queryP "MATCH (n:Person {name: {props}.name, born: {props}.born}) RETURN n" 
                                                (props ["props" =: props ["name" =: name, "born" =: year]])
                                forM toms' $ \record -> record `at` "n"

actorsByName :: Text -> BoltActionT IO [Text]
actorsByName = genericABN

-- This request raises 'WrongMessageFormat' error, as it cannot unpack 'Text' values as 'Int's.
wrongType :: Text -> BoltActionT IO [Int]
wrongType = genericABN 

-- Database server answers with a 'ResponseError' exception on any syntax error or internal database problem.
typoInRequest :: Text -> BoltActionT IO [Text]
typoInRequest name = do toms' <- queryP "MATCH (tom:Person) WHERE tom.name CONTAINS {name} RETURN not_tom"
                                        (props ["name" =: name])
                        nodes <- forM toms' $ \record -> record `at` "tom"
                        forM nodes $ \node -> nodeProps node `at` "name"

-- 'RecordHasNoKey' is thrown in case of a wrong key usage in 'at'.
typoInField :: Text -> BoltActionT IO [Text]
typoInField name = do toms' <- queryP "MATCH (tom:Person) WHERE tom.name CONTAINS {name} RETURN tom" 
                                      (props ["name" =: name])
                      nodes <- forM toms' $ \record -> record `at` "not_tom"
                      forM nodes $ \node -> nodeProps node `at` "name"

main :: IO ()
main = do pipe <- connect $ def { user = "neo4j", password = "12345" }
          -- Prints nineties example from Movies tutorial
          putStrLn "Movies (nineties):" 
          titles <- run pipe nineties 
          forM_ titles print
          -- Prints all actors called Tom 
          putStrLn "\nActors (Tom):"
          toms' <- run pipe $ actorsByName "Tom" 
          forM_ toms' print
          -- Prints Tom Hanks 
          putStrLn "\nNodes (Tom Cruise):"
          nodes' <- run pipe $ actorsByNameYear "Tom Cruise" 1962 
          forM_ nodes' print
           -- Prints an error as type is wrong 
          putStrLn "\nWrong return type:"
          wtype' <- run pipe $ wrongType "Tom" `catchError`
                                 \e@(WrongMessageFormat _) -> liftIO (print e) >> pure [] 
          forM_ wtype' print
          -- Prints an error as the request contains a typo
          putStrLn "\nTypo in request:"
          typor' <- run pipe $ typoInRequest "Tom" `catchError`
                                 \(ResponseError e) -> liftIO (print e) >> pure [] 
          forM_ typor' print
          -- Prints an error as the field name contains a typo
          putStrLn "\nTypo in field:"
          typof' <- run pipe $ typoInField "Tom" `catchError` 
                                 \e@(RecordHasNoKey _) -> liftIO (print e) >> pure [] 
          forM_ typof' print
          close pipe

signature = 'X'
fields = { crs :: CoordinateReferenceSystem
         , x   :: Double
         , y   :: Double
         }

signature = 'Y'
fields = { crs :: CoordinateReferenceSystem
         , x   :: Double
         , y   :: Double
         , z   :: Double
         }

signature = 'E'
fields = { months  :: Integer
         , days    :: Integer
         , seconds :: Integer
         , nanos   :: Integer
         }

signature = 'D'
fields = { epochDays :: Integer
         }

signature = 'T'
fields = { nanosOfDayLocal :: Integer
         , offsetSeconds   :: Integer
         }

signature = 't'
fields = { nanosOfDay :: Integer
         }

signature = 'd'
fields = { epochSeconds :: Integer
         , nano         :: Integer
         }

signature = 'F'
fields = { epochSecondsLocal :: Integer
         , nano              :: Integer
         , offsetSeconds     :: Integer
         }

signature = 'f'
fields = { epochSecondsLocal :: Integer
         , nano              :: Integer
         , zoneId            :: Integer
         }

λ> :set -XScopedTypeVariables 
λ> pipe <- connect $ def { user = "neo4j", password = "neo4j", version = 2 }
λ> point :: Value <- run pipe $ do records <- query "RETURN point({x: 1, y: 2, z: 3}) as point"
                                   (head records) `at` "point"
λ> point 
S (Structure {signature = 89, fields = [I 9157,F 1.0,F 2.0,F 3.0]})
λ> close pipe