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   myCooc <- Map.filter (>1)
 154          <$> getCoocByNgrams (Diagonal True)
 155          <$> groupNodesByNgrams ngs
 156          <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
 157
 158   graph <- liftBase $ cooc2graph d 0 myCooc
 159   let graph' = set graph_metadata (Just metadata) graph
 160   pure graph'
 161
 162 ------------------------------------------------------------
 163 type GraphAsyncAPI = Summary "Update graph"
 164                    :> "async"
 165                    :> AsyncJobsAPI JobLog () JobLog
 166
 167
 168 graphAsync :: UserId -> NodeId -> GargServer GraphAsyncAPI
 169 graphAsync u n =
 170   serveJobsAPI $
 171     JobFunction (\_ log' -> graphAsync' u n (liftBase . log'))
 172
 173
 174 graphAsync' :: UserId
 175            -> NodeId
 176            -> (JobLog -> GargNoServer ())
 177            -> GargNoServer JobLog
 178 graphAsync' u n logStatus = do
 179   logStatus JobLog { _scst_succeeded = Just 0
 180                           , _scst_failed    = Just 0
 181                           , _scst_remaining = Just 1
 182                           , _scst_events    = Just []
 183                           }
 184   _g <- trace (show u) $ recomputeGraph u n Conditional
 185   pure  JobLog { _scst_succeeded = Just 1
 186                       , _scst_failed    = Just 0
 187                       , _scst_remaining = Just 0
 188                       , _scst_events    = Just []
 189                       }
 190
 191 ------------------------------------------------------------
 192 type GraphVersionsAPI = Summary "Graph versions"
 193                         :> Get '[JSON] GraphVersions
 194                    :<|> Summary "Recompute graph version"
 195                         :> Post '[JSON] Graph
 196
 197 graphVersionsAPI :: UserId -> NodeId -> GargServer GraphVersionsAPI
 198 graphVersionsAPI u n =
 199            graphVersions u n
 200       :<|> recomputeVersions u n
 201
 202 graphVersions :: UserId -> NodeId -> GargNoServer GraphVersions
 203 graphVersions _uId nId = do
 204   nodeGraph <- getNodeWith nId HyperdataGraph
 205   let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
 206   let listVersion = graph ^? _Just
 207                             . graph_metadata
 208                             . _Just
 209                             . gm_list
 210                             . lfg_version
 211
 212   repo <- getRepo
 213   let v = repo ^. r_version
 214
 215   pure $ GraphVersions { gv_graph = listVersion
 216                        , gv_repo = v }
 217
 218 recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
 219 recomputeVersions uId nId = recomputeGraph uId nId Conditional
 220
 221 ------------------------------------------------------------
 222 getGraphGexf :: UserId
 223              -> NodeId
 224              -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph)
 225 getGraphGexf uId nId = do
 226   graph <- getGraph uId nId
 227   pure $ addHeader (concat [ "attachment; filename=graph.gexf" ]) graph
 228
 229
 230