src/Gargantext/Viz/Graph/API.hs

   1 {-|
   2 Module      : Gargantext.Viz.Graph
   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
  13 {-# OPTIONS_GHC -fno-warn-orphans #-}
  14
  15 {-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
  16 {-# LANGUAGE TypeOperators     #-}
  17
  18 module Gargantext.Viz.Graph.API
  19   where
  20
  21 import Control.Lens (set, (^.), _Just, (^?))
  22 import Data.Aeson
  23 import Data.Maybe (Maybe(..))
  24 import Data.Swagger
  25 import Data.Text
  26 import Debug.Trace (trace)
  27 import GHC.Generics (Generic)
  28 import Gargantext.API.Admin.Orchestrator.Types
  29 import Gargantext.API.Ngrams (NgramsRepo, r_version)
  30 import Gargantext.API.Ngrams.Tools
  31 import Gargantext.API.Prelude
  32 import Gargantext.Core.Types.Main
  33 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
  34 import Gargantext.Database.Admin.Config
  35 import Gargantext.Database.Admin.Types.Node
  36 import Gargantext.Database.Prelude (Cmd)
  37 import Gargantext.Database.Query.Table.Node
  38 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
  39 import Gargantext.Database.Query.Table.Node.Select
  40 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  41 import Gargantext.Database.Schema.Ngrams
  42 import Gargantext.Database.Schema.Node (node_parentId, node_hyperdata)
  43 import Gargantext.Prelude
  44 import Gargantext.Viz.Graph
  45 import Gargantext.Viz.Graph.GEXF ()
  46 import Gargantext.Viz.Graph.Tools -- (cooc2graph)
  47 import Gargantext.Viz.Graph.Distances (Distance(..), GraphMetric(..))
  48 import Servant
  49 import Servant.Job.Async
  50 import Servant.XML
  51 import qualified Data.Map as Map
  52
  53 ------------------------------------------------------------------------
  54 -- | There is no Delete specific API for Graph since it can be deleted
  55 -- as simple Node.
  56 type GraphAPI   =  Get  '[JSON] Graph
  57               :<|> "gexf" :> Get '[XML] (Headers '[Servant.Header "Content-Disposition" Text] Graph)
  58               :<|> GraphAsyncAPI
  59               :<|> "versions" :> GraphVersionsAPI
  60
  61 data GraphVersions =
  62   GraphVersions { gv_graph :: Maybe Int
  63                 , gv_repo :: Int
  64                 }
  65    deriving (Show, Generic)
  66
  67 instance ToJSON GraphVersions
  68 instance ToSchema GraphVersions
  69
  70 graphAPI :: UserId -> NodeId -> GargServer GraphAPI
  71 graphAPI u n =  getGraph       u n
  72          :<|> getGraphGexf     u n
  73          :<|> graphAsync       u n
  74          :<|> graphVersionsAPI u n
  75
  76 ------------------------------------------------------------------------
  77 getGraph :: UserId -> NodeId -> GargNoServer Graph
  78 getGraph _uId nId = do
  79   nodeGraph <- getNodeWith nId HyperdataGraph
  80   let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
  81
  82   repo <- getRepo
  83
  84   let cId = maybe (panic "[G.V.G.API] Node has no parent")
  85                   identity
  86                   $ nodeGraph ^. node_parentId
  87
  88   -- TODO Distance in Graph params
  89   g <- case graph of
  90     Nothing     -> do
  91         graph' <- computeGraph cId Conditional NgramsTerms repo
  92         _      <- updateHyperdata nId (HyperdataGraph $ Just graph')
  93         pure $ trace "[G.V.G.API] Graph empty, computing" $ graph'
  94
  95     Just graph' -> pure $ trace "[G.V.G.API] Graph exists, returning" $ graph'
  96
  97   pure g
  98
  99
 100 recomputeGraph :: UserId -> NodeId -> Distance -> GargNoServer Graph
 101 recomputeGraph _uId nId d = do
 102   nodeGraph <- getNodeWith nId HyperdataGraph
 103   let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
 104   let listVersion = graph ^? _Just
 105                             . graph_metadata
 106                             . _Just
 107                             . gm_list
 108                             . lfg_version
 109
 110   repo <- getRepo
 111   let v   = repo ^. r_version
 112   let cId = maybe (panic "[G.V.G.API.recomputeGraph] Node has no parent")
 113                   identity
 114                   $ nodeGraph ^. node_parentId
 115
 116   g <- case graph of
 117     Nothing     -> do
 118       graph' <- computeGraph cId d NgramsTerms repo
 119       _ <- updateHyperdata nId (HyperdataGraph $ Just graph')
 120       pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" $ graph'
 121
 122     Just graph' -> if listVersion == Just v
 123                      then pure graph'
 124                      else do
 125                        graph'' <- computeGraph cId d NgramsTerms repo
 126                        _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
 127                        pure $ trace "[G.V.G.API] Graph exists, recomputing" $ graph''
 128   pure g
 129
 130
 131 -- TODO use Database Monad only here ?
 132 computeGraph :: HasNodeError err
 133              => CorpusId
 134              -> Distance
 135              -> NgramsType
 136              -> NgramsRepo
 137              -> Cmd err Graph
 138 computeGraph cId d nt repo = do
 139   lId  <- defaultList cId
 140
 141   let metadata = GraphMetadata "Title"
 142                                Order1
 143                                [cId]
 144                                [ LegendField 1 "#FFF" "Cluster"
 145                                , LegendField 2 "#FFF" "Cluster"
 146                                ]
 147                                (ListForGraph lId (repo ^. r_version))
 148                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
 149
 150   lIds <- selectNodesWithUsername NodeList userMaster
 151   let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
 152
 153   -- TODO split diagonal
 154   myCooc <- Map.filter (>1)
 155          <$> getCoocByNgrams (Diagonal False)
 156          <$> groupNodesByNgrams ngs
 157          <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
 158
 159   graph <- liftBase $ cooc2graph d 0 myCooc
 160   let graph' = set graph_metadata (Just metadata) graph
 161   pure graph'
 162
 163 ------------------------------------------------------------
 164 type GraphAsyncAPI = Summary "Update graph"
 165                    :> "async"
 166                    :> AsyncJobsAPI JobLog () JobLog
 167
 168
 169 graphAsync :: UserId -> NodeId -> GargServer GraphAsyncAPI
 170 graphAsync u n =
 171   serveJobsAPI $
 172     JobFunction (\_ log' -> graphAsync' u n (liftBase . log'))
 173
 174
 175 graphAsync' :: UserId
 176            -> NodeId
 177            -> (JobLog -> GargNoServer ())
 178            -> GargNoServer JobLog
 179 graphAsync' u n logStatus = do
 180   logStatus JobLog { _scst_succeeded = Just 0
 181                           , _scst_failed    = Just 0
 182                           , _scst_remaining = Just 1
 183                           , _scst_events    = Just []
 184                           }
 185   _g <- trace (show u) $ recomputeGraph u n Conditional
 186   pure  JobLog { _scst_succeeded = Just 1
 187                       , _scst_failed    = Just 0
 188                       , _scst_remaining = Just 0
 189                       , _scst_events    = Just []
 190                       }
 191
 192 ------------------------------------------------------------
 193 type GraphVersionsAPI = Summary "Graph versions"
 194                         :> Get '[JSON] GraphVersions
 195                    :<|> Summary "Recompute graph version"
 196                         :> Post '[JSON] Graph
 197
 198 graphVersionsAPI :: UserId -> NodeId -> GargServer GraphVersionsAPI
 199 graphVersionsAPI u n =
 200            graphVersions u n
 201       :<|> recomputeVersions u n
 202
 203 graphVersions :: UserId -> NodeId -> GargNoServer GraphVersions
 204 graphVersions _uId nId = do
 205   nodeGraph <- getNodeWith nId HyperdataGraph
 206   let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
 207   let listVersion = graph ^? _Just
 208                             . graph_metadata
 209                             . _Just
 210                             . gm_list
 211                             . lfg_version
 212
 213   repo <- getRepo
 214   let v = repo ^. r_version
 215
 216   pure $ GraphVersions { gv_graph = listVersion
 217                        , gv_repo = v }
 218
 219 recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
 220 recomputeVersions uId nId = recomputeGraph uId nId Conditional
 221
 222 ------------------------------------------------------------
 223 getGraphGexf :: UserId
 224              -> NodeId
 225              -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph)
 226 getGraphGexf uId nId = do
 227   graph <- getGraph uId nId
 228   pure $ addHeader (concat [ "attachment; filename=graph.gexf" ]) graph
 229
 230
 231