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 {-# LANGUAGE TypeOperators      #-}
  21
  22 module Gargantext.Viz.Graph.API
  23   where
  24
  25 import Control.Lens (set)
  26 import Control.Monad.IO.Class (liftIO)
  27 import Gargantext.API.Ngrams.Tools
  28 import Gargantext.API.Types
  29 import Gargantext.Core.Types.Main
  30 import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
  31 import Gargantext.Database.Schema.Ngrams
  32 import Gargantext.Database.Schema.Node ( getNode)
  33 import Gargantext.Database.Schema.Node (defaultList)
  34 import Gargantext.Database.Types.Node -- (GraphId, ListId, CorpusId, NodeId)
  35 import Gargantext.Prelude
  36 import Gargantext.Viz.Graph
  37 import Gargantext.Viz.Graph.Tools -- (cooc2graph)
  38 import Servant
  39 import qualified Data.Map as Map
  40
  41 ------------------------------------------------------------------------
  42
  43 -- | There is no Delete specific API for Graph since it can be deleted
  44 -- as simple Node.
  45 type GraphAPI   =  Get  '[JSON] Graph
  46               :<|> Post '[JSON] [NodeId]
  47               :<|> Put  '[JSON] Int
  48
  49
  50 graphAPI :: NodeId -> GargServer GraphAPI
  51 graphAPI n =  getGraph  n
  52          :<|> postGraph n
  53          :<|> putGraph  n
  54
  55 ------------------------------------------------------------------------
  56
  57 getGraph :: NodeId -> GargServer (Get '[JSON] Graph)
  58 getGraph nId = do
  59   nodeGraph <- getNode nId HyperdataGraph
  60
  61   let metadata = GraphMetadata "Title" [maybe 0 identity $ _node_parentId nodeGraph]
  62                                      [ LegendField 1 "#FFF" "Cluster"
  63                                      , LegendField 2 "#FFF" "Cluster"
  64                                      ]
  65                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
  66   let cId = maybe (panic "no parentId") identity $ _node_parentId nodeGraph
  67
  68   lId <- defaultList cId
  69   ngs    <- filterListWithRoot GraphTerm <$> mapTermListRoot [lId] NgramsTerms
  70
  71   myCooc <- Map.filter (>1) <$> getCoocByNgrams (Diagonal False)
  72                             <$> groupNodesByNgrams ngs
  73                             <$> getNodesByNgramsOnlyUser cId NgramsTerms (Map.keys ngs)
  74
  75   liftIO $ set graph_metadata (Just metadata) <$> cooc2graph myCooc
  76
  77
  78 postGraph :: NodeId -> GargServer (Post '[JSON] [NodeId])
  79 postGraph = undefined
  80
  81 putGraph :: NodeId -> GargServer (Put '[JSON] Int)
  82 putGraph = undefined
  83
  84
  85
  86
  87 -- | Instances
  88