{-|
Module      : Gargantext.Core.Viz.Graph
Description : Graph utils
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TemplateHaskell      #-}

module Gargantext.Core.Viz.Graph
  where

import Data.ByteString.Lazy as DBL (readFile, writeFile)
import Data.HashMap.Strict (HashMap, lookup)
import Data.Text (pack)
import GHC.IO (FilePath)

import qualified Data.Aeson as DA
import qualified Data.Text as T
import qualified Text.Read as T

import Gargantext.API.Ngrams.Types (NgramsTerm(..), NgramsRepoElement(..), mSetToList)
import Gargantext.Core.Methods.Distances (GraphMetric)
import Gargantext.Core.Types (ListId)
import Gargantext.Database.Admin.Types.Hyperdata.Prelude
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Prelude


data TypeNode = Terms | Unknown
  deriving (Int -> TypeNode -> ShowS
[TypeNode] -> ShowS
TypeNode -> String
(Int -> TypeNode -> ShowS)
-> (TypeNode -> String) -> ([TypeNode] -> ShowS) -> Show TypeNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeNode] -> ShowS
$cshowList :: [TypeNode] -> ShowS
show :: TypeNode -> String
$cshow :: TypeNode -> String
showsPrec :: Int -> TypeNode -> ShowS
$cshowsPrec :: Int -> TypeNode -> ShowS
Show, (forall x. TypeNode -> Rep TypeNode x)
-> (forall x. Rep TypeNode x -> TypeNode) -> Generic TypeNode
forall x. Rep TypeNode x -> TypeNode
forall x. TypeNode -> Rep TypeNode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeNode x -> TypeNode
$cfrom :: forall x. TypeNode -> Rep TypeNode x
Generic)

instance ToJSON TypeNode
instance FromJSON TypeNode
instance ToSchema TypeNode

data Attributes = Attributes { Attributes -> Int
clust_default :: Int }
  deriving (Int -> Attributes -> ShowS
[Attributes] -> ShowS
Attributes -> String
(Int -> Attributes -> ShowS)
-> (Attributes -> String)
-> ([Attributes] -> ShowS)
-> Show Attributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attributes] -> ShowS
$cshowList :: [Attributes] -> ShowS
show :: Attributes -> String
$cshow :: Attributes -> String
showsPrec :: Int -> Attributes -> ShowS
$cshowsPrec :: Int -> Attributes -> ShowS
Show, (forall x. Attributes -> Rep Attributes x)
-> (forall x. Rep Attributes x -> Attributes) -> Generic Attributes
forall x. Rep Attributes x -> Attributes
forall x. Attributes -> Rep Attributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attributes x -> Attributes
$cfrom :: forall x. Attributes -> Rep Attributes x
Generic)
$(deriveJSON (unPrefix "") ''Attributes)
instance ToSchema Attributes

data Node = Node { Node -> Int
node_size  :: Int
                 , Node -> TypeNode
node_type  :: TypeNode -- TODO NgramsType | Person
                 , Node -> Text
node_id    :: Text     -- TODO NgramId
                 , Node -> Text
node_label :: Text
                 , Node -> Double
node_x_coord :: Double
                 , Node -> Double
node_y_coord :: Double
                 , Node -> Attributes
node_attributes :: Attributes
                 , Node -> [Text]
node_children :: [Text]
                 }
  deriving (Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show, (forall x. Node -> Rep Node x)
-> (forall x. Rep Node x -> Node) -> Generic Node
forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node x -> Node
$cfrom :: forall x. Node -> Rep Node x
Generic)
$(deriveJSON (unPrefix "node_") ''Node)
instance ToSchema Node where
  declareNamedSchema :: Proxy Node -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy Node -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"node_")


data Edge = Edge { Edge -> Text
edge_source :: Text
                 , Edge -> Text
edge_target :: Text
                 , Edge -> Double
edge_weight :: Double
                 , Edge -> Double
edge_confluence :: Double
                 , Edge -> Text
edge_id     :: Text
                 }
  deriving (Int -> Edge -> ShowS
[Edge] -> ShowS
Edge -> String
(Int -> Edge -> ShowS)
-> (Edge -> String) -> ([Edge] -> ShowS) -> Show Edge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Edge] -> ShowS
$cshowList :: [Edge] -> ShowS
show :: Edge -> String
$cshow :: Edge -> String
showsPrec :: Int -> Edge -> ShowS
$cshowsPrec :: Int -> Edge -> ShowS
Show, (forall x. Edge -> Rep Edge x)
-> (forall x. Rep Edge x -> Edge) -> Generic Edge
forall x. Rep Edge x -> Edge
forall x. Edge -> Rep Edge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Edge x -> Edge
$cfrom :: forall x. Edge -> Rep Edge x
Generic)

