src/Gargantext/Core/Viz/Graph.hs

   1 {-|
   2 Module      : Gargantext.Core.Viz.Graph
   3 Description : Graph utils
   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 {-# LANGUAGE TemplateHaskell      #-}
  13
  14 module Gargantext.Core.Viz.Graph
  15   where
  16
  17 import Data.ByteString.Lazy as DBL (readFile, writeFile)
  18 import Data.HashMap.Strict (HashMap, lookup)
  19 import GHC.IO (FilePath)
  20 import Gargantext.API.Ngrams.Types (NgramsTerm(..), NgramsRepoElement(..), mSetToList)
  21 import Gargantext.Core.Viz.Graph.Types
  22 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
  23 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
  24 import Gargantext.Prelude
  25 import qualified Data.Aeson   as DA
  26 import qualified Data.Text    as Text
  27 import qualified Text.Read    as Text
  28
  29 -----------------------------------------------------------
  30 graphV3ToGraph :: GraphV3 -> Graph
  31 graphV3ToGraph (GraphV3 links nodes) = Graph { _graph_nodes = map nodeV32node nodes
  32                                              , _graph_edges = zipWith linkV32edge [1..] links
  33                                              , _graph_metadata = Nothing }
  34   where
  35     nodeV32node :: NodeV3 -> Node
  36     nodeV32node (NodeV3 no_id' (AttributesV3 cl') no_s' no_lb')
  37                 = Node { node_size = no_s'
  38                        , node_type = NgramsTerms
  39                        , node_id = cs $ show no_id'
  40                        , node_label = no_lb'
  41                        , node_x_coord = 0
  42                        , node_y_coord = 0
  43                        , node_attributes = Attributes cl'
  44                        , node_children = []
  45                        }
  46
  47     linkV32edge :: Int -> EdgeV3 -> Edge
  48     linkV32edge n (EdgeV3 eo_s' eo_t' eo_w') =
  49       Edge { edge_source = cs $ show eo_s'
  50            , edge_hidden = Just False
  51            , edge_target = cs $ show eo_t'
  52            , edge_weight = (Text.read $ Text.unpack eo_w') :: Double
  53            , edge_confluence = 0.5
  54            , edge_id = cs $ show n }
  55
  56
  57 graphV3ToGraphWithFiles :: FilePath -> FilePath -> IO ()
  58 graphV3ToGraphWithFiles g1 g2 = do
  59   -- GraphV3 <- IO Fichier
  60   graph <- DBL.readFile g1
  61   let newGraph = case DA.decode graph :: Maybe GraphV3 of
  62         Nothing -> panic (Text.pack "no graph")
  63         Just new -> new
  64
  65   DBL.writeFile g2 (DA.encode $ graphV3ToGraph newGraph)
  66
  67 readGraphFromJson :: MonadBase IO m => FilePath -> m (Maybe Graph)
  68 readGraphFromJson fp = do
  69   graph <- liftBase $ DBL.readFile fp
  70   pure $ DA.decode graph
  71
  72
  73 -----------------------------------------------------------
  74 mergeGraphNgrams :: Graph -> Maybe (HashMap NgramsTerm NgramsRepoElement) -> Graph
  75 mergeGraphNgrams g Nothing = g
  76 mergeGraphNgrams graph@(Graph { _graph_nodes }) (Just listNgrams) = set graph_nodes newNodes graph
  77   where
  78     newNodes = insertChildren <$> _graph_nodes
  79     insertChildren (Node { node_label, .. }) = Node { node_children = children', .. }
  80       where
  81         -- lookup (NgramsTerm node_label) in listNgrams, then fetch (NgramsRepoElement _nre_children)
  82         children' = case (lookup (NgramsTerm node_label) listNgrams) of
  83           Nothing  -> []
  84           Just (NgramsRepoElement { _nre_children }) -> unNgramsTerm <$> mSetToList _nre_children