[FIX] bug invitation
[gargantext.git] / src / Gargantext / Core / Viz / Graph.hs
index c328cc5a96f8d3c9ea2a499ddccfa2e8ea15d403..4417f4be2962b59062f6aa8d3210d38506e2c871 100644 (file)
@@ -16,20 +16,19 @@ Portability : POSIX
 module Gargantext.Core.Viz.Graph
   where
 
-import Control.Lens (makeLenses)
 import Data.ByteString.Lazy as DBL (readFile, writeFile)
-import Data.Text (Text, pack)
+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.Core.Types (ListId)
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
 import Gargantext.Database.Admin.Types.Node (NodeId)
-import Gargantext.Core.Viz.Graph.Distances (GraphMetric)
+import Gargantext.Core.Methods.Distances (GraphMetric)
 import Gargantext.Prelude
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-import qualified Data.Aeson as DA
-import qualified Data.Text as T
-import qualified Text.Read as T
 
 
 data TypeNode = Terms | Unknown
@@ -97,12 +96,13 @@ makeLenses ''ListForGraph
 
 --
 data GraphMetadata =
-  GraphMetadata { _gm_title    :: Text          -- title of the graph
-                , _gm_metric   :: GraphMetric
-                , _gm_corpusId :: [NodeId]      -- we can map with different corpus
-                , _gm_legend   :: [LegendField] -- legend of the Graph
-                , _gm_list     :: ListForGraph
-                -- , _gm_version  :: Int
+  GraphMetadata { _gm_title            :: Text          -- title of the graph
+                , _gm_metric           :: GraphMetric
+                , _gm_corpusId         :: [NodeId]      -- we can map with different corpus
+                , _gm_legend           :: [LegendField] -- legend of the Graph
+                , _gm_list             :: ListForGraph
+                , _gm_startForceAtlas  :: Bool
+                -- , _gm_version       :: Int
                 }
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "_gm_") ''GraphMetadata)
@@ -122,7 +122,7 @@ makeLenses ''Graph
 instance ToSchema Graph where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_graph_")
 
--- | Intances for the mack
+-- | Intances for the mock
 instance Arbitrary Graph where
   arbitrary = elements $ [defaultGraph]
 
@@ -158,15 +158,28 @@ data GraphV3 = GraphV3 { go_links :: [EdgeV3]
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "go_") ''GraphV3)
 
+-----------------------------------------------------------
+data Camera = Camera { _camera_ratio :: Double
+                     , _camera_x     :: Double
+                     , _camera_y     :: Double }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "_camera_") ''Camera)
+makeLenses ''Camera
+
+instance ToSchema Camera where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_camera_")
 
 -----------------------------------------------------------
 data HyperdataGraph =
   HyperdataGraph { _hyperdataGraph :: !(Maybe Graph)
+                 , _hyperdataCamera :: !(Maybe Camera)
                  } deriving (Show, Generic)
-$(deriveJSON (unPrefix "") ''HyperdataGraph)
+$(deriveJSON (unPrefix "_") ''HyperdataGraph)
+instance ToSchema HyperdataGraph where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_")
 
 defaultHyperdataGraph :: HyperdataGraph 
-defaultHyperdataGraph = HyperdataGraph Nothing
+defaultHyperdataGraph = HyperdataGraph Nothing Nothing
 
 
 instance Hyperdata HyperdataGraph
@@ -180,6 +193,23 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataGraph
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
+-----------------------------------------------------------
+-- This type is used to return graph via API
+-- hyperdataGraphAPI field is not a Maybe anymore – graph is always computed
+data HyperdataGraphAPI =
+  HyperdataGraphAPI { _hyperdataAPIGraph  :: Graph
+                    , _hyperdataAPICamera :: !(Maybe Camera)
+                    } deriving (Show, Generic)
+$(deriveJSON (unPrefix "_hyperdataAPI") ''HyperdataGraphAPI)
+instance ToSchema HyperdataGraphAPI where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hyperdataAPI")
+
+makeLenses ''HyperdataGraphAPI
+
+instance FromField HyperdataGraphAPI
+  where
+    fromField = fromField'
+
 -----------------------------------------------------------
 graphV3ToGraph :: GraphV3 -> Graph
 graphV3ToGraph (GraphV3 links nodes) = Graph (map nodeV32node nodes) (zipWith linkV32edge [1..] links) Nothing