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