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