{-|
Module      : Gargantext.Database.Node.UpdateOpaleye
Description : Update Node in Database (Postgres)
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# LANGUAGE QuasiQuotes       #-}


module Gargantext.Database.Query.Table.Node.UpdateOpaleye
  where

import Opaleye
import Data.Aeson (encode, ToJSON)
import Gargantext.Core
import Gargantext.Prelude
import Gargantext.Database.Schema.Node
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, mkCmd, JSONB)
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error

updateHyperdata :: ToJSON a => NodeId -> a -> Cmd err Int64
updateHyperdata :: NodeId -> a -> Cmd err Int64
updateHyperdata NodeId
i a
h = (Connection -> IO Int64) -> Cmd err Int64
forall a err. (Connection -> IO a) -> Cmd err a
mkCmd ((Connection -> IO Int64) -> Cmd err Int64)
-> (Connection -> IO Int64) -> Cmd err Int64
forall a b. (a -> b) -> a -> b
$ \Connection
c -> Connection -> Update Int64 -> IO Int64
forall haskells. Connection -> Update haskells -> IO haskells
runUpdate_ Connection
c (NodeId -> a -> Update Int64
forall a. ToJSON a => NodeId -> a -> Update Int64
updateHyperdataQuery NodeId
i a
h)

updateHyperdataQuery :: ToJSON a => NodeId -> a -> Update Int64
updateHyperdataQuery :: NodeId -> a -> Update Int64
updateHyperdataQuery NodeId
i a
h = Update :: forall haskells fieldsW fieldsR.
Table fieldsW fieldsR
-> (fieldsR -> fieldsW)
-> (fieldsR -> Field SqlBool)
-> Returning fieldsR haskells
-> Update haskells
Update
   { uTable :: Table NodeWrite NodeRead
uTable      = Table NodeWrite NodeRead
nodeTable
   , uUpdateWith :: NodeRead -> NodeWrite
uUpdateWith = (NodeRead -> NodeRead) -> NodeRead -> NodeWrite
forall fieldsR fieldsW.
Default Updater fieldsR fieldsW =>
(fieldsR -> fieldsR) -> fieldsR -> fieldsW
updateEasy (\  (Node Column PGInt4
_ni Column PGText
_nh Column PGInt4
_nt Column PGInt4
_nu Column PGInt4
_np Column PGText
_nn Column PGTimestamptz
_nd Column PGJsonb
_h)
                                -> Column PGInt4
-> Column PGText
-> Column PGInt4
-> Column PGInt4
-> Column PGInt4
-> Column PGText
-> Column PGTimestamptz
-> Column PGJsonb
-> NodeRead
forall id hash_id typename user_id parent_id name date hyperdata.
id
-> hash_id
-> typename
-> user_id
-> parent_id
-> name
-> date
-> hyperdata
-> NodePoly
     id hash_id typename user_id parent_id name date hyperdata
Node Column PGInt4
_ni Column PGText
_nh Column PGInt4
_nt Column PGInt4
_nu Column PGInt4
_np Column PGText
_nn Column PGTimestamptz
_nd Column PGJsonb
h'
                              )
   , uWhere :: NodeRead -> Field SqlBool
uWhere      = (\NodeRead
row -> NodeRead -> Column PGInt4
forall id hash_id typename user_id parent_id name date hyperdata.
NodePoly id hash_id typename user_id parent_id name date hyperdata
-> id
_node_id NodeRead
row Column PGInt4 -> Column PGInt4 -> Field SqlBool
forall a. Column a -> Column a -> Field SqlBool
.== NodeId -> Column PGInt4
pgNodeId NodeId
i )
   , uReturning :: Returning NodeRead Int64
uReturning  = Returning NodeRead Int64
forall fieldsR. Returning fieldsR Int64
rCount
   }
    where h' :: Column PGJsonb
h' =  (String -> Column PGJsonb
pgJSONB (String -> Column PGJsonb) -> String -> Column PGJsonb
forall a b. (a -> b) -> a -> b
$ ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode (a -> ByteString) -> a -> ByteString
forall a b. (a -> b) -> a -> b
$ a
h)

----------------------------------------------------------------------------------
updateNodesWithType :: ( HasNodeError err
                       , JSONB a
                       , ToJSON a
                       , HasDBid NodeType
                       ) => NodeType -> proxy a -> (a -> a) -> Cmd err [Int64]
updateNodesWithType :: NodeType -> proxy a -> (a -> a) -> Cmd err [Int64]
updateNodesWithType NodeType
nt proxy a
p a -> a
f = do
  [Node a]
ns <- NodeType -> proxy a -> Cmd err [Node a]
forall err a (proxy :: * -> *).
(HasNodeError err, JSONB a, HasDBid NodeType) =>
NodeType -> proxy a -> Cmd err [Node a]
getNodesWithType NodeType
nt proxy a
p
  (Node a -> m Int64) -> [Node a] -> m [Int64]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Node a
n -> NodeId -> a -> Cmd err Int64
forall a err. ToJSON a => NodeId -> a -> Cmd err Int64
updateHyperdata (Node a -> NodeId
forall id hash_id typename user_id parent_id name date hyperdata.
NodePoly id hash_id typename user_id parent_id name date hyperdata
-> id
_node_id Node a
n) (a -> a
f (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Node a -> a
forall id hash_id typename user_id parent_id name date hyperdata.
NodePoly id hash_id typename user_id parent_id name date hyperdata
-> hyperdata
_node_hyperdata Node a
n)) [Node a]
ns


-- | In case the Hyperdata Types are not compatible
updateNodesWithType_ :: ( HasNodeError err
                        , JSONB a
                        , ToJSON a
                        , HasDBid NodeType
                        ) => NodeType -> a -> Cmd err [Int64]
updateNodesWithType_ :: NodeType -> a -> Cmd err [Int64]
updateNodesWithType_ NodeType
nt a
h = do
  [NodeId]
ns <- NodeType -> Cmd err [NodeId]
forall err.
(HasNodeError err, HasDBid NodeType) =>
NodeType -> Cmd err [NodeId]
getNodesIdWithType NodeType
nt
  (NodeId -> m Int64) -> [NodeId] -> m [Int64]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\NodeId
n -> NodeId -> a -> Cmd err Int64
forall a err. ToJSON a => NodeId -> a -> Cmd err Int64
updateHyperdata NodeId
n a
h) [NodeId]
ns