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   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
  98 recomputeGraph :: UserId -> NodeId -> Distance -> GargNoServer Graph
  99 recomputeGraph _uId nId d = do
 100   nodeGraph <- getNodeWith nId HyperdataGraph
 101   let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
 102   let listVersion = graph ^? _Just
 103                             . graph_metadata
 104                             . _Just
 105                             . gm_list
 106                             . lfg_version
 107
 108   repo <- getRepo
 109   let v   = repo ^. r_version
 110   let cId = maybe (panic "[G.V.G.API.recomputeGraph] Node has no parent")
 111                   identity
 112                   $ nodeGraph ^. node_parentId
 113
 114   case graph of
 115     Nothing     -> do
 116       graph' <- computeGraph cId d NgramsTerms repo
 117       _ <- updateHyperdata nId (HyperdataGraph $ Just graph')
 118       pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" graph'
 119
 120     Just graph' -> if listVersion == Just v
 121                      then pure graph'
 122                      else do
 123                        graph'' <- computeGraph cId d NgramsTerms repo
 124                        _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
 125                        pure $ trace "[G.V.G.API] Graph exists, recomputing" graph''
 126
 127
 128 -- TODO use Database Monad only here ?
 129 computeGraph :: HasNodeError err
 130              => CorpusId
 131              -> Distance
 132              -> NgramsType
 133              -> NgramsRepo
 134              -> Cmd err Graph
 135 computeGraph cId d nt repo = do
 136   lId  <- defaultList cId
 137
 138   lIds <- selectNodesWithUsername NodeList userMaster
 139   let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
 140
 141   -- TODO split diagonal
 142   myCooc <- Map.filter (>1)
 143          <$> getCoocByNgrams (Diagonal True)
 144          <$> groupNodesByNgrams ngs
 145          <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
 146
 147   graph <- liftBase $ cooc2graph d 0 myCooc
 148
 149
 150   let metadata = GraphMetadata "Title"
 151                                Order1
 152                                [cId]
 153                                [ LegendField 1 "#FFF" "Cluster1"
 154                                , LegendField 2 "#FFF" "Cluster2"
 155                                , LegendField 3 "#FFF" "Cluster3"
 156                                , LegendField 4 "#FFF" "Cluster4"
 157                                ]
 158                                (ListForGraph lId (repo ^. r_version))
 159                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
 160
 161   pure $ set graph_metadata (Just metadata) graph
 162
 163
 164 ------------------------------------------------------------
 165 type GraphAsyncAPI = Summary "Update graph"
 166                    :> "async"
 167                    :> AsyncJobsAPI JobLog () JobLog
 168
 169
 170 graphAsync :: UserId -> NodeId -> GargServer GraphAsyncAPI
 171 graphAsync u n =
 172   serveJobsAPI $
 173     JobFunction (\_ log' -> graphAsync' u n (liftBase . log'))
 174
 175
 176 graphAsync' :: UserId
 177            -> NodeId
 178            -> (JobLog -> GargNoServer ())
 179            -> GargNoServer JobLog
 180 graphAsync' u n logStatus = do
 181   logStatus JobLog { _scst_succeeded = Just 0
 182                           , _scst_failed    = Just 0
 183                           , _scst_remaining = Just 1
 184                           , _scst_events    = Just []
 185                           }
 186   _g <- trace (show u) $ recomputeGraph u n Conditional
 187   pure  JobLog { _scst_succeeded = Just 1
 188                       , _scst_failed    = Just 0
 189                       , _scst_remaining = Just 0
 190                       , _scst_events    = Just []
 191                       }
 192
 193 ------------------------------------------------------------
 194 type GraphVersionsAPI = Summary "Graph versions"
 195                         :> Get '[JSON] GraphVersions
 196                    :<|> Summary "Recompute graph version"
 197                         :> Post '[JSON] Graph
 198
 199 graphVersionsAPI :: UserId -> NodeId -> GargServer GraphVersionsAPI
 200 graphVersionsAPI u n =
 201            graphVersions u n
 202       :<|> recomputeVersions u n
 203
 204 graphVersions :: UserId -> NodeId -> GargNoServer GraphVersions
 205 graphVersions _uId nId = do
 206   nodeGraph <- getNodeWith nId HyperdataGraph
 207   let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
 208   let listVersion = graph ^? _Just
 209                             . graph_metadata
 210                             . _Just
 211                             . gm_list
 212                             . lfg_version
 213
 214   repo <- getRepo
 215   let v = repo ^. r_version
 216
 217   pure $ GraphVersions { gv_graph = listVersion
 218                        , gv_repo = v }
 219
 220 recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
 221 recomputeVersions uId nId = recomputeGraph uId nId Conditional
 222
 223 ------------------------------------------------------------
 224 getGraphGexf :: UserId
 225              -> NodeId
 226              -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph)
 227 getGraphGexf uId nId = do
 228   graph <- getGraph uId nId
 229   pure $ addHeader "attachment; filename=graph.gexf" graph
 230
 231
 232