$(deriveJSON (unPrefix "edge_") ''Edge)

instance ToSchema Edge where
  declareNamedSchema :: Proxy Edge -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy Edge -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"edge_")

---------------------------------------------------------------
data LegendField = LegendField { LegendField -> Int
_lf_id :: Int
                               , LegendField -> Text
_lf_color :: Text
                               , LegendField -> Text
_lf_label :: Text
   } deriving (Int -> LegendField -> ShowS
[LegendField] -> ShowS
LegendField -> String
(Int -> LegendField -> ShowS)
-> (LegendField -> String)
-> ([LegendField] -> ShowS)
-> Show LegendField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LegendField] -> ShowS
$cshowList :: [LegendField] -> ShowS
show :: LegendField -> String
$cshow :: LegendField -> String
showsPrec :: Int -> LegendField -> ShowS
$cshowsPrec :: Int -> LegendField -> ShowS
Show, (forall x. LegendField -> Rep LegendField x)
-> (forall x. Rep LegendField x -> LegendField)
-> Generic LegendField
forall x. Rep LegendField x -> LegendField
forall x. LegendField -> Rep LegendField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LegendField x -> LegendField
$cfrom :: forall x. LegendField -> Rep LegendField x
Generic)
$(deriveJSON (unPrefix "_lf_") ''LegendField)

instance ToSchema LegendField where
  declareNamedSchema :: Proxy LegendField -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy LegendField -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"_lf_")

makeLenses ''LegendField
---------------------------------------------------------------
type Version = Int
data ListForGraph =
  ListForGraph { ListForGraph -> ListId
_lfg_listId  :: ListId
               , ListForGraph -> Int
_lfg_version :: Version
               } deriving (Int -> ListForGraph -> ShowS
[ListForGraph] -> ShowS
ListForGraph -> String
(Int -> ListForGraph -> ShowS)
-> (ListForGraph -> String)
-> ([ListForGraph] -> ShowS)
-> Show ListForGraph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListForGraph] -> ShowS
$cshowList :: [ListForGraph] -> ShowS
show :: ListForGraph -> String
$cshow :: ListForGraph -> String
showsPrec :: Int -> ListForGraph -> ShowS
$cshowsPrec :: Int -> ListForGraph -> ShowS
Show, (forall x. ListForGraph -> Rep ListForGraph x)
-> (forall x. Rep ListForGraph x -> ListForGraph)
-> Generic ListForGraph
forall x. Rep ListForGraph x -> ListForGraph
forall x. ListForGraph -> Rep ListForGraph x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListForGraph x -> ListForGraph
$cfrom :: forall x. ListForGraph -> Rep ListForGraph x
Generic)
$(deriveJSON (unPrefix "_lfg_") ''ListForGraph)

instance ToSchema ListForGraph where
  declareNamedSchema :: Proxy ListForGraph -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy ListForGraph -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"_lfg_")

makeLenses ''ListForGraph

--
data GraphMetadata =
  GraphMetadata { GraphMetadata -> Text
_gm_title            :: Text          -- title of the graph
                , GraphMetadata -> GraphMetric
_gm_metric           :: GraphMetric
                , GraphMetadata -> [ListId]
_gm_corpusId         :: [NodeId]      -- we can map with different corpus
                , GraphMetadata -> [LegendField]
_gm_legend           :: [LegendField] -- legend of the Graph
                , GraphMetadata -> ListForGraph
_gm_list             :: ListForGraph
                , GraphMetadata -> Bool
_gm_startForceAtlas  :: Bool
                -- , _gm_version       :: Int
                }
  deriving (Int -> GraphMetadata -> ShowS
[GraphMetadata] -> ShowS
GraphMetadata -> String
(Int -> GraphMetadata -> ShowS)
-> (GraphMetadata -> String)
-> ([GraphMetadata] -> ShowS)
-> Show GraphMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphMetadata] -> ShowS
$cshowList :: [GraphMetadata] -> ShowS
show :: GraphMetadata -> String
$cshow :: GraphMetadata -> String
showsPrec :: Int -> GraphMetadata -> ShowS
$cshowsPrec :: Int -> GraphMetadata -> ShowS
Show, (forall x. GraphMetadata -> Rep GraphMetadata x)
-> (forall x. Rep GraphMetadata x -> GraphMetadata)
-> Generic GraphMetadata
forall x. Rep GraphMetadata x -> GraphMetadata
forall x. GraphMetadata -> Rep GraphMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GraphMetadata x -> GraphMetadata
$cfrom :: forall x. GraphMetadata -> Rep GraphMetadata x
Generic)
$(deriveJSON (unPrefix "_gm_") ''GraphMetadata)
instance ToSchema GraphMetadata where
  declareNamedSchema :: Proxy GraphMetadata -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy GraphMetadata -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"_gm_")
