]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs
improve performance of logDistributional, upgrade to accelerate 1.3 + lots of debug...
[gargantext.git] / 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 _ni _nh _nt _nu _np _nn _nd _h)
39 -> trace "updating mate" $ Node _ni _nh _nt _nu _np _nn _nd h'
40 )
41 , uWhere = (\row -> trace "uWhere" $ _node_id row .== pgNodeId i )
42 , uReturning = rCount
43 }
44 where h' = (sqlJSONB $ cs $ encode $ h)
45
46 ----------------------------------------------------------------------------------
47 updateNodesWithType :: ( HasNodeError err
48 , JSONB a
49 , ToJSON a
50 , HasDBid NodeType
51 ) => NodeType -> proxy a -> (a -> a) -> Cmd err [Int64]
52 updateNodesWithType nt p f = do
53 ns <- getNodesWithType nt p
54 mapM (\n -> updateHyperdata (_node_id n) (f $ _node_hyperdata n)) ns
55
56
57 -- | In case the Hyperdata Types are not compatible
58 updateNodesWithType_ :: ( HasNodeError err
59 , JSONB a
60 , ToJSON a
61 , HasDBid NodeType
62 ) => NodeType -> a -> Cmd err [Int64]
63 updateNodesWithType_ nt h = do
64 ns <- getNodesIdWithType nt
65 mapM (\n -> updateHyperdata n h) ns
66
67
68
69