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