src/Gargantext/Viz/Graph.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 {-# LANGUAGE NoImplicitPrelude #-}
  13 {-# LANGUAGE TemplateHaskell   #-}
  14 {-# LANGUAGE DeriveGeneric     #-}
  15
  16 module Gargantext.Viz.Graph
  17   where
  18
  19 import GHC.IO (FilePath)
  20 import GHC.Generics (Generic)
  21 import Data.Aeson.TH (deriveJSON)
  22 import qualified Data.Aeson as DA
  23
  24 import Data.ByteString.Lazy as DBL (readFile, writeFile)
  25
  26 import Data.Text (Text)
  27 import qualified Text.Read as T
  28 import qualified Data.Text as T
  29
  30 import Data.Map (Map)
  31
  32 import Gargantext.Prelude
  33 import Gargantext.Core.Utils.Prefix (unPrefix)
  34
  35 import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode)
  36
  37
  38 data TypeNode = Terms | Unknown
  39   deriving (Show, Generic)
  40
  41 $(deriveJSON (unPrefix "") ''TypeNode)
  42
  43 data Attributes = Attributes { clust_default :: Int }
  44   deriving (Show, Generic)
  45 $(deriveJSON (unPrefix "") ''Attributes)
  46
  47 data Node = Node { node_size  :: Int
  48                  , node_type  :: TypeNode
  49                  , node_id    :: Text
  50                  , node_label :: Text
  51                  , node_attributes :: Attributes
  52                  }
  53   deriving (Show, Generic)
  54 $(deriveJSON (unPrefix "node_") ''Node)
  55
  56 data Edge = Edge { edge_source :: Text
  57                  , edge_target :: Text
  58                  , edge_weight :: Double
  59                  , edge_id     :: Text
  60                  }
  61   deriving (Show, Generic)
  62 $(deriveJSON (unPrefix "edge_") ''Edge)
  63
  64 data Graph = Graph { graph_nodes :: [Node]
  65                    , graph_edges :: [Edge]
  66                    }
  67   deriving (Show, Generic)
  68 $(deriveJSON (unPrefix "graph_") ''Graph)
  69 -----------------------------------------------------------
  70 -- Old Gargantext Version
  71
  72 data AttributesOld = AttributesOld { cl :: Int }
  73   deriving (Show, Generic)
  74 $(deriveJSON (unPrefix "") ''AttributesOld)
  75
  76 data NodeOld = NodeOld { no_id :: Int
  77                    , no_at :: AttributesOld
  78                    , no_s :: Int
  79                    , no_lb :: Text
  80                    }
  81   deriving (Show, Generic)
  82 $(deriveJSON (unPrefix "no_") ''NodeOld)
  83
  84 data EdgeOld = EdgeOld { eo_s :: Int
  85                  , eo_t :: Int
  86                  , eo_w :: Text
  87                  }
  88   deriving (Show, Generic)
  89 $(deriveJSON (unPrefix "eo_") ''EdgeOld)
  90
  91 data GraphOld = GraphOld {
  92                            go_links :: [EdgeOld]
  93                          , go_nodes :: [NodeOld]
  94                    }
  95   deriving (Show, Generic)
  96 $(deriveJSON (unPrefix "go_") ''GraphOld)
  97
  98 ----------------------------------------------------------
  99
 100
 101 graphOld2graph :: GraphOld -> Graph
 102 graphOld2graph (GraphOld links nodes) = Graph (map nodeOld2node nodes) (zipWith linkOld2edge [1..] links)
 103   where
 104     nodeOld2node :: NodeOld -> Node
 105     nodeOld2node (NodeOld no_id' (AttributesOld cl') no_s' no_lb')
 106                 = Node no_s' Terms (cs $ show no_id') no_lb' (Attributes cl')
 107
 108     linkOld2edge :: Int -> EdgeOld -> Edge
 109     linkOld2edge n (EdgeOld eo_s' eo_t' eo_w') = Edge (cs $ show eo_s') (cs $ show eo_t') ((T.read $ T.unpack eo_w') :: Double) (cs $ show n)
 110
 111
 112 graphOld2graphWithFiles :: FilePath -> FilePath -> IO ()
 113 graphOld2graphWithFiles g1 g2 = do
 114   graph <- DBL.readFile g1
 115   let newGraph = case DA.decode graph :: Maybe GraphOld of
 116         Nothing -> panic (T.pack "no graph")
 117         Just new -> new
 118
 119   DBL.writeFile g2 (DA.encode $ graphOld2graph newGraph)
 120
 121