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 Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
  23 import Gargantext.API.Node.Corpus.New (AsyncJobs)
  24 import Gargantext.API.Prelude (GargServer, simuLogs)
  25 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
  26 import Gargantext.Database.Admin.Types.Node
  27 import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.), {-Int, pure, (*),-} printDebug, {-(^)-}) -- (-), (^))
  28 import Prelude (Enum, Bounded, minBound, maxBound)
  29 import Servant
  30 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
  31 import Test.QuickCheck (elements)
  32 import Test.QuickCheck.Arbitrary
  33
  34
  35 ------------------------------------------------------------------------
  36 type API = Summary " Update node according to NodeType params"
  37          :> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
  38
  39 ------------------------------------------------------------------------
  40 data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: Method      }
  41                       | UpdateNodeParamsGraph { methodGraph :: GraphMetric }
  42                       | UpdateNodeParamsTexts { methodTexts :: Granularity }
  43                       | UpdateNodeParamsBoard { methodBoard :: Charts      }
  44     deriving (Generic)
  45
  46 ----------------------------------------------------------------------
  47 data Method = Basic | Advanced | WithModel
  48     deriving (Generic, Eq, Ord, Enum, Bounded)
  49
  50 ----------------------------------------------------------------------
  51 data GraphMetric = Order1 | Order2
  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 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
  64 instance FromJSON  UpdateNodeParams where
  65   parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  66
  67 instance ToJSON    UpdateNodeParams where
  68   toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  69
  70 instance ToSchema  UpdateNodeParams
  71 instance Arbitrary UpdateNodeParams where
  72   arbitrary = do
  73     l <- UpdateNodeParamsList  <$> arbitrary
  74     g <- UpdateNodeParamsGraph <$> arbitrary
  75     t <- UpdateNodeParamsTexts <$> arbitrary
  76     b <- UpdateNodeParamsBoard <$> arbitrary
  77     elements [l,g,t,b]
  78
  79 instance FromJSON  Method
  80 instance ToJSON    Method
  81 instance ToSchema  Method
  82 instance Arbitrary Method where
  83   arbitrary = elements [ minBound .. maxBound ]
  84
  85 instance FromJSON  GraphMetric
  86 instance ToJSON    GraphMetric
  87 instance ToSchema  GraphMetric
  88 instance Arbitrary GraphMetric where
  89   arbitrary = elements [ minBound .. maxBound ]
  90
  91 instance FromJSON  Granularity
  92 instance ToJSON    Granularity
  93 instance ToSchema  Granularity
  94 instance Arbitrary Granularity where
  95   arbitrary = elements [ minBound .. maxBound ]
  96
  97 instance FromJSON  Charts
  98 instance ToJSON    Charts
  99 instance ToSchema  Charts
 100 instance Arbitrary Charts where
 101   arbitrary = elements [ minBound .. maxBound ]
 102
 103 ------------------------------------------------------------------------
 104 api :: UserId -> NodeId -> GargServer API
 105 api uId nId =
 106   serveJobsAPI $
 107     JobFunction (\p log ->
 108       let
 109         log' x = do
 110           printDebug "updateNode" x
 111           liftBase $ log x
 112       in updateNode uId nId p (liftBase . log')
 113       )
 114
 115 updateNode :: FlowCmdM env err m
 116     => UserId
 117     -> NodeId
 118     -> UpdateNodeParams
 119     -> (JobLog -> m ())
 120     -> m JobLog
 121 updateNode _uId _nId _p logStatus = do
 122   simuLogs logStatus 10
 123 ------------------------------------------------------------------------