makeLenses ''GraphMetadata


data Graph = Graph { Graph -> [Node]
_graph_nodes    :: [Node]
                   , Graph -> [Edge]
_graph_edges    :: [Edge]
                   , Graph -> Maybe GraphMetadata
_graph_metadata :: Maybe GraphMetadata
                   }
  deriving (Int -> Graph -> ShowS
[Graph] -> ShowS
Graph -> String
(Int -> Graph -> ShowS)
-> (Graph -> String) -> ([Graph] -> ShowS) -> Show Graph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Graph] -> ShowS
$cshowList :: [Graph] -> ShowS
show :: Graph -> String
$cshow :: Graph -> String
showsPrec :: Int -> Graph -> ShowS
$cshowsPrec :: Int -> Graph -> ShowS
Show, (forall x. Graph -> Rep Graph x)
-> (forall x. Rep Graph x -> Graph) -> Generic Graph
forall x. Rep Graph x -> Graph
forall x. Graph -> Rep Graph x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Graph x -> Graph
$cfrom :: forall x. Graph -> Rep Graph x
Generic)
$(deriveJSON (unPrefix "_graph_") ''Graph)
makeLenses ''Graph

instance ToSchema Graph where
  declareNamedSchema :: Proxy Graph -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy Graph -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"_graph_")

-- | Intances for the mock
instance Arbitrary Graph where
  arbitrary :: Gen Graph
arbitrary = [Graph] -> Gen Graph
forall a. [a] -> Gen a
elements ([Graph] -> Gen Graph) -> [Graph] -> Gen Graph
forall a b. (a -> b) -> a -> b
$ [Graph
defaultGraph]

