[Merge]

src/Gargantext/API/Admin/Orchestrator/Types.hs

@@ -11,14 +11,16 @@ import Data.Proxy
 import Data.Swagger hiding (URL, url, port)
 import Data.Text (Text)
 import GHC.Generics hiding (to)
-import Gargantext.Core.Types (TODO(..))
-import Gargantext.Prelude
+import Servant
 import Servant.Job.Async
 import Servant.Job.Types
 import Servant.Job.Utils (jsonOptions)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 
+import Gargantext.Core.Types (TODO(..))
+import Gargantext.Prelude
+
 ------------------------------------------------------------------------
 instance Arbitrary a => Arbitrary (JobStatus 'Safe a) where
   arbitrary = panic "TODO"
@@ -126,3 +128,7 @@ instance ToParamSchema Limit -- where
 type ScrapersEnv = JobEnv JobLog JobLog
 
 type ScraperAPI  = AsyncJobsAPI JobLog ScraperInput  JobLog
+
+------------------------------------------------------------------------
+type AsyncJobs event ctI input output =
+  AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output

src/Gargantext/API/Ngrams/List.hs

@@ -22,7 +22,13 @@ import Data.Map (Map, toList, fromList)
 import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema)
 import Data.Text (Text, concat, pack)
 import GHC.Generics (Generic)
