]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Node/Update.hs
[ADMIN] Adding linear Algebra utils for Accelerate
[gargantext.git] / src / Gargantext / API / Node / Update.hs
1 {-|
2 Module : Gargantext.API.Node.Update
3 Description :
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 TemplateHaskell #-}
13 {-# LANGUAGE TypeOperators #-}
14 {-# OPTIONS_GHC -fno-warn-orphans #-}
15
16 module Gargantext.API.Node.Update
17 where
18
19 import Data.Aeson
20 import Data.Maybe (Maybe(..))
21 import Data.Swagger
22 import GHC.Generics (Generic)
23 import Prelude (Enum, Bounded, minBound, maxBound)
24 import Servant
25 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
26 import Test.QuickCheck (elements)
27 import Test.QuickCheck.Arbitrary
28
29 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
30 import Gargantext.API.Admin.Types (HasSettings)
31 import Gargantext.API.Prelude (GargServer, simuLogs)
32 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
33 import Gargantext.Core.Methods.Distances (GraphMetric(..), Distance(..))
34 import Gargantext.Database.Action.Flow.Pairing (pairing)
35 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
36 import Gargantext.Database.Admin.Types.Node
37 import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure, show, cs, (<>), panic)
38
39 ------------------------------------------------------------------------
40 type API = Summary " Update node according to NodeType params"
41 :> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
42
43 ------------------------------------------------------------------------
44 data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
45 | UpdateNodeParamsGraph { methodGraph :: !GraphMetric }
46 | UpdateNodeParamsTexts { methodTexts :: !Granularity }
47 | UpdateNodeParamsBoard { methodBoard :: !Charts }
48 | LinkNodeReq { nodeType :: !NodeType, id :: !NodeId }
49 deriving (Generic)
50
51 ----------------------------------------------------------------------
52 data Method = Basic | Advanced | WithModel
53 deriving (Generic, Eq, Ord, Enum, Bounded)
54
55 ----------------------------------------------------------------------
56 data Granularity = NewNgrams | NewTexts | Both
57 deriving (Generic, Eq, Ord, Enum, Bounded)
58
59 ----------------------------------------------------------------------
60 data Charts = Sources | Authors | Institutes | Ngrams | All
61 deriving (Generic, Eq, Ord, Enum, Bounded)
62
63 ------------------------------------------------------------------------
64 api :: UserId -> NodeId -> GargServer API
65 api uId nId =
66 serveJobsAPI $
67 JobFunction (\p log'' ->
68 let
69 log' x = do
70 printDebug "updateNode" x
71 liftBase $ log'' x
72 in updateNode uId nId p (liftBase . log')
73 )
74
75 updateNode :: (HasSettings env, FlowCmdM env err m)
76 => UserId
77 -> NodeId
78 -> UpdateNodeParams
79 -> (JobLog -> m ())
80 -> m JobLog
81 updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do
82
83 logStatus JobLog { _scst_succeeded = Just 1
84 , _scst_failed = Just 0
85 , _scst_remaining = Just 1
86 , _scst_events = Just []
87 }
88
89 _ <- case metric of
90 Order1 -> recomputeGraph uId nId Conditional
91 Order2 -> recomputeGraph uId nId Distributional
92
93 pure JobLog { _scst_succeeded = Just 2
94 , _scst_failed = Just 0
95 , _scst_remaining = Just 0
96 , _scst_events = Just []
97 }
98
99 updateNode _uId nid1 (LinkNodeReq nt nid2) logStatus = do
100 logStatus JobLog { _scst_succeeded = Just 1
101 , _scst_failed = Just 0
102 , _scst_remaining = Just 1
103 , _scst_events = Just []
104 }
105 _ <- case nt of
106 NodeAnnuaire -> pairing nid2 nid1 Nothing -- defaultList
107 NodeCorpus -> pairing nid1 nid2 Nothing -- defaultList
108 _ -> panic $ "[G.API.N.Update.updateNode] NodeType not implemented"
109 <> cs (show nt)
110
111 pure JobLog { _scst_succeeded = Just 2
112 , _scst_failed = Just 0
113 , _scst_remaining = Just 0
114 , _scst_events = Just []
115 }
116
117
118 updateNode _uId _nId _p logStatus = do
119 simuLogs logStatus 10
120
121 ------------------------------------------------------------------------
122 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
123 instance FromJSON UpdateNodeParams where
124 parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
125
126 instance ToJSON UpdateNodeParams where
127 toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
128
129 instance ToSchema UpdateNodeParams
130 instance Arbitrary UpdateNodeParams where
131 arbitrary = do
132 l <- UpdateNodeParamsList <$> arbitrary
133 g <- UpdateNodeParamsGraph <$> arbitrary
134 t <- UpdateNodeParamsTexts <$> arbitrary
135 b <- UpdateNodeParamsBoard <$> arbitrary
136 elements [l,g,t,b]
137
138 instance FromJSON Method
139 instance ToJSON Method
140 instance ToSchema Method
141 instance Arbitrary Method where
142 arbitrary = elements [ minBound .. maxBound ]
143
144 instance FromJSON Granularity
145 instance ToJSON Granularity
146 instance ToSchema Granularity
147 instance Arbitrary Granularity where
148 arbitrary = elements [ minBound .. maxBound ]
149
150 instance FromJSON Charts
151 instance ToJSON Charts
152 instance ToSchema Charts
153 instance Arbitrary Charts where
154 arbitrary = elements [ minBound .. maxBound ]
155
156 ------------------------------------------------------------------------