defaultGraph :: Graph
defaultGraph :: Graph
defaultGraph = Graph :: [Node] -> [Edge] -> Maybe GraphMetadata -> Graph
Graph {_graph_nodes :: [Node]
_graph_nodes = [Node :: Int
-> TypeNode
-> Text
-> Text
-> Double
-> Double
-> Attributes
-> [Text]
-> Node
Node {node_x_coord :: Double
node_x_coord=Double
0, node_y_coord :: Double
node_y_coord=Double
0, node_size :: Int
node_size = Int
4, node_type :: TypeNode
node_type = TypeNode
Terms, node_id :: Text
node_id = String -> Text
pack String
"0", node_label :: Text
node_label = String -> Text
pack String
"animal", node_attributes :: Attributes
node_attributes = Attributes :: Int -> Attributes
Attributes {clust_default :: Int
clust_default = Int
0}, node_children :: [Text]
node_children = []},Node :: Int
-> TypeNode
-> Text
-> Text
-> Double
-> Double
-> Attributes
-> [Text]
-> Node
Node {node_x_coord :: Double
node_x_coord=Double
0, node_y_coord :: Double
node_y_coord=Double
0, node_size :: Int
node_size = Int
3, node_type :: TypeNode
node_type = TypeNode
Terms, node_id :: Text
node_id = String -> Text
pack String
"1", node_label :: Text
node_label = String -> Text
pack String
"bird", node_attributes :: Attributes
node_attributes = Attributes :: Int -> Attributes
Attributes {clust_default :: Int
clust_default = Int
0}, node_children :: [Text]
node_children = []},Node :: Int
-> TypeNode
-> Text
-> Text
-> Double
-> Double
-> Attributes
-> [Text]
-> Node
Node {node_x_coord :: Double
node_x_coord=Double
0, node_y_coord :: Double
node_y_coord=Double
0, node_size :: Int
node_size = Int
2, node_type :: TypeNode
node_type = TypeNode
Terms, node_id :: Text
node_id = String -> Text
pack String
"2", node_label :: Text
node_label = String -> Text
pack String
"boy", node_attributes :: Attributes
node_attributes = Attributes :: Int -> Attributes
Attributes {clust_default :: Int
clust_default = Int
1}, node_children :: [Text]
node_children = []},Node :: Int
-> TypeNode
-> Text
-> Text
-> Double
-> Double
-> Attributes
-> [Text]
-> Node
Node {node_x_coord :: Double
node_x_coord=Double
0, node_y_coord :: Double
node_y_coord=Double
0, node_size :: Int
node_size = Int
2, node_type :: TypeNode
node_type = TypeNode
Terms, node_id :: Text
node_id = String -> Text
pack String
"3", node_label :: Text
node_label = String -> Text
pack String
"dog", node_attributes :: Attributes
node_attributes = Attributes :: Int -> Attributes
Attributes {clust_default :: Int
clust_default = Int
0}, node_children :: [Text]
node_children = []},Node :: Int
-> TypeNode
-> Text
-> Text
-> Double
-> Double
-> Attributes
-> [Text]
-> Node
Node {node_x_coord :: Double
node_x_coord=Double
0, node_y_coord :: Double
node_y_coord=Double
0, node_size :: Int
node_size = Int
2, node_type :: TypeNode
node_type = TypeNode
Terms, node_id :: Text
node_id = String -> Text
pack String
"4", node_label :: Text
node_label = String -> Text
pack String
"girl", node_attributes :: Attributes
node_attributes = Attributes :: Int -> Attributes
Attributes {clust_default :: Int
clust_default = Int
1}, node_children :: [Text]
node_children = []},Node :: Int
-> TypeNode
-> Text
-> Text
-> Double
-> Double
-> Attributes
-> [Text]
-> Node
Node {node_x_coord :: Double
node_x_coord=Double
0, node_y_coord :: Double
node_y_coord=Double
0, node_size :: Int
node_size = Int
4, node_type :: TypeNode
node_type = TypeNode
Terms, node_id :: Text
node_id = String -> Text
pack String
"5", node_label :: Text
node_label = String -> Text
pack String
"human body", node_attributes :: Attributes
node_attributes = Attributes :: Int -> Attributes
Attributes {clust_default :: Int
clust_default = Int
1}, node_children :: [Text]
node_children = []},Node :: Int
-> TypeNode
-> Text
-> Text
-> Double
-> Double
-> Attributes
-> [Text]
-> Node
Node {node_x_coord :: Double
node_x_coord=Double
0, node_y_coord :: Double
node_y_coord=Double
0, node_size :: Int
node_size = Int
3, node_type :: TypeNode
node_type = TypeNode
Terms, node_id :: Text
node_id = String -> Text
pack String
"6", node_label :: Text
node_label = String -> Text
pack String
"object", node_attributes :: Attributes
node_attributes = Attributes :: Int -> Attributes
Attributes {clust_default :: Int
clust_default = Int
2}, node_children :: [Text]
node_children = []},Node :: Int
-> TypeNode
-> Text
-> Text
-> Double
-> Double
-> Attributes
-> [Text]
-> Node
Node {node_x_coord :: Double
node_x_coord=Double
0, node_y_coord :: Double
node_y_coord=Double
0, node_size :: Int
node_size = Int
2, node_type :: TypeNode
node_type = TypeNode
Terms, node_id :: Text
node_id = String -> Text
pack String
"7", node_label :: Text
node_label = String -> Text
pack String
"pen", node_attributes :: Attributes
node_attributes = Attributes :: Int -> Attributes
Attributes {clust_default :: Int
clust_default = Int
2}, node_children :: [Text]
node_children = []},Node :: Int
-> TypeNode
-> Text
-> Text
-> Double
-> Double
-> Attributes
-> [Text]
-> Node
Node {node_x_coord :: Double
node_x_coord=Double
0, node_y_coord :: Double
node_y_coord=Double
0, node_size :: Int
node_size = Int
2, node_type :: TypeNode
node_type = TypeNode
Terms, node_id :: Text
node_id = String -> Text
pack String
"8", node_label :: Text
node_label = String -> Text
pack String
"table", node_attributes :: Attributes
node_attributes = Attributes :: Int -> Attributes
Attributes {clust_default :: Int
clust_default = Int
2}, node_children :: [Text]
node_children = []}], _graph_edges :: [Edge]
_graph_edges = [Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"0", edge_target :: Text
edge_target = String -> Text
pack String
"0", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"0"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"1", edge_target :: Text
edge_target = String -> Text
pack String
"0", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"1"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"1", edge_target :: Text
edge_target = String -> Text
pack String
"1", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"2"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"2", edge_target :: Text
edge_target = String -> Text
pack String
"2", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"3"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"2", edge_target :: Text
edge_target = String -> Text
pack String
"5", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"4"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"3", edge_target :: Text
edge_target = String -> Text
pack String
"0", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"5"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"3", edge_target :: Text
edge_target = String -> Text
pack String
"1", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"6"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"3", edge_target :: Text
edge_target = String -> Text
pack String
"3", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"7"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"4", edge_target :: Text
edge_target = String -> Text
pack String
"4", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"8"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"4", edge_target :: Text
edge_target = String -> Text
pack String
"5", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"9"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"5", edge_target :: Text
edge_target = String -> Text
pack String
"5", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"10"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"6", edge_target :: Text
edge_target = String -> Text
pack String
"6", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"11"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"7", edge_target :: Text
edge_target = String -> Text
pack String
"6", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"12"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"7", edge_target :: Text
edge_target = String -> Text
pack String
"7", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"13"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"8", edge_target :: Text
edge_target = String -> Text
pack String
"6", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"14"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"8", edge_target :: Text
edge_target = String -> Text
pack String
"7", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"15"},Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge {edge_source :: Text
edge_source = String -> Text
pack String
"8", edge_target :: Text
edge_target = String -> Text
pack String
"8", edge_weight :: Double
edge_weight = Double
1.0, edge_confluence :: Double
edge_confluence=Double
0.5, edge_id :: Text
edge_id = String -> Text
pack String
"16"}], _graph_metadata :: Maybe GraphMetadata
_graph_metadata = Maybe GraphMetadata
forall a. Maybe a
Nothing}


