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