{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Gargantext.Database.Transactional.Example where

import Control.Lens
import Data.Aeson qualified as JSON
import Gargantext.Core (toDBid)
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu
import Gargantext.Database.Action.Share hiding (getFolderId)
import Gargantext.Database.Admin.Config
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser, HyperdataFolder)
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node (selectNode, selectNodesWith)
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Table.NodeNode (TargetId(..), SourceId (..), NodeNodePoly (..), nodeNodeTable)
import Gargantext.Database.Query.Table.NodeNode qualified as GGTX hiding (insertNodeNode)
import Gargantext.Database.Query.Tree.Root (selectRoot)
import Gargantext.Database.Schema.Node (_node_id)
import Gargantext.Database.Schema.Node (node_user_id)
import Gargantext.Database.Transactional
import Gargantext.Prelude (panicTrace, headMay)
import Opaleye
import Prelude

-- | In this example we can compose two QUERY operations
-- and the result it's still a pure query.
pureQueryExample :: HasNodeError err
                => NodeId
                -> User
                -> DBCmd err (Node JSON.Value, UserId)
pureQueryExample n u = runDBQuery $ do
  nodeToCheck <- getNode n
  userIdCheck <- getUserId u
  pure (nodeToCheck, userIdCheck)

-- | In this example we can compose a QUERY operation
-- with an UPDATE operation, and the overall \"flavor\"
-- of the DbTx is an UPDATE, so we have to use 'runDBTx'.
simpleTxExample :: HasNodeError err
                => NodeId
                -> DBCmd err Int
simpleTxExample n = runDBTx $ do
  nodeToCheck <- getNode n
  shareNode (SourceId $ _node_id nodeToCheck) (TargetId $ _node_id nodeToCheck)

shareNodeWithTx :: HasNodeError err
                => ShareNodeWith
                -> NodeId
                -- ^ The target node we would like to share, it has
                -- to be a 'NodeFolderShared'.
                -> DBCmd err Int
shareNodeWithTx (ShareNodeWith_User NodeFolderShared u) n = runDBTx $ do
  nodeToCheck <- getNode   n
  userIdCheck <- getUserId u
  if Prelude.not (hasNodeType nodeToCheck NodeTeam)
    then dbFailWith "[G.D.A.S.shareNodeWith] Can share node Team only"
    else
      if (view node_user_id nodeToCheck == userIdCheck)
        then dbFailWith "[G.D.A.S.shareNodeWith] Can share to others only"
        else do
          folderSharedId  <- getFolderId u NodeFolderShared
          shareNode (SourceId folderSharedId) (TargetId n)
shareNodeWithTx _ _ = panicTrace "unimplemented (just testing)"

shareNode :: SourceId -> TargetId -> DBUpdate err Int
shareNode (SourceId sourceId) (TargetId targetId) =
  insertNodeNode [ NodeNode sourceId targetId Nothing Nothing ]

--
-- Mock functions for testing
--

getNode :: forall err x. HasNodeError err => NodeId -> DBQuery err x (Node JSON.Value)
getNode nId = do
  xs <- mkOpaQuery (selectNode (pgNodeId nId))
  case headMay xs of
    Nothing -> dbFail $ _NodeError # (DoesNotExist nId)
    Just  r -> pure r

getUserId :: User -> DBQuery err x UserId
getUserId = undefined

getFolderId :: HasNodeError err => User -> NodeType -> DBQuery err x NodeId
getFolderId u nt = do
  rootId <- getRootId u
  (s :: [ Node HyperdataFolder]) <- mkOpaQuery (selectNodesWith rootId (Just nt) Nothing Nothing)
  case headMay s of
    Nothing -> dbFailWith "[G.D.A.S.getFolderId] No folder shared found"
    Just  f -> pure (_node_id f)

getRootId :: HasNodeError err => User -> DBQuery err x NodeId
getRootId u = do
  (xs :: [ Node HyperdataUser]) <- mkOpaQuery (selectRoot u)
  case headMay xs of
    Nothing -> dbFailWith "[G.D.Q.T.R.getRootId] No root id"
    Just  r -> pure (_node_id r)

insertNodeNode :: [GGTX.NodeNode] -> DBUpdate err Int
insertNodeNode ns = fromIntegral <$> mkOpaInsert (Insert nodeNodeTable ns' rCount (Just doNothing))
  where
    ns' :: [GGTX.NodeNodeWrite]
    ns' = map (\(NodeNode n1 n2 x y)
                -> NodeNode (pgNodeId n1)
                            (pgNodeId n2)
                            (sqlDouble <$> x)
                            (sqlInt4 . toDBid <$> y)
              ) ns