-----------------------------------------------------------
-- V3 Gargantext Version

data AttributesV3 = AttributesV3 { AttributesV3 -> Int
cl :: Int }
  deriving (Int -> AttributesV3 -> ShowS
[AttributesV3] -> ShowS
AttributesV3 -> String
(Int -> AttributesV3 -> ShowS)
-> (AttributesV3 -> String)
-> ([AttributesV3] -> ShowS)
-> Show AttributesV3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributesV3] -> ShowS
$cshowList :: [AttributesV3] -> ShowS
show :: AttributesV3 -> String
$cshow :: AttributesV3 -> String
showsPrec :: Int -> AttributesV3 -> ShowS
$cshowsPrec :: Int -> AttributesV3 -> ShowS
Show, (forall x. AttributesV3 -> Rep AttributesV3 x)
-> (forall x. Rep AttributesV3 x -> AttributesV3)
-> Generic AttributesV3
forall x. Rep AttributesV3 x -> AttributesV3
forall x. AttributesV3 -> Rep AttributesV3 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributesV3 x -> AttributesV3
$cfrom :: forall x. AttributesV3 -> Rep AttributesV3 x
Generic)
$(deriveJSON (unPrefix "") ''AttributesV3)

data NodeV3 = NodeV3 { NodeV3 -> Int
no_id :: Int
                     , NodeV3 -> AttributesV3
no_at :: AttributesV3
                     , NodeV3 -> Int
no_s  :: Int
                     , NodeV3 -> Text
no_lb :: Text
                     }
  deriving (Int -> NodeV3 -> ShowS
[NodeV3] -> ShowS
NodeV3 -> String
(Int -> NodeV3 -> ShowS)
-> (NodeV3 -> String) -> ([NodeV3] -> ShowS) -> Show NodeV3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeV3] -> ShowS
$cshowList :: [NodeV3] -> ShowS
show :: NodeV3 -> String
$cshow :: NodeV3 -> String
showsPrec :: Int -> NodeV3 -> ShowS
$cshowsPrec :: Int -> NodeV3 -> ShowS
Show, (forall x. NodeV3 -> Rep NodeV3 x)
-> (forall x. Rep NodeV3 x -> NodeV3) -> Generic NodeV3
forall x. Rep NodeV3 x -> NodeV3
forall x. NodeV3 -> Rep NodeV3 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NodeV3 x -> NodeV3
$cfrom :: forall x. NodeV3 -> Rep NodeV3 x
Generic)
$(deriveJSON (unPrefix "no_") ''NodeV3)

data EdgeV3 = EdgeV3 { EdgeV3 -> Int
eo_s :: Int
                     , EdgeV3 -> Int
eo_t :: Int
                     , EdgeV3 -> Text
eo_w :: Text
                     }
  deriving (Int -> EdgeV3 -> ShowS
[EdgeV3] -> ShowS
EdgeV3 -> String
(Int -> EdgeV3 -> ShowS)
-> (EdgeV3 -> String) -> ([EdgeV3] -> ShowS) -> Show EdgeV3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EdgeV3] -> ShowS
$cshowList :: [EdgeV3] -> ShowS
show :: EdgeV3 -> String
$cshow :: EdgeV3 -> String
showsPrec :: Int -> EdgeV3 -> ShowS
$cshowsPrec :: Int -> EdgeV3 -> ShowS
Show, (forall x. EdgeV3 -> Rep EdgeV3 x)
-> (forall x. Rep EdgeV3 x -> EdgeV3) -> Generic EdgeV3
forall x. Rep EdgeV3 x -> EdgeV3
forall x. EdgeV3 -> Rep EdgeV3 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EdgeV3 x -> EdgeV3
$cfrom :: forall x. EdgeV3 -> Rep EdgeV3 x
Generic)
$(deriveJSON (unPrefix "eo_") ''EdgeV3)

