src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs

   1 {-|
   2 Module      : Gargantext.Database.Node.UpdateOpaleye
   3 Description : Update Node in Database (Postgres)
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# LANGUAGE QuasiQuotes       #-}
  13
  14
  15 module Gargantext.Database.Query.Table.Node.UpdateOpaleye
  16   where
  17
  18 import Opaleye
  19 import Data.Aeson (encode, ToJSON)
  20 import Gargantext.Core
  21 import Gargantext.Prelude
  22 import Gargantext.Database.Schema.Node
  23 import Gargantext.Database.Admin.Types.Node
  24 import Gargantext.Database.Prelude (Cmd, mkCmd, JSONB)
  25 import Gargantext.Database.Query.Table.Node
  26 import Gargantext.Database.Query.Table.Node.Error
  27
  28 import Debug.Trace (trace)
  29
  30 updateHyperdata :: ToJSON a => NodeId -> a -> Cmd err Int64
  31 updateHyperdata i h = mkCmd $ \c -> putStrLn "before runUpdate_" >>
  32                                     runUpdate_ c (updateHyperdataQuery i h) >>= \res ->
  33                                     putStrLn "after runUpdate_" >> return res
  34
  35 updateHyperdataQuery :: ToJSON a => NodeId -> a -> Update Int64
  36 updateHyperdataQuery i h = seq h' $ trace "updateHyperdataQuery: encoded JSON" $ Update
  37    { uTable      = nodeTable
  38    , uUpdateWith = updateEasy (\  (Node { .. })
  39                                 -> Node { _node_hyperdata = h', .. }
  40                                -- -> trace "updating mate" $ Node _ni _nh _nt _nu _np _nn _nd h'
  41                               )
  42    , uWhere      = \row -> {-trace "uWhere" $-} _node_id row .== pgNodeId i
  43    , uReturning  = rCount
  44    }
  45     where h' =  sqlJSONB $ cs $ encode h
  46
  47 ----------------------------------------------------------------------------------
  48 updateNodesWithType :: ( HasNodeError err
  49                        , JSONB a
  50                        , ToJSON a
  51                        , HasDBid NodeType
  52                        ) => NodeType -> proxy a -> (a -> a) -> Cmd err [Int64]
  53 updateNodesWithType nt p f = do
  54   ns <- getNodesWithType nt p
  55   mapM (\n -> updateHyperdata (_node_id n) (f $ _node_hyperdata n)) ns
  56
  57 updateNodeWithType :: ( HasNodeError err
  58                       , JSONB a
  59                       , ToJSON a
  60                       , HasDBid NodeType
  61                       ) => NodeId
  62                         -> NodeType
  63                         -> proxy a
  64                         -> (a -> a)
  65                         -> Cmd err [Int64]
  66 updateNodeWithType nId nt p f = do
  67   ns <- getNodeWithType nId nt p
  68   mapM (\n -> updateHyperdata (_node_id n) (f $ _node_hyperdata n)) ns
  69
  70
  71 -- | In case the Hyperdata Types are not compatible
  72 updateNodesWithType_ :: ( HasNodeError err
  73                         , JSONB a
  74                         , ToJSON a
  75                         , HasDBid NodeType
  76                         ) => NodeType -> a -> Cmd err [Int64]
  77 updateNodesWithType_ nt h = do
  78   ns <- getNodesIdWithType nt
  79   mapM (\n -> updateHyperdata n h) ns