{-# OPTIONS_GHC -fno-warn-orphans #-}

module Database.Bolt.Extras.Utils
  (
    dummyId
  , union
  , currentLoc
  , exactValues
  , exactValuesM
  , exact
  ) where

import           Control.Monad.IO.Class (MonadIO (..))
import           Data.List              (nub)
import           Data.Map.Strict        as M ((!), (!?))
import qualified Data.Map.Strict        as M (union)
import           Data.Text              (Text)
import           Database.Bolt          as B (BoltActionT, Node (..), Record,
                                              RecordValue (..), Value (..))
import           Language.Haskell.TH    (Exp (..), Lit (..), Loc (..), Q,
                                         location)
import           Text.Printf            (printf)


-- | 'dummyId' is used to load 'Node' and 'URelationship' into database,
-- because id from database is not known for such moment.
--
dummyId :: Int
dummyId :: Int
dummyId = -Int
1

-- | 'Node's can be merged. 'union' is useful when you have to store in one node
-- several labels and props from different classes.
--
union :: Node -> Node -> Node
(Node Int
_ [Text]
labels1 Map Text Value
props1) union :: Node -> Node -> Node
`union` (Node Int
_ [Text]
labels2 Map Text Value
props2) = Int -> [Text] -> Map Text Value -> Node
Node Int
dummyId
                                                               (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [Text]
labels1 forall a. [a] -> [a] -> [a]
++ [Text]
labels2)
                                                               (Map Text Value
props1 forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map Text Value
props2)

-- | 'currentLoc' shows module name and line where this expression is used.
--
currentLoc :: Q Exp
currentLoc :: Q Exp
currentLoc = do
  Loc
loc <- Q Loc
location
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%s:%d: " (Loc -> String
loc_module Loc
loc) (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Loc -> CharPos
loc_start Loc
loc)

-- | Unpack a value, using 'fail' in 'IO` to report errors.
{-# DEPRECATED exact "This function exists for compatibility, consider using pure exactEither or exactMaybe instead." #-}
exact :: (MonadIO m, RecordValue a) => Value -> m a
exact :: forall (m :: * -> *) a. (MonadIO m, RecordValue a) => Value -> m a
exact = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RecordValue a => Value -> Either UnpackError a
exactEither

-- | Extract values
--
exactValues :: (MonadIO m, RecordValue a) => Text -> [Record] -> m [a]
exactValues :: forall (m :: * -> *) a.
(MonadIO m, RecordValue a) =>
Text -> [Map Text Value] -> m [a]
exactValues Text
var = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) a. (MonadIO m, RecordValue a) => Value -> m a
exact forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall k a. Ord k => Map k a -> k -> a
! Text
var))

-- | Extract values (maybe)
exactValuesM :: (MonadIO m, RecordValue a) => Text -> [Record] -> BoltActionT m [Maybe a]
exactValuesM :: forall (m :: * -> *) a.
(MonadIO m, RecordValue a) =>
Text -> [Map Text Value] -> BoltActionT m [Maybe a]
exactValuesM Text
var = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) a.
(MonadIO m, RecordValue a) =>
Maybe Value -> BoltActionT m (Maybe a)
safeExact forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall k a. Ord k => Map k a -> k -> Maybe a
!? Text
var))
  where
    safeExact :: (MonadIO m, RecordValue a) => Maybe B.Value -> BoltActionT m (Maybe a)
    safeExact :: forall (m :: * -> *) a.
(MonadIO m, RecordValue a) =>
Maybe Value -> BoltActionT m (Maybe a)
safeExact Maybe Value
Nothing       = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    safeExact (Just (N ())) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    safeExact (Just Value
x )     = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (MonadIO m, RecordValue a) => Value -> m a
exact Value
x