data GraphV3 = GraphV3 { GraphV3 -> [EdgeV3]
go_links :: [EdgeV3]
                       , GraphV3 -> [NodeV3]
go_nodes :: [NodeV3]
                       }
  deriving (Int -> GraphV3 -> ShowS
[GraphV3] -> ShowS
GraphV3 -> String
(Int -> GraphV3 -> ShowS)
-> (GraphV3 -> String) -> ([GraphV3] -> ShowS) -> Show GraphV3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphV3] -> ShowS
$cshowList :: [GraphV3] -> ShowS
show :: GraphV3 -> String
$cshow :: GraphV3 -> String
showsPrec :: Int -> GraphV3 -> ShowS
$cshowsPrec :: Int -> GraphV3 -> ShowS
Show, (forall x. GraphV3 -> Rep GraphV3 x)
-> (forall x. Rep GraphV3 x -> GraphV3) -> Generic GraphV3
forall x. Rep GraphV3 x -> GraphV3
forall x. GraphV3 -> Rep GraphV3 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GraphV3 x -> GraphV3
$cfrom :: forall x. GraphV3 -> Rep GraphV3 x
Generic)
$(deriveJSON (unPrefix "go_") ''GraphV3)

-----------------------------------------------------------
data Camera = Camera { Camera -> Double
_camera_ratio :: Double
                     , Camera -> Double
_camera_x     :: Double
                     , Camera -> Double
_camera_y     :: Double }
  deriving (Int -> Camera -> ShowS
[Camera] -> ShowS
Camera -> String
(Int -> Camera -> ShowS)
-> (Camera -> String) -> ([Camera] -> ShowS) -> Show Camera
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Camera] -> ShowS
$cshowList :: [Camera] -> ShowS
show :: Camera -> String
$cshow :: Camera -> String
showsPrec :: Int -> Camera -> ShowS
$cshowsPrec :: Int -> Camera -> ShowS
Show, (forall x. Camera -> Rep Camera x)
-> (forall x. Rep Camera x -> Camera) -> Generic Camera
forall x. Rep Camera x -> Camera
forall x. Camera -> Rep Camera x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Camera x -> Camera
$cfrom :: forall x. Camera -> Rep Camera x
Generic)
$(deriveJSON (unPrefix "_camera_") ''Camera)
makeLenses ''Camera

instance ToSchema Camera where
  declareNamedSchema :: Proxy Camera -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy Camera -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"_camera_")

-----------------------------------------------------------
data HyperdataGraph =
  HyperdataGraph { HyperdataGraph -> Maybe Graph
_hyperdataGraph :: !(Maybe Graph)
                 , HyperdataGraph -> Maybe Camera
_hyperdataCamera :: !(Maybe Camera)
                 } deriving (Int -> HyperdataGraph -> ShowS
[HyperdataGraph] -> ShowS
HyperdataGraph -> String
(Int -> HyperdataGraph -> ShowS)
-> (HyperdataGraph -> String)
-> ([HyperdataGraph] -> ShowS)
-> Show HyperdataGraph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HyperdataGraph] -> ShowS
$cshowList :: [HyperdataGraph] -> ShowS
show :: HyperdataGraph -> String
$cshow :: HyperdataGraph -> String
showsPrec :: Int -> HyperdataGraph -> ShowS
$cshowsPrec :: Int -> HyperdataGraph -> ShowS
Show, (forall x. HyperdataGraph -> Rep HyperdataGraph x)
-> (forall x. Rep HyperdataGraph x -> HyperdataGraph)
-> Generic HyperdataGraph
forall x. Rep HyperdataGraph x -> HyperdataGraph
forall x. HyperdataGraph -> Rep HyperdataGraph x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HyperdataGraph x -> HyperdataGraph
$cfrom :: forall x. HyperdataGraph -> Rep HyperdataGraph x
Generic)
$(deriveJSON (unPrefix "_") ''HyperdataGraph)
instance ToSchema HyperdataGraph where
  declareNamedSchema :: Proxy HyperdataGraph -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy HyperdataGraph -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"_")

defaultHyperdataGraph :: HyperdataGraph 
defaultHyperdataGraph :: HyperdataGraph
defaultHyperdataGraph = Maybe Graph -> Maybe Camera -> HyperdataGraph
HyperdataGraph Maybe Graph
forall a. Maybe a
Nothing Maybe Camera
forall a. Maybe a
Nothing


instance Hyperdata HyperdataGraph
makeLenses ''HyperdataGraph

instance FromField HyperdataGraph
  where
    fromField :: FieldParser HyperdataGraph
fromField = FieldParser HyperdataGraph
forall b.
(Typeable b, FromJSON b) =>
Field -> Maybe ByteString -> Conversion b
fromField'

instance DefaultFromField PGJsonb HyperdataGraph
  where
    defaultFromField :: FromField PGJsonb HyperdataGraph
defaultFromField = FromField PGJsonb HyperdataGraph
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fieldQueryRunnerColumn

