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.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
  24 import Gargantext.API.Admin.Settings (HasSettings)
  25 import Gargantext.API.Prelude (GargServer, simuLogs)
  26 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
  27 import Gargantext.Core.Viz.Graph.Distances (GraphMetric(..), Distance(..))
  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, show, cs, (<>), panic)
  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 type API = Summary " Update node according to NodeType params"
  40          :> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
  41
  42 ------------------------------------------------------------------------
  43 data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: !Method      }
  44                       | UpdateNodeParamsGraph { methodGraph :: !GraphMetric }
  45                       | UpdateNodeParamsTexts { methodTexts :: !Granularity }
  46                       | UpdateNodeParamsBoard { methodBoard :: !Charts      }
  47                       | LinkNodeReq { nodeType :: !NodeType, id :: !NodeId }
  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 updateNode _uId nid1 (LinkNodeReq nt nid2) logStatus = do
  99   logStatus JobLog { _scst_succeeded = Just 1
 100                    , _scst_failed    = Just 0
 101                    , _scst_remaining = Just 1
 102                    , _scst_events    = Just []
 103                    }
 104   _ <- case nt of
 105     NodeAnnuaire -> pairing nid2 nid1 Nothing -- defaultList
 106     NodeCorpus   -> pairing nid1 nid2 Nothing -- defaultList
 107     _            -> panic $ "[G.API.N.Update.updateNode] NodeType not implemented"
 108                            <> cs (show nt)
 109
 110   pure  JobLog { _scst_succeeded = Just 2
 111                , _scst_failed    = Just 0
 112                , _scst_remaining = Just 0
 113                , _scst_events    = Just []
 114                }
 115
 116
 117 updateNode _uId _nId _p logStatus = do
 118   simuLogs logStatus 10
 119
 120 ------------------------------------------------------------------------
 121 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
 122 instance FromJSON  UpdateNodeParams where
 123   parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 124
 125 instance ToJSON    UpdateNodeParams where
 126   toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 127
 128 instance ToSchema  UpdateNodeParams
 129 instance Arbitrary UpdateNodeParams where
 130   arbitrary = do
 131     l <- UpdateNodeParamsList  <$> arbitrary
 132     g <- UpdateNodeParamsGraph <$> arbitrary
 133     t <- UpdateNodeParamsTexts <$> arbitrary
 134     b <- UpdateNodeParamsBoard <$> arbitrary
 135     elements [l,g,t,b]
 136
 137 instance FromJSON  Method
 138 instance ToJSON    Method
 139 instance ToSchema  Method
 140 instance Arbitrary Method where
 141   arbitrary = elements [ minBound .. maxBound ]
 142
 143 instance FromJSON  Granularity
 144 instance ToJSON    Granularity
 145 instance ToSchema  Granularity
 146 instance Arbitrary Granularity where
 147   arbitrary = elements [ minBound .. maxBound ]
 148
 149 instance FromJSON  Charts
 150 instance ToJSON    Charts
 151 instance ToSchema  Charts
 152 instance Arbitrary Charts where
 153   arbitrary = elements [ minBound .. maxBound ]
 154
 155 ------------------------------------------------------------------------