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 updateHyperdata :: ToJSON a => NodeId -> a -> Cmd err Int64
  29 updateHyperdata i h = mkCmd $ \c -> runUpdate_ c (updateHyperdataQuery i h)
  30
  31 updateHyperdataQuery :: ToJSON a => NodeId -> a -> Update Int64
  32 updateHyperdataQuery i h = Update
  33    { uTable      = nodeTable
  34    , uUpdateWith = updateEasy (\  (Node _ni _nh _nt _nu _np _nn _nd _h)
  35                                 -> Node _ni _nh _nt _nu _np _nn _nd h'
  36                               )
  37    , uWhere      = (\row -> _node_id row .== pgNodeId i )
  38    , uReturning  = rCount
  39    }
  40     where h' =  (sqlJSONB $ cs $ encode $ h)
  41
  42 ----------------------------------------------------------------------------------
  43 updateNodesWithType :: ( HasNodeError err
  44                        , JSONB a
  45                        , ToJSON a
  46                        , HasDBid NodeType
  47                        ) => NodeType -> proxy a -> (a -> a) -> Cmd err [Int64]
  48 updateNodesWithType nt p f = do
  49   ns <- getNodesWithType nt p
  50   mapM (\n -> updateHyperdata (_node_id n) (f $ _node_hyperdata n)) ns
  51
  52
  53 -- | In case the Hyperdata Types are not compatible
  54 updateNodesWithType_ :: ( HasNodeError err
  55                         , JSONB a
  56                         , ToJSON a
  57                         , HasDBid NodeType
  58                         ) => NodeType -> a -> Cmd err [Int64]
  59 updateNodesWithType_ nt h = do
  60   ns <- getNodesIdWithType nt
  61   mapM (\n -> updateHyperdata n h) ns
  62
  63
  64
  65