src/Gargantext/Viz/Graph/API.hs

   1 {-|
   2 Module      : Gargantext.Viz.Phylo.Tools
   3 Description : Phylomemy Tools to build/manage it
   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 RankNTypes         #-}
  16 {-# LANGUAGE NoImplicitPrelude #-}
  17 {-# LANGUAGE OverloadedStrings #-}   -- allows to write Text literals
  18 {-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
  19 {-# LANGUAGE DataKinds            #-}
  20
  21 module Gargantext.Viz.Graph.API
  22   where
  23
  24 import Control.Monad.IO.Class (liftIO)
  25 import Control.Lens (set)
  26 --import Servant.Job.Utils (swaggerOptions)
  27 import Gargantext.Database.Schema.Ngrams
  28 import Gargantext.API.Types
  29 import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
  30 import Gargantext.Database.Schema.Node ( getNode)
  31 import Gargantext.Database.Types.Node -- (GraphId, ListId, CorpusId, NodeId)
  32 import Gargantext.Prelude
  33 import Gargantext.API.Ngrams.Tools
  34 import Gargantext.Core.Types.Main
  35 import Gargantext.Viz.Graph.Tools -- (cooc2graph)
  36 import Gargantext.Database.Schema.Node (defaultList)
  37 import Gargantext.Viz.Graph
  38 import Servant
  39 import qualified Data.Map as Map
  40
  41 {-
  42 getgraph :: GraphId -> GraphView
  43 getgraph _GraphId = phyloView
  44 --getgraph :: GraphId -> Maybe PhyloQueryView -> PhyloView
  45 --getgraph _GraphId _phyloQueryView = phyloView
  46
  47 postgraph :: CorpusId -> Maybe ListId -> GraphQueryBuild -> Phylo
  48 postgraph = undefined
  49
  50 putgraph :: GraphId -> Maybe ListId -> PhyloQueryBuild -> Phylo
  51 putgraph = undefined
  52 -}
  53
  54 type GraphAPI   = Get '[JSON] Graph
  55
  56 graphAPI :: NodeId -> GargServer GraphAPI
  57 graphAPI nId = do
  58   nodeGraph <- getNode nId HyperdataGraph
  59
  60   let metadata = GraphMetadata "Title" [maybe 0 identity $ _node_parentId nodeGraph]
  61                                      [ LegendField 1 "#FFF" "Cluster"
  62                                      , LegendField 2 "#FFF" "Cluster"
  63                                      ]
  64                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
  65   let cId = maybe (panic "no parentId") identity $ _node_parentId nodeGraph
  66
  67   lId <- defaultList cId
  68   ngs    <- filterListWithRoot GraphTerm <$> mapTermListRoot [lId] NgramsTerms
  69
  70   myCooc <- Map.filter (>1) <$> getCoocByNgrams (Diagonal False)
  71                             <$> groupNodesByNgrams ngs
  72                             <$> getNodesByNgramsOnlyUser cId NgramsTerms (Map.keys ngs)
  73
  74   liftIO $ set graph_metadata (Just metadata) <$> cooc2graph myCooc
  75
  76
  77 -- | Instances
  78