-----------------------------------------------------------
-- This type is used to return graph via API
-- hyperdataGraphAPI field is not a Maybe anymore – graph is always computed
data HyperdataGraphAPI =
  HyperdataGraphAPI { HyperdataGraphAPI -> Graph
_hyperdataAPIGraph  :: Graph
                    , HyperdataGraphAPI -> Maybe Camera
_hyperdataAPICamera :: !(Maybe Camera)
                    } deriving (Int -> HyperdataGraphAPI -> ShowS
[HyperdataGraphAPI] -> ShowS
HyperdataGraphAPI -> String
(Int -> HyperdataGraphAPI -> ShowS)
-> (HyperdataGraphAPI -> String)
-> ([HyperdataGraphAPI] -> ShowS)
-> Show HyperdataGraphAPI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HyperdataGraphAPI] -> ShowS
$cshowList :: [HyperdataGraphAPI] -> ShowS
show :: HyperdataGraphAPI -> String
$cshow :: HyperdataGraphAPI -> String
showsPrec :: Int -> HyperdataGraphAPI -> ShowS
$cshowsPrec :: Int -> HyperdataGraphAPI -> ShowS
Show, (forall x. HyperdataGraphAPI -> Rep HyperdataGraphAPI x)
-> (forall x. Rep HyperdataGraphAPI x -> HyperdataGraphAPI)
-> Generic HyperdataGraphAPI
forall x. Rep HyperdataGraphAPI x -> HyperdataGraphAPI
forall x. HyperdataGraphAPI -> Rep HyperdataGraphAPI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HyperdataGraphAPI x -> HyperdataGraphAPI
$cfrom :: forall x. HyperdataGraphAPI -> Rep HyperdataGraphAPI x
Generic)
$(deriveJSON (unPrefix "_hyperdataAPI") ''HyperdataGraphAPI)
instance ToSchema HyperdataGraphAPI where
  declareNamedSchema :: Proxy HyperdataGraphAPI -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy HyperdataGraphAPI
-> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"_hyperdataAPI")

makeLenses ''HyperdataGraphAPI

instance FromField HyperdataGraphAPI
  where
    fromField :: FieldParser HyperdataGraphAPI
fromField = FieldParser HyperdataGraphAPI
forall b.
(Typeable b, FromJSON b) =>
Field -> Maybe ByteString -> Conversion b
fromField'

