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
 114   _ <- recomputeGraph uId nId method (Just metric) True
 115
 116   pure  JobLog { _scst_succeeded = Just 2
 117                , _scst_failed    = Just 0
 118                , _scst_remaining = Just 0
 119                , _scst_events    = Just []
 120                }
 121
 122 updateNode _uId nid1 (LinkNodeReq nt nid2) logStatus = do
 123   logStatus JobLog { _scst_succeeded = Just 1
 124                    , _scst_failed    = Just 0
 125                    , _scst_remaining = Just 1
 126                    , _scst_events    = Just []
 127                    }
 128   _ <- case nt of
 129     NodeAnnuaire -> pairing nid2 nid1 Nothing -- defaultList
 130     NodeCorpus   -> pairing nid1 nid2 Nothing -- defaultList
 131     _            -> panic $ "[G.API.N.Update.updateNode] NodeType not implemented"
 132                           <> cs (show nt <> " nid1: " <> show nid1 <> " nid2: " <> show nid2)
 133
 134   pure  JobLog { _scst_succeeded = Just 2
 135                , _scst_failed    = Just 0
 136                , _scst_remaining = Just 0
 137                , _scst_events    = Just []
 138                }
 139
 140 -- | `Advanced` to update graphs
 141 updateNode _uId lId (UpdateNodeParamsList Advanced) logStatus = do
 142   logStatus JobLog { _scst_succeeded = Just 1
 143                    , _scst_failed    = Just 0
 144                    , _scst_remaining = Just 2
 145                    , _scst_events    = Just []
 146                    }
 147   corpusId <- view node_parent_id <$> getNode lId
 148
 149   logStatus JobLog { _scst_succeeded = Just 2
 150                    , _scst_failed    = Just 0
 151                    , _scst_remaining = Just 1
 152                    , _scst_events    = Just []
 153                    }
 154
 155   _ <- case corpusId of
 156     Just cId -> do
 157       _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Authors Nothing
 158       _ <- Metrics.updateTree cId (Just lId) NgramsTypes.Institutes MapTerm
 159       _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Sources Nothing
 160       pure ()
 161     Nothing  -> pure ()
 162
 163   pure  JobLog { _scst_succeeded = Just 3
 164                , _scst_failed    = Just 0
 165                , _scst_remaining = Just 0
 166                , _scst_events    = Just []
 167                }
 168
 169 updateNode _uId lId (UpdateNodeParamsList _mode) logStatus = do
 170   logStatus JobLog { _scst_succeeded = Just 1
 171                    , _scst_failed    = Just 0
 172                    , _scst_remaining = Just 2
 173                    , _scst_events    = Just []
 174                    }
 175   corpusId <- view node_parent_id <$> getNode lId
 176
 177   logStatus JobLog { _scst_succeeded = Just 2
 178                    , _scst_failed    = Just 0
 179                    , _scst_remaining = Just 1
 180                    , _scst_events    = Just []
 181                    }
 182
 183   _ <- case corpusId of
 184     Just cId -> do
 185       _ <- reIndexWith cId lId NgramsTerms (Set.singleton MapTerm)
 186       _ <- updateNgramsOccurrences cId (Just lId)
 187       pure ()
 188     Nothing  -> pure ()
 189
 190   pure  JobLog { _scst_succeeded = Just 3
 191                , _scst_failed    = Just 0
 192                , _scst_remaining = Just 0
 193                , _scst_events    = Just []
 194                }
 195
 196 updateNode _userId phyloId (UpdateNodePhylo config) logStatus = do
 197   logStatus JobLog { _scst_succeeded = Just 1
 198                    , _scst_failed    = Just 0
 199                    , _scst_remaining = Just 2
 200                    , _scst_events    = Just []
 201                    }
 202
 203   corpusId' <- view node_parent_id <$> getNode phyloId
 204
 205   let corpusId = fromMaybe (panic "") corpusId'
 206
 207   phy <- flowPhyloAPI (subConfig2config config) corpusId
 208
 209   logStatus JobLog { _scst_succeeded = Just 2
 210                    , _scst_failed    = Just 0
 211                    , _scst_remaining = Just 1
 212                    , _scst_events    = Just []
 213                    }
 214
 215   _ <- updateHyperdata phyloId (HyperdataPhylo Nothing (Just phy))
 216
 217   pure  JobLog { _scst_succeeded = Just 3
 218                , _scst_failed    = Just 0
 219                , _scst_remaining = Just 0
 220                , _scst_events    = Just []
 221                }
 222
 223
 224 updateNode _uId tId (UpdateNodeParamsTexts _mode) logStatus = do
 225   logStatus JobLog { _scst_succeeded = Just 1
 226                    , _scst_failed    = Just 0
 227                    , _scst_remaining = Just 2
 228                    , _scst_events    = Just []
 229                    }
 230   corpusId <- view node_parent_id <$> getNode tId
 231   lId      <- defaultList $ fromMaybe (panic "[G.A.N.Update] updateNode/UpdateNodeParamsTexts: no defaultList") corpusId
 232
 233   logStatus JobLog { _scst_succeeded = Just 2
 234                    , _scst_failed    = Just 0
 235                    , _scst_remaining = Just 1
 236                    , _scst_events    = Just []
 237                    }
 238
 239   _ <- case corpusId of
 240     Just cId -> do
 241       _ <- reIndexWith cId lId NgramsTerms (Set.singleton MapTerm)
 242       _ <- updateNgramsOccurrences cId (Just lId)
 243       _ <- updateContextScore      cId (Just lId)
 244       _ <- Metrics.updateChart     cId (Just lId) NgramsTypes.Docs Nothing
 245       -- printDebug "updateContextsScore" (cId, lId, u)
 246       pure ()
 247     Nothing  -> pure ()
 248
 249   pure  JobLog { _scst_succeeded = Just 3
 250                , _scst_failed    = Just 0
 251                , _scst_remaining = Just 0
 252                , _scst_events    = Just []
 253                }
 254
 255
 256
 257
 258
 259 updateNode _uId _nId _p logStatus = do
 260   simuLogs logStatus 10
 261
 262 ------------------------------------------------------------------------
 263 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
 264 instance FromJSON  UpdateNodeParams where
 265   parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
 266
 267 instance ToJSON    UpdateNodeParams where
 268   toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
 269
 270 instance ToSchema  UpdateNodeParams
 271 instance Arbitrary UpdateNodeParams where
 272   arbitrary = do
 273     l <- UpdateNodeParamsList  <$> arbitrary
 274     g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary
 275     t <- UpdateNodeParamsTexts <$> arbitrary
 276     b <- UpdateNodeParamsBoard <$> arbitrary
 277     elements [l,g,t,b]
 278
 279 instance FromJSON  Method
 280 instance ToJSON    Method
 281 instance ToSchema  Method
 282 instance Arbitrary Method where
 283   arbitrary = elements [ minBound .. maxBound ]
 284
 285 instance FromJSON  Granularity
 286 instance ToJSON    Granularity
 287 instance ToSchema  Granularity
 288 instance Arbitrary Granularity where
 289   arbitrary = elements [ minBound .. maxBound ]
 290
 291 instance FromJSON  Charts
 292 instance ToJSON    Charts
 293 instance ToSchema  Charts
 294 instance Arbitrary Charts where
 295   arbitrary = elements [ minBound .. maxBound ]
 296
 297 ------------------------------------------------------------------------