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.Viz.Graph.Distances (GraphMetric(..), Distance(..))
  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   _ <- case metric of
  90     Order1 -> recomputeGraph uId nId Conditional
  91     Order2 -> recomputeGraph uId nId Distributional
  92
  93   pure  JobLog { _scst_succeeded = Just 2
  94                , _scst_failed    = Just 0
  95                , _scst_remaining = Just 0
  96                , _scst_events    = Just []
  97                }
  98
  99 updateNode _uId nid1 (LinkNodeReq nt nid2) logStatus = do
 100   logStatus JobLog { _scst_succeeded = Just 1
 101                    , _scst_failed    = Just 0
 102                    , _scst_remaining = Just 1
 103                    , _scst_events    = Just []
 104                    }
 105   _ <- case nt of
 106     NodeAnnuaire -> pairing nid2 nid1 Nothing -- defaultList
 107     NodeCorpus   -> pairing nid1 nid2 Nothing -- defaultList
 108     _            -> panic $ "[G.API.N.Update.updateNode] NodeType not implemented"
 109                            <> cs (show nt)
 110
 111   pure  JobLog { _scst_succeeded = Just 2
 112                , _scst_failed    = Just 0
 113                , _scst_remaining = Just 0
 114                , _scst_events    = Just []
 115                }
 116
 117
 118 updateNode _uId _nId _p logStatus = do
 119   simuLogs logStatus 10
 120
 121 ------------------------------------------------------------------------
 122 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
 123 instance FromJSON  UpdateNodeParams where
 124   parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 125
 126 instance ToJSON    UpdateNodeParams where
 127   toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 128
 129 instance ToSchema  UpdateNodeParams
 130 instance Arbitrary UpdateNodeParams where
 131   arbitrary = do
 132     l <- UpdateNodeParamsList  <$> arbitrary
 133     g <- UpdateNodeParamsGraph <$> arbitrary
 134     t <- UpdateNodeParamsTexts <$> arbitrary
 135     b <- UpdateNodeParamsBoard <$> arbitrary
 136     elements [l,g,t,b]
 137
 138 instance FromJSON  Method
 139 instance ToJSON    Method
 140 instance ToSchema  Method
 141 instance Arbitrary Method where
 142   arbitrary = elements [ minBound .. maxBound ]
 143
 144 instance FromJSON  Granularity
 145 instance ToJSON    Granularity
 146 instance ToSchema  Granularity
 147 instance Arbitrary Granularity where
 148   arbitrary = elements [ minBound .. maxBound ]
 149
 150 instance FromJSON  Charts
 151 instance ToJSON    Charts
 152 instance ToSchema  Charts
 153 instance Arbitrary Charts where
 154   arbitrary = elements [ minBound .. maxBound ]
 155
 156 ------------------------------------------------------------------------