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 Control.Lens (view)
  20 import Data.Aeson
  21 import Data.Maybe (Maybe(..), fromMaybe)
  22 import Data.Swagger
  23 import GHC.Generics (Generic)
  24 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
  25 import Gargantext.API.Admin.Types (HasSettings)
  26 import Gargantext.API.Ngrams.List (reIndexWith)
  27 --import Gargantext.API.Ngrams.Types (TabType(..))
  28 import Gargantext.API.Prelude (GargServer, simuLogs)
  29 import Gargantext.Core.Methods.Distances (GraphMetric(..))
  30 import Gargantext.Core.Types.Main (ListType(..))
  31 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
  32 import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..))
  33 import Gargantext.Core.Viz.Phylo (PhyloSubConfig(..), subConfig2config)
  34 import Gargantext.Core.Viz.Phylo.API.Tools (flowPhyloAPI)
  35 import Gargantext.Database.Action.Flow.Pairing (pairing)
  36 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
  37 import Gargantext.Database.Action.Metrics (updateNgramsOccurrences, updateContextScore)
  38 import Gargantext.Database.Admin.Types.Hyperdata
  39 import Gargantext.Database.Admin.Types.Node
  40 import Gargantext.Database.Query.Table.Node (defaultList, getNode)
  41 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  42 import Gargantext.Database.Schema.Ngrams (NgramsType(NgramsTerms))
  43 import Gargantext.Database.Schema.Node (node_parent_id)
  44 import Gargantext.Prelude (Bool(..), Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure, show, cs, (<>), panic, (<*>))
  45 import Prelude (Enum, Bounded, minBound, maxBound)
  46 import Servant
  47 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
  48 import Test.QuickCheck (elements)
  49 import Test.QuickCheck.Arbitrary
  50 import qualified Data.Set                    as Set
  51 import qualified Gargantext.API.Metrics      as Metrics
  52 import qualified Gargantext.API.Ngrams.Types as NgramsTypes
  53 import qualified Gargantext.Utils.Aeson      as GUA
  54
  55 ------------------------------------------------------------------------
  56 type API = Summary " Update node according to NodeType params"
  57          :> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
  58
  59 ------------------------------------------------------------------------
  60 data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: !Method      }
  61
  62                       | UpdateNodeParamsGraph { methodGraphMetric     :: !GraphMetric
  63                                               , methodGraphClustering :: !PartitionMethod
  64                                               }
  65
  66                       | UpdateNodeParamsTexts { methodTexts :: !Granularity }
  67
  68                       | UpdateNodeParamsBoard { methodBoard :: !Charts      }
  69
  70                       | LinkNodeReq           { nodeType    :: !NodeType
  71                                               , id          :: !NodeId }
  72
  73                       | UpdateNodePhylo       { config :: !PhyloSubConfig }
  74     deriving (Generic)
  75
  76 ----------------------------------------------------------------------
  77 data Method = Basic | Advanced | WithModel
  78     deriving (Generic, Eq, Ord, Enum, Bounded)
  79
  80 ----------------------------------------------------------------------
  81 data Granularity = NewNgrams | NewTexts | Both
  82     deriving (Generic, Eq, Ord, Enum, Bounded)
  83
  84 ----------------------------------------------------------------------
  85 data Charts = Sources | Authors | Institutes | Ngrams | All
  86     deriving (Generic, Eq, Ord, Enum, Bounded)
  87
  88 ------------------------------------------------------------------------
  89 api :: UserId -> NodeId -> GargServer API
  90 api uId nId =
  91   serveJobsAPI $
  92     JobFunction (\p log'' ->
  93       let
  94         log' x = do
  95           printDebug "updateNode" x
  96           liftBase $ log'' x
  97       in updateNode uId nId p (liftBase . log')
  98       )
  99
 100 updateNode :: (HasSettings env, FlowCmdM env err m)
 101     => UserId
 102     -> NodeId
 103     -> UpdateNodeParams
 104     -> (JobLog -> m ())
 105     -> m JobLog
 106 updateNode uId nId (UpdateNodeParamsGraph metric method) logStatus = do
 107
 108   logStatus JobLog { _scst_succeeded = Just 1
 109                    , _scst_failed    = Just 0
 110                    , _scst_remaining = Just 1
 111                    , _scst_events    = Just []
 112                    }
 113   printDebug "Computing graph: " method
 114   _ <- recomputeGraph uId nId method (Just metric) True
 115   printDebug "Graph computed: " method
 116
 117   pure  JobLog { _scst_succeeded = Just 2
 118                , _scst_failed    = Just 0
 119                , _scst_remaining = Just 0
 120                , _scst_events    = Just []
 121                }
 122
 123 updateNode _uId nid1 (LinkNodeReq nt nid2) logStatus = do
 124   logStatus JobLog { _scst_succeeded = Just 1
 125                    , _scst_failed    = Just 0
 126                    , _scst_remaining = Just 1
 127                    , _scst_events    = Just []
 128                    }
 129   _ <- case nt of
 130     NodeAnnuaire -> pairing nid2 nid1 Nothing -- defaultList
 131     NodeCorpus   -> pairing nid1 nid2 Nothing -- defaultList
 132     _            -> panic $ "[G.API.N.Update.updateNode] NodeType not implemented"
 133                           <> cs (show nt <> " nid1: " <> show nid1 <> " nid2: " <> show nid2)
 134
 135   pure  JobLog { _scst_succeeded = Just 2
 136                , _scst_failed    = Just 0
 137                , _scst_remaining = Just 0
 138                , _scst_events    = Just []
 139                }
 140
 141 -- | `Advanced` to update graphs
 142 updateNode _uId lId (UpdateNodeParamsList Advanced) logStatus = do
 143   logStatus JobLog { _scst_succeeded = Just 1
 144                    , _scst_failed    = Just 0
 145                    , _scst_remaining = Just 2
 146                    , _scst_events    = Just []
 147                    }
 148   corpusId <- view node_parent_id <$> getNode lId
 149
 150   logStatus JobLog { _scst_succeeded = Just 2
 151                    , _scst_failed    = Just 0
 152                    , _scst_remaining = Just 1
 153                    , _scst_events    = Just []
 154                    }
 155
 156   _ <- case corpusId of
 157     Just cId -> do
 158       _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Authors Nothing
 159       _ <- Metrics.updateTree cId (Just lId) NgramsTypes.Institutes MapTerm
 160       _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Sources Nothing
 161       pure ()
 162     Nothing  -> pure ()
 163
 164   pure  JobLog { _scst_succeeded = Just 3
 165                , _scst_failed    = Just 0
 166                , _scst_remaining = Just 0
 167                , _scst_events    = Just []
 168                }
 169
 170 updateNode _uId lId (UpdateNodeParamsList _mode) logStatus = do
 171   logStatus JobLog { _scst_succeeded = Just 1
 172                    , _scst_failed    = Just 0
 173                    , _scst_remaining = Just 2
 174                    , _scst_events    = Just []
 175                    }
 176   corpusId <- view node_parent_id <$> getNode lId
 177
 178   logStatus JobLog { _scst_succeeded = Just 2
 179                    , _scst_failed    = Just 0
 180                    , _scst_remaining = Just 1
 181                    , _scst_events    = Just []
 182                    }
 183
 184   _ <- case corpusId of
 185     Just cId -> do
 186       _ <- reIndexWith cId lId NgramsTerms (Set.singleton MapTerm)
 187       _ <- updateNgramsOccurrences cId (Just lId)
 188       pure ()
 189     Nothing  -> pure ()
 190
 191   pure  JobLog { _scst_succeeded = Just 3
 192                , _scst_failed    = Just 0
 193                , _scst_remaining = Just 0
 194                , _scst_events    = Just []
 195                }
 196
 197 updateNode _userId phyloId (UpdateNodePhylo config) logStatus = do
 198   logStatus JobLog { _scst_succeeded = Just 1
 199                    , _scst_failed    = Just 0
 200                    , _scst_remaining = Just 2
 201                    , _scst_events    = Just []
 202                    }
 203
 204   corpusId' <- view node_parent_id <$> getNode phyloId
 205
 206   let corpusId = fromMaybe (panic "") corpusId'
 207
 208   phy <- flowPhyloAPI (subConfig2config config) corpusId
 209
 210   logStatus JobLog { _scst_succeeded = Just 2
 211                    , _scst_failed    = Just 0
 212                    , _scst_remaining = Just 1
 213                    , _scst_events    = Just []
 214                    }
 215
 216   _ <- updateHyperdata phyloId (HyperdataPhylo Nothing (Just phy))
 217
 218   pure  JobLog { _scst_succeeded = Just 3
 219                , _scst_failed    = Just 0
 220                , _scst_remaining = Just 0
 221                , _scst_events    = Just []
 222                }
 223
 224
 225 updateNode _uId tId (UpdateNodeParamsTexts _mode) logStatus = do
 226   logStatus JobLog { _scst_succeeded = Just 1
 227                    , _scst_failed    = Just 0
 228                    , _scst_remaining = Just 2
 229                    , _scst_events    = Just []
 230                    }
 231   corpusId <- view node_parent_id <$> getNode tId
 232   lId      <- defaultList $ fromMaybe (panic "[G.A.N.Update] updateNode/UpdateNodeParamsTexts: no defaultList") corpusId
 233
 234   logStatus JobLog { _scst_succeeded = Just 2
 235                    , _scst_failed    = Just 0
 236                    , _scst_remaining = Just 1
 237                    , _scst_events    = Just []
 238                    }
 239
 240   _ <- case corpusId of
 241     Just cId -> do
 242       _ <- reIndexWith cId lId NgramsTerms (Set.singleton MapTerm)
 243       _ <- updateNgramsOccurrences cId (Just lId)
 244       _ <- updateContextScore      cId (Just lId)
 245       _ <- Metrics.updateChart     cId (Just lId) NgramsTypes.Docs Nothing
 246       -- printDebug "updateContextsScore" (cId, lId, u)
 247       pure ()
 248     Nothing  -> pure ()
 249
 250   pure  JobLog { _scst_succeeded = Just 3
 251                , _scst_failed    = Just 0
 252                , _scst_remaining = Just 0
 253                , _scst_events    = Just []
 254                }
 255
 256
 257
 258
 259
 260 updateNode _uId _nId _p logStatus = do
 261   simuLogs logStatus 10
 262
 263 ------------------------------------------------------------------------
 264 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
 265 instance FromJSON  UpdateNodeParams where
 266   parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
 267
 268 instance ToJSON    UpdateNodeParams where
 269   toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
 270
 271 instance ToSchema  UpdateNodeParams
 272 instance Arbitrary UpdateNodeParams where
 273   arbitrary = do
 274     l <- UpdateNodeParamsList  <$> arbitrary
 275     g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary
 276     t <- UpdateNodeParamsTexts <$> arbitrary
 277     b <- UpdateNodeParamsBoard <$> arbitrary
 278     elements [l,g,t,b]
 279
 280 instance FromJSON  Method
 281 instance ToJSON    Method
 282 instance ToSchema  Method
 283 instance Arbitrary Method where
 284   arbitrary = elements [ minBound .. maxBound ]
 285
 286 instance FromJSON  Granularity
 287 instance ToJSON    Granularity
 288 instance ToSchema  Granularity
 289 instance Arbitrary Granularity where
 290   arbitrary = elements [ minBound .. maxBound ]
 291
 292 instance FromJSON  Charts
 293 instance ToJSON    Charts
 294 instance ToSchema  Charts
 295 instance Arbitrary Charts where
 296   arbitrary = elements [ minBound .. maxBound ]
 297
 298 ------------------------------------------------------------------------