-import Gargantext.API.Node.Corpus.New
+import Network.HTTP.Media ((//), (/:))
+import Servant
+import Servant.Job.Async
+import Servant.Job.Utils (jsonOptions)
+import Web.FormUrlEncoded (FromForm)
+
+import Gargantext.Prelude
 import Gargantext.API.Node.Corpus.New.File (FileType(..))
 import Gargantext.API.Ngrams
 import Gargantext.API.Admin.Orchestrator.Types
@@ -31,12 +37,6 @@ import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
 import Gargantext.Database.Action.Flow (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes)
-import Gargantext.Prelude
-import Network.HTTP.Media ((//), (/:))
-import Servant
-import Servant.Job.Async
-import Servant.Job.Utils (jsonOptions)
-import Web.FormUrlEncoded (FromForm)
 
 ------------------------------------------------------------------------
 type NgramsList = (Map NgramsType (Versioned NgramsTableMap))

src/Gargantext/API/Node.hs

@@ -150,6 +150,7 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "unpublish" :> Share.Unpublish
 
              :<|> "file"      :> FileApi
+             :<|> "async"     :> FileAsyncApi
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
@@ -228,6 +229,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> Share.unPublish id'
 
            :<|> fileApi uId id'
+           :<|> fileAsyncApi uId id'
 
 
 ------------------------------------------------------------------------

src/Gargantext/API/Node/Contact.hs

@@ -29,12 +29,12 @@ import Data.Maybe (Maybe(..))
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Settings (HasSettings)
 import Gargantext.API.Node
-import Gargantext.API.Node.Corpus.New (AsyncJobs)
 import Gargantext.API.Prelude (GargServer, simuLogs)
 import Gargantext.Core (Lang(..))
+import Gargantext.Core.Text.Terms (TermType(..))
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Flow (flow)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
@@ -42,7 +42,6 @@ import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire(..), Hyperda
 import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude (($), liftBase, (.), printDebug, pure)
-import Gargantext.Core.Text.Terms (TermType(..))
 import Servant
 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
 import Test.QuickCheck (elements)

src/Gargantext/API/Node/Corpus/Annuaire.hs

@@ -19,18 +19,19 @@ import Data.Aeson
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.Core (Lang(..))
-import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
-import Gargantext.Database.Action.Flow (FlowCmdM)  -- flowAnnuaire
-import Gargantext.Database.Admin.Types.Node (AnnuaireId)
-import Gargantext.Prelude
 import Servant
 import Servant.Job.Core
 import Servant.Job.Types
 import Servant.Job.Utils (jsonOptions)
 import Web.FormUrlEncoded (FromForm)
+
 import qualified Gargantext.API.Node.Corpus.New.File as NewFile
+import Gargantext.API.Admin.Orchestrator.Types hiding (AsyncJobs)
+import Gargantext.Core (Lang(..))
+import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
+import Gargantext.Database.Action.Flow (FlowCmdM)  -- flowAnnuaire
+import Gargantext.Database.Admin.Types.Node (AnnuaireId)
+import Gargantext.Prelude
 
 
 type Api = Summary "New Annuaire endpoint"

src/Gargantext/API/Node/Corpus/New.hs

@@ -14,7 +14,6 @@ New corpus means either:
 
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE TypeOperators      #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Gargantext.API.Node.Corpus.New
       where
@@ -22,30 +21,25 @@ module Gargantext.API.Node.Corpus.New
 import Control.Lens hiding (elements, Empty)
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Base64 as BSB64
 import Data.Either
 import Data.Maybe (fromMaybe)
 import Data.Swagger
 import Data.Text (Text)
 import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
 import GHC.Generics (Generic)
 import Servant
-import Servant.Job.Core
-import Servant.Job.Types
 import Servant.Job.Utils (jsonOptions)
 -- import Servant.Multipart
 -- import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
-import Web.FormUrlEncoded          (FromForm)
 
 import Gargantext.Prelude
 
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import qualified Gargantext.API.Admin.Orchestrator.Types as T
 import Gargantext.API.Admin.Settings (HasSettings)
 import Gargantext.API.Node.Corpus.New.File
+import Gargantext.API.Node.Types
 import Gargantext.Core (Lang(..){-, allLangs-})
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
@@ -163,49 +157,6 @@ instance FromJSON WithQuery where
 instance ToSchema WithQuery where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wq_")
 
--------------------------------------------------------
-data NewWithForm = NewWithForm
-  { _wf_filetype :: !FileType
-  , _wf_data     :: !Text
-  , _wf_lang     :: !(Maybe Lang)
-  , _wf_name     :: !Text
-  } deriving (Eq, Show, Generic)
-
-makeLenses ''NewWithForm
-instance FromForm NewWithForm
-instance FromJSON NewWithForm where
-  parseJSON = genericParseJSON $ jsonOptions "_wf_"
-instance ToSchema NewWithForm where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
-
--------------------------------------------------------
-data NewWithFile = NewWithFile
-  { _wfi_b64_data :: !Text
-  , _wfi_lang     :: !(Maybe Lang)
-  , _wfi_name     :: !Text
-  } deriving (Eq, Show, Generic)
-
-makeLenses ''NewWithFile
-instance FromForm NewWithFile
-instance FromJSON NewWithFile where
-  parseJSON = genericParseJSON $ jsonOptions "_wfi_"
-instance ToSchema NewWithFile where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wfi_")
-
-instance GPU.SaveFile NewWithFile where
-  saveFile' fp (NewWithFile b64d _ _) = do
-    let eDecoded = BSB64.decode $ TE.encodeUtf8 b64d
-    case eDecoded of
-      Left err -> panic $ T.pack $ "Error decoding: " <> err
-      Right decoded -> BS.writeFile fp decoded
-    -- BS.writeFile fp $ BSB64.decodeLenient $ TE.encodeUtf8 b64d
-
---instance GPU.ReadFile NewWithFile where
---  readFile' = TIO.readFile
-
-------------------------------------------------------------------------
-type AsyncJobs event ctI input output =
-  AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output
 ------------------------------------------------------------------------
 
 type AddWithQuery = Summary "Add with Query to corpus endpoint"

src/Gargantext/API/Node/Corpus/New/File.hs

@@ -26,11 +26,7 @@ import Data.Monoid (mempty)
 import Data.Swagger
 import Data.Text (Text())
 import GHC.Generics (Generic)
-import Gargantext.API.Ngrams (TODO)
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude -- (Cmd, CmdM)
-import Gargantext.Prelude
-import Gargantext.Prelude.Crypto.Hash (hash)
+
 import Servant
 import Servant.Multipart
 import Servant.Swagger (HasSwagger(toSwagger))
@@ -38,6 +34,12 @@ import Servant.Swagger.Internal
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
+import Gargantext.API.Ngrams (TODO)
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude -- (Cmd, CmdM)
+import Gargantext.Prelude
+import Gargantext.Prelude.Crypto.Hash (hash)
+
 -------------------------------------------------------------
 type Hash = Text
 data FileType = CSV

src/Gargantext/API/Node/File.hs

@@ -18,17 +18,25 @@ import qualified Network.HTTP.Media as M
 import Network.Wai.Application.Static
 import Servant
 import Servant.API.Raw (Raw)
+import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+import Servant.Job.Core
+import Servant.Job.Types
+import Servant.Job.Utils (jsonOptions)
 import Servant.Server.Internal
 
 import Gargantext.Prelude
 import qualified Gargantext.Prelude.Utils as GPU
 
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Settings (HasSettings)
+import Gargantext.API.Node.Types
 import Gargantext.API.Prelude
 import Gargantext.Database.Action.Flow.Types
+import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Types.Hyperdata.File
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node (getNodeWith)
+import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 
 data RESPONSE deriving Typeable
@@ -89,3 +97,55 @@ fileDownload uId nId = do
   -- let settings = embeddedSettings [("", "hello")]
   -- Tagged $ staticApp settings
 
+type FileAsyncApi = Summary "File Async Api"
+                 :> "file"
+                 :> "add"
+                 :> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
+
+fileAsyncApi :: UserId -> NodeId -> GargServer FileAsyncApi
+fileAsyncApi uId nId =
+  serveJobsAPI $
+    JobFunction (\i l ->
+      let
+        log' x = do
+          printDebug "addWithFile" x
+          liftBase $ l x
+      in addWithFile uId nId i log')
+
+
+addWithFile :: (HasSettings env, FlowCmdM env err m)
+            => UserId
+            -> NodeId
+            -> NewWithFile
+            -> (JobLog -> m ())
+            -> m JobLog
+addWithFile uId nId nwf@(NewWithFile _d _l fName) logStatus = do
+
+  printDebug "[addWithFile] Uploading file: " nId
+  logStatus JobLog { _scst_succeeded = Just 0
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 1
+                   , _scst_events    = Just []
+                   }
+
+  fPath <- GPU.writeFile nwf
+  printDebug "[addWithFile] File saved as: " fPath
+
+  nIds <- mkNodeWithParent NodeFile (Just nId) uId fName
+
+  _ <- case nIds of
+    [nId'] -> do
+        node <- getNodeWith nId' (Proxy :: Proxy HyperdataFile)
+        let hl = node ^. node_hyperdata
+        _ <- updateHyperdata nId' $ hl { _hff_name = fName
+                                       , _hff_path = pack fPath }
+
+        printDebug "[addWithFile] Created node with id: " nId'
+    _     -> pure ()
+
+  printDebug "[addWithFile] File upload finished: " nId
+  pure $ JobLog { _scst_succeeded = Just 1
+                , _scst_failed    = Just 0
+                , _scst_remaining = Just 0
+                , _scst_events    = Just []
+                }

src/Gargantext/API/Node/New.hs

@@ -30,8 +30,7 @@ import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 import Web.FormUrlEncoded          (FromForm)
 
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
-import Gargantext.API.Node.Corpus.New (AsyncJobs)
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Prelude
 import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Action.Node

src/Gargantext/API/Node/Types.hs

+{-# LANGUAGE TemplateHaskell    #-}
+
+module Gargantext.API.Node.Types where
+
+import Control.Lens hiding (elements, Empty)
+import Data.Aeson
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as BSB64
+import Data.Either
+import Data.Swagger
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import GHC.Generics (Generic)
+import Servant.Job.Utils (jsonOptions)
+import Web.FormUrlEncoded          (FromForm)
+
+import Gargantext.Core (Lang(..){-, allLangs-})
+import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
+import Gargantext.Prelude
+import qualified Gargantext.Prelude.Utils as GPU
+import Gargantext.API.Node.Corpus.New.File (FileType)
+
+-------------------------------------------------------
+data NewWithForm = NewWithForm
+  { _wf_filetype :: !FileType
+  , _wf_data     :: !Text
+  , _wf_lang     :: !(Maybe Lang)
+  , _wf_name     :: !Text
+  } deriving (Eq, Show, Generic)
+
+makeLenses ''NewWithForm
+instance FromForm NewWithForm
+instance FromJSON NewWithForm where
+  parseJSON = genericParseJSON $ jsonOptions "_wf_"
+instance ToSchema NewWithForm where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
+
+-------------------------------------------------------
+
+data NewWithFile = NewWithFile
+  { _wfi_b64_data :: !Text
+  , _wfi_lang     :: !(Maybe Lang)
+  , _wfi_name     :: !Text
+  } deriving (Eq, Show, Generic)
+
+makeLenses ''NewWithFile
+instance FromForm NewWithFile
+instance FromJSON NewWithFile where
+  parseJSON = genericParseJSON $ jsonOptions "_wfi_"
+instance ToSchema NewWithFile where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wfi_")
+
+instance GPU.SaveFile NewWithFile where
+  saveFile' fp (NewWithFile b64d _ _) = do
+    let eDecoded = BSB64.decode $ TE.encodeUtf8 b64d
+    case eDecoded of
+      Left err -> panic $ T.pack $ "Error decoding: " <> err
+      Right decoded -> BS.writeFile fp decoded
+    -- BS.writeFile fp $ BSB64.decodeLenient $ TE.encodeUtf8 b64d
+
+--instance GPU.ReadFile NewWithFile where
+--  readFile' = TIO.readFile

src/Gargantext/API/Node/Update.hs

@@ -20,24 +20,21 @@ import Data.Aeson
 import Data.Maybe (Maybe(..))
 import Data.Swagger
 import GHC.Generics (Generic)
-import Gargantext.Prelude
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Settings (HasSettings)
-import Gargantext.API.Node.Corpus.New (AsyncJobs)
 import Gargantext.API.Prelude (GargServer, simuLogs)
+import Gargantext.Core.Viz.Graph.API (recomputeGraph)
+import Gargantext.Core.Viz.Graph.Distances (GraphMetric(..), Distance(..))
 import Gargantext.Database.Action.Flow.Pairing (pairing)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure)
-import Gargantext.Core.Viz.Graph.API (recomputeGraph)
-import Gargantext.Core.Viz.Graph.Distances (GraphMetric(..), Distance(..))
+import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure, show, cs, (<>), panic)
 import Prelude (Enum, Bounded, minBound, maxBound)
 import Servant
 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 
-
 ------------------------------------------------------------------------
 type API = Summary " Update node according to NodeType params"
          :> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog

src/Gargantext/API/Prelude.hs

@@ -33,6 +33,10 @@ import Crypto.JOSE.Error as Jose
 import Data.Aeson.Types
 import Data.Typeable
 import Data.Validity
+import Servant
+import Servant.Job.Async
+import Servant.Job.Core (HasServerError(..), serverError)
+
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Admin.Settings
 import Gargantext.API.Ngrams
@@ -41,9 +45,6 @@ import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
 import Gargantext.Database.Query.Tree
 import Gargantext.Prelude
-import Servant
-import Servant.Job.Async (HasJobEnv)
-import Servant.Job.Core (HasServerError(..), serverError)
 
 class HasJoseError e where
   _JoseError :: Prism' e Jose.Error

src/Gargantext/API/Routes.hs

@@ -24,6 +24,7 @@ module Gargantext.API.Routes
       where
 ---------------------------------------------------------------------
 
+-- import qualified Gargantext.API.Search as Search
 import Control.Concurrent (threadDelay)
 import Data.Text (Text)
 import Data.Validity
@@ -33,29 +34,27 @@ import Gargantext.API.Count  (CountAPI, count, Query)
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableDoc)
 import Gargantext.API.Node
 import Gargantext.API.Prelude
--- import qualified Gargantext.API.Search as Search
 import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Core.Viz.Graph.API
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Admin.Types.Node (NodeId, CorpusId, AnnuaireId)
 import Gargantext.Prelude
-import Gargantext.Core.Viz.Graph.API
 import Servant
 import Servant.Auth as SA
 import Servant.Auth.Swagger ()
 import Servant.Job.Async
 import Servant.Swagger.UI
 import qualified Gargantext.API.Ngrams.List           as List
+import qualified Gargantext.API.Node.Contact          as Contact
 import qualified Gargantext.API.Node.Corpus.Annuaire  as Annuaire
 import qualified Gargantext.API.Node.Corpus.Export    as Export
 import qualified Gargantext.API.Node.Corpus.New       as New
 import qualified Gargantext.API.Public                as Public
-import qualified Gargantext.API.Node.Contact          as Contact
 
 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
 -- | TODO          :<|> Summary "Latest API" :> GargAPI'
 
-
 type GargAPIVersion = "v1.0"
                    :> Summary "Garg API Version "
                    :> GargAPI'

src/Gargantext/Core/Text/Metrics/TFICF.hs

@@ -23,12 +23,12 @@ module Gargantext.Core.Text.Metrics.TFICF ( TFICF
                                      )
   where
 
+import Data.Map.Strict (Map, toList)
 import Data.Text (Text)
-import Gargantext.Prelude
 import Gargantext.Core.Types (Ordering(..))
-import Data.Map.Strict (Map, toList)
-import qualified Data.Ord as DO (Down(..))
+import Gargantext.Prelude
 import qualified Data.List as List
+import qualified Data.Ord as DO (Down(..))
 
 path :: Text
 path = "[G.T.Metrics.TFICF]"

src/Gargantext/Core/Viz/Graph.hs

@@ -20,17 +20,19 @@ import Control.Lens (makeLenses)
 import Data.ByteString.Lazy as DBL (readFile, writeFile)
 import Data.Text (Text, pack)
 import GHC.IO (FilePath)
-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.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
 
+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.Prelude
+
 
 data TypeNode = Terms | Unknown
   deriving (Show, Generic)
@@ -97,12 +99,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 +125,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 +161,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 +196,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

src/Gargantext/Database/Action/Metrics/NgramsByNode.hs

@@ -24,6 +24,12 @@ import Data.Tuple.Extra (second, swap)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Debug.Trace (trace)
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified Data.Text as Text
+import qualified Database.PostgreSQL.Simple as DPS
+
 import Gargantext.Core (Lang(..))
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
@@ -31,11 +37,6 @@ import Gargantext.Database.Prelude (Cmd, runPGSQuery)
 import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..))
 import Gargantext.Prelude
 import Gargantext.Core.Text.Terms.Mono.Stem (stem)
-import qualified Data.List as List
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
-import qualified Data.Text as Text
-import qualified Database.PostgreSQL.Simple as DPS
 
 -- | TODO: group with 2 terms only can be
 -- discussed. Main purpose of this is offering

src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs

@@ -17,12 +17,13 @@ module Gargantext.Database.Admin.Trigger.NodeNodeNgrams
   where
 
 import Database.PostgreSQL.Simple.SqlQQ (sql)
+import qualified Database.PostgreSQL.Simple as DPS
+
 import Gargantext.Core.Types.Main (listTypeId, ListType(CandidateTerm))
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
 import Gargantext.Database.Prelude (Cmd, execPGSQuery)
 import Gargantext.Prelude
-import qualified Database.PostgreSQL.Simple as DPS
 
 triggerCountInsert :: Cmd err Int64
 triggerCountInsert = execPGSQuery query (nodeTypeId NodeDocument, nodeTypeId NodeList)

src/Gargantext/Database/Admin/Trigger/Nodes.hs

@@ -17,11 +17,12 @@ module Gargantext.Database.Admin.Trigger.Nodes
   where
 
 import Database.PostgreSQL.Simple.SqlQQ (sql)
+import qualified Database.PostgreSQL.Simple as DPS
+
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
 import Gargantext.Database.Prelude (Cmd, execPGSQuery)
 import Gargantext.Prelude
-import qualified Database.PostgreSQL.Simple as DPS
 
 
 triggerSearchUpdate :: Cmd err Int64

src/Gargantext/Database/Prelude.hs

@@ -84,12 +84,14 @@ mkCmd k = do
   withResource pool (liftBase . k)
 
 runCmd :: (HasConnectionPool env)
-       => env -> Cmd' env err a
+       => env
+       -> Cmd' env err a
        -> IO (Either err a)
 runCmd env m = runExceptT $ runReaderT m env
 
 runOpaQuery :: Default FromFields fields haskells
-            => Select fields -> Cmd err [haskells]
+            => Select fields
+            -> Cmd err [haskells]
 runOpaQuery q = mkCmd $ \c -> runQuery c q
 
 runCountOpaQuery :: Select a -> Cmd err Int

src/Gargantext/Database/Query/Table/Node.hs

@@ -15,6 +15,7 @@ Portability : POSIX
 {-# LANGUAGE Arrows                 #-}
 {-# LANGUAGE ConstraintKinds        #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE TemplateHaskell        #-}
 {-# LANGUAGE TypeFamilies           #-}
 
@@ -26,7 +27,13 @@ import Control.Lens (set, view)
 import Data.Aeson
 import Data.Maybe (Maybe(..), fromMaybe, maybe)
 import Data.Text (Text)
+import qualified Database.PostgreSQL.Simple as DPS
+import Database.PostgreSQL.Simple.SqlQQ (sql)
 import GHC.Int (Int64)
+import Opaleye hiding (FromField)
+import Opaleye.Internal.QueryArr (Query)
+import Prelude hiding (null, id, map, sum)
+
 import Gargantext.Core.Types
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata
@@ -37,9 +44,6 @@ import Gargantext.Database.Query.Filter (limit', offset')
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (sum, head)
-import Opaleye hiding (FromField)
-import Opaleye.Internal.QueryArr (Query)
-import Prelude hiding (null, id, map, sum)
 
 
 queryNodeSearchTable :: Query NodeSearchRead
@@ -107,6 +111,31 @@ getNodesWithParentId n = runOpaQuery $ selectNodesWithParentID n'
       Just n'' -> n''
       Nothing  -> 0
 
+
+-- | Given a node id, find it's closest parent of given type
+-- NOTE: This isn't too optimal: can make successive queries depending on how
+-- deeply nested the child is.
+getClosestParentIdByType :: NodeId
+                         -> NodeType
+                         -> Cmd err (Maybe NodeId)
+getClosestParentIdByType nId nType = do
+  result <- runPGSQuery query (nId, 0 :: Int)
+  case result of
+    [DPS.Only parentId, DPS.Only pTypename] -> do
+      if nodeTypeId nType == pTypename then
+        pure $ Just $ NodeId parentId
+      else
+        getClosestParentIdByType (NodeId parentId) nType
+    _ -> pure Nothing
+  where
+    query :: DPS.Query
+    query = [sql|
+      SELECT n2.id, n2.typename
+        FROM nodes n1
+        JOIN nodes n2 ON n1.parent_id = n2.id
+        WHERE n1.id = ? AND 0 = ?;
+    |]
+
 ------------------------------------------------------------------------
 getDocumentsV3WithParentId :: NodeId -> Cmd err [Node HyperdataDocumentV3]
 getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)