-----------------------------------------------------------
graphV3ToGraph :: GraphV3 -> Graph
graphV3ToGraph :: GraphV3 -> Graph
graphV3ToGraph (GraphV3 [EdgeV3]
links [NodeV3]
nodes) = Graph :: [Node] -> [Edge] -> Maybe GraphMetadata -> Graph
Graph { _graph_nodes :: [Node]
_graph_nodes = (NodeV3 -> Node) -> [NodeV3] -> [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map NodeV3 -> Node
nodeV32node [NodeV3]
nodes
                                             , _graph_edges :: [Edge]
_graph_edges = (Int -> EdgeV3 -> Edge) -> [Int] -> [EdgeV3] -> [Edge]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> EdgeV3 -> Edge
linkV32edge [Int
1..] [EdgeV3]
links
                                             , _graph_metadata :: Maybe GraphMetadata
_graph_metadata = Maybe GraphMetadata
forall a. Maybe a
Nothing }
  where
    nodeV32node :: NodeV3 -> Node
    nodeV32node :: NodeV3 -> Node
nodeV32node (NodeV3 Int
no_id' (AttributesV3 Int
cl') Int
no_s' Text
no_lb')
                = Node :: Int
-> TypeNode
-> Text
-> Text
-> Double
-> Double
-> Attributes
-> [Text]
-> Node
Node { node_size :: Int
node_size = Int
no_s'
                       , node_type :: TypeNode
node_type = TypeNode
Terms
                       , node_id :: Text
node_id = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
no_id'
                       , node_label :: Text
node_label = Text
no_lb'
                       , node_x_coord :: Double
node_x_coord = Double
0
                       , node_y_coord :: Double
node_y_coord = Double
0
                       , node_attributes :: Attributes
node_attributes = Int -> Attributes
Attributes Int
cl'
                       , node_children :: [Text]
node_children = [] }

    linkV32edge :: Int -> EdgeV3 -> Edge
    linkV32edge :: Int -> EdgeV3 -> Edge
linkV32edge Int
n (EdgeV3 Int
eo_s' Int
eo_t' Text
eo_w') =
      Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge { edge_source :: Text
edge_source = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
eo_s'
           , edge_target :: Text
edge_target = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
eo_t'
           , edge_weight :: Double
edge_weight = (String -> Double
forall a. Read a => String -> a
T.read (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
eo_w') :: Double
           , edge_confluence :: Double
edge_confluence = Double
0.5
           , edge_id :: Text
edge_id = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n }


graphV3ToGraphWithFiles :: FilePath -> FilePath -> IO ()
graphV3ToGraphWithFiles :: String -> String -> IO ()
graphV3ToGraphWithFiles String
g1 String
g2 = do
  -- GraphV3 <- IO Fichier
  ByteString
graph <- String -> IO ByteString
DBL.readFile String
g1
  let newGraph :: GraphV3
newGraph = case ByteString -> Maybe GraphV3
forall a. FromJSON a => ByteString -> Maybe a
DA.decode ByteString
graph :: Maybe GraphV3 of
        Maybe GraphV3
Nothing -> Text -> GraphV3
forall a. HasCallStack => Text -> a
panic (String -> Text
T.pack String
"no graph")
        Just GraphV3
new -> GraphV3
new

  String -> ByteString -> IO ()
DBL.writeFile String
g2 (Graph -> ByteString
forall a. ToJSON a => a -> ByteString
DA.encode (Graph -> ByteString) -> Graph -> ByteString
forall a b. (a -> b) -> a -> b
$ GraphV3 -> Graph
graphV3ToGraph GraphV3
newGraph)

readGraphFromJson :: MonadBase IO m => FilePath -> m (Maybe Graph)
readGraphFromJson :: String -> m (Maybe Graph)
readGraphFromJson String
fp = do
  ByteString
graph <- IO ByteString -> m ByteString
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
DBL.readFile String
fp
  Maybe Graph -> m (Maybe Graph)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Graph -> m (Maybe Graph)) -> Maybe Graph -> m (Maybe Graph)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Graph
forall a. FromJSON a => ByteString -> Maybe a
DA.decode ByteString
graph


-----------------------------------------------------------
mergeGraphNgrams :: Graph -> Maybe (HashMap NgramsTerm NgramsRepoElement) -> Graph
mergeGraphNgrams :: Graph -> Maybe (HashMap NgramsTerm NgramsRepoElement) -> Graph
mergeGraphNgrams Graph
g Maybe (HashMap NgramsTerm NgramsRepoElement)
Nothing = Graph
g
mergeGraphNgrams graph :: Graph
graph@(Graph { [Node]
_graph_nodes :: [Node]
_graph_nodes :: Graph -> [Node]
_graph_nodes }) (Just HashMap NgramsTerm NgramsRepoElement
listNgrams) = ASetter Graph Graph [Node] [Node] -> [Node] -> Graph -> Graph
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Graph Graph [Node] [Node]
Lens' Graph [Node]
graph_nodes [Node]
newNodes Graph
graph
  where
    newNodes :: [Node]
newNodes = Node -> Node
insertChildren (Node -> Node) -> [Node] -> [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node]
_graph_nodes
    insertChildren :: Node -> Node
insertChildren (Node { Text
node_label :: Text
node_label :: Node -> Text
node_label, Double
Int
[Text]
Text
Attributes
TypeNode
node_children :: [Text]
node_attributes :: Attributes
node_y_coord :: Double
node_x_coord :: Double
node_id :: Text
node_type :: TypeNode
node_size :: Int
node_children :: Node -> [Text]
node_attributes :: Node -> Attributes
node_y_coord :: Node -> Double
node_x_coord :: Node -> Double
node_id :: Node -> Text
node_type :: Node -> TypeNode
node_size :: Node -> Int
.. }) = Node :: Int
-> TypeNode
-> Text
-> Text
-> Double
-> Double
-> Attributes
-> [Text]
-> Node
Node { node_children :: [Text]
node_children = [Text]
children', Double
Int
Text
Attributes
TypeNode
node_attributes :: Attributes
node_y_coord :: Double
node_x_coord :: Double
node_id :: Text
node_type :: TypeNode
node_size :: Int
node_label :: Text
node_attributes :: Attributes
node_y_coord :: Double
node_x_coord :: Double
node_label :: Text
node_id :: Text
node_type :: TypeNode
node_size :: Int
.. }
      where
        -- lookup (NgramsTerm node_label) in listNgrams, then fetch (NgramsRepoElement _nre_children)
        children' :: [Text]
children' = case (NgramsTerm
-> HashMap NgramsTerm NgramsRepoElement -> Maybe NgramsRepoElement
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup (Text -> NgramsTerm
NgramsTerm Text
node_label) HashMap NgramsTerm NgramsRepoElement
listNgrams) of
          Maybe NgramsRepoElement
Nothing  -> []
          Just (NgramsRepoElement { MSet NgramsTerm
_nre_children :: NgramsRepoElement -> MSet NgramsTerm
_nre_children :: MSet NgramsTerm
_nre_children }) -> NgramsTerm -> Text
unNgramsTerm (NgramsTerm -> Text) -> [NgramsTerm] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MSet NgramsTerm -> [NgramsTerm]
forall a. MSet a -> [a]
mSetToList MSet NgramsTerm
_nre_children