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