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