Merge branch 'dev' into dev-doc-table-optimization

bin/build

+#!/bin/bash
+
+stack build # --profile # --test # --haddock

bin/gargantext-adaptative-phylo/Main.hs

@@ -89,16 +89,16 @@ wosToCorpus :: Int -> FilePath -> IO ([(Int,Text)])
 wosToCorpus limit path = do 
       files <- getFilesFromPath path
       take limit
-        <$> map (\d -> let date' = fromJust $ _hyperdataDocument_publication_year d
-                           title = fromJust $ _hyperdataDocument_title d
-                           abstr = if (isJust $ _hyperdataDocument_abstract d)
-                                   then fromJust $ _hyperdataDocument_abstract d
+        <$> map (\d -> let date' = fromJust $ _hd_publication_year d
+                           title = fromJust $ _hd_title d
+                           abstr = if (isJust $ _hd_abstract d)
+                                   then fromJust $ _hd_abstract d
                                    else ""
                         in (date', title <> " " <> abstr)) 
         <$> concat 
         <$> mapConcurrently (\file -> 
-              filter (\d -> (isJust $ _hyperdataDocument_publication_year d)
-                         && (isJust $ _hyperdataDocument_title d))
+              filter (\d -> (isJust $ _hd_publication_year d)
+                         && (isJust $ _hd_title d))
                 <$> parseFile WOS (path <> file) ) files
 
 
@@ -162,10 +162,22 @@ main = do
 
             printIOMsg "End of reconstruction, start the export"
 
-            let dot = toPhyloExport phylo        
+            let dot = toPhyloExport phylo 
+
+            let clq = case (clique config) of
+                        Fis s s' -> "fis_" <> (show s) <> "_" <> (show s')
+                        MaxClique s ->  "clique_" <> (show s)
+
+            let sensibility = case (phyloProximity config) of
+                        Hamming -> undefined
+                        WeightedLogJaccard s -> (show s)                        
 
             let output = (outputPath config) 
                       <> (unpack $ phyloName config)
-                      <> "_V2.dot"
+                      <> "-scale_" <> (show (_qua_granularity $ phyloQuality config))
+                      <> "-level_" <> (show (phyloLevel config))
+                      <> "-" <> clq
+                      <> "-sens_" <> sensibility
+                      <> ".dot"
 
             dotToFile output dot

bin/gargantext-phylo/Main.hs

@@ -132,11 +132,11 @@ csvToCorpus limit csv = DV.toList
 -- | To transform a Wos nfile into a readable corpus
 wosToCorpus :: Limit -> CorpusPath -> IO ([(Int,Text)])
 wosToCorpus limit path = DL.take limit
-                         . map (\d -> ((fromJust $_hyperdataDocument_publication_year d)
-                                    ,(fromJust $_hyperdataDocument_title d) <> " " <> (fromJust $_hyperdataDocument_abstract d)))
-                         . filter (\d -> (isJust $_hyperdataDocument_publication_year d)
-                                      && (isJust $_hyperdataDocument_title d)
-                                      && (isJust $_hyperdataDocument_abstract d))
+                         . map (\d -> ((fromJust $_hd_publication_year d)
+                                    ,(fromJust $_hd_title d) <> " " <> (fromJust $_hd_abstract d)))
+                         . filter (\d -> (isJust $_hd_publication_year d)
+                                      && (isJust $_hd_title d)
+                                      && (isJust $_hd_abstract d))
                          . concat
                          <$> mapConcurrently (\idx -> parseFile WOS (path <> show(idx) <> ".txt")) [1..20]
 

bin/ghci

+stack ghci --profile

bin/install

+#!/bin/bash
+
+stack install #--profile # --test --haddock

package.yaml

 name: gargantext
-version: '0.0.1.6.4'
+version: '0.0.1.7.1'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data
@@ -56,6 +56,7 @@ library:
   - Gargantext.Database.Admin.Types.Hyperdata
   - Gargantext.Database.Admin.Types.Node
   - Gargantext.Prelude
+  - Gargantext.Prelude.Utils
   - Gargantext.Text
   - Gargantext.Text.Context
   - Gargantext.Text.Corpus.Parsers

server

+~/.local/bin/gargantext-server --ini gargantext.ini --run Dev +RTS # -p

src-test/Graph/Distance.hs

+
+{-|
+Module      : Graph.Distance
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Here is a longer description of this module, containing some
+commentary with @some markup@.
+-}
+
+
+module Graph.Distance where
+
+import Test.Hspec
+import Gargantext.Viz.Graph.Distances.Matrice
+import Gargantext.Prelude
+
+test :: IO ()
+test = hspec $ do
+  describe "Cross" $ do
+    let result = cross' $ matrix 3 ([1,1..] :: [Double])
+    it "compare" $ do
+      shouldBe result (matrix 3 ([2,2..] :: [Double]))
+

src-test/Main.hs

@@ -17,6 +17,7 @@ import qualified Ngrams.Lang.Occurrences as Occ
 import qualified Ngrams.Metrics as Metrics
 import qualified Parsers.Date as PD
 import qualified Graph.Distance as GD
+import qualified Utils.Crypto as Crypto
 
 main :: IO ()
 main = do
@@ -25,4 +26,5 @@ main = do
 --    Lang.ngramsExtractionTest EN
 --    Metrics.main
     PD.testFromRFC3339
-    GD.test
+--    GD.test
+    Crypto.test

src-test/Utils/Crypto.hs

+
+{-|
+Module      : Utils.Crypto
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+module Utils.Crypto where
+
+import Data.Text (Text)
+import Test.Hspec
+import Gargantext.Prelude
+import Gargantext.Prelude.Utils
+
+-- | Crypto Hash tests
+test :: IO ()
+test = hspec $ do
+  describe "Hash String with frontend works" $ do
+    let text = "To hash with backend" :: Text
+    let hashed = "8a69a94d164279af2b7d1443ce08da6184b3d7e815406076e148159c284b53c3" :: Hash
+                 -- ^ hash from fronted with text above
+    it "compare" $ do
+      hash text `shouldBe` hashed
+
+  describe "Hash List with backend works" $ do
+    let list = ["a","b"] :: [Text]
+    let hashed = "ab19ec537f09499b26f0f62eed7aefad46ab9f498e06a7328ce8e8ef90da6d86" :: Hash
+                 -- ^ hash from frontend with text above
+    it "compare" $ do
+      hash list `shouldBe` hashed
+
+------------------------------------------------------------------------
+-- | TODO property based tests
+  describe "Hash works with any order of list" $ do
+    let hash1 = hash (["a","b"] :: [Text])
+    let hash2 = hash (["b","a"] :: [Text])
+    it "compare" $ do
+      hash1 `shouldBe` hash2
+

src/Gargantext/API.hs

@@ -76,6 +76,7 @@ import System.IO (FilePath)
 import qualified Data.ByteString.Lazy.Char8 as BL8
 import qualified Data.Text.IO               as T
 import qualified Paths_gargantext           as PG -- cabal magic build module
+import qualified Gargantext.API.Public      as Public
 
 
 data Mode = Dev | Mock | Prod 
@@ -219,7 +220,7 @@ server :: forall env. EnvC env => env -> IO (Server API)
 server env = do
   -- orchestrator <- scrapyOrchestrator env
   pure $  schemaUiServer swaggerDoc
-     :<|> hoistServerWithContext 
+     :<|> hoistServerWithContext
             (Proxy :: Proxy GargAPI)
             (Proxy :: Proxy AuthContext)
             transform
@@ -240,6 +241,8 @@ serverGargAPI -- orchestrator
        =  auth
      :<|> gargVersion
      :<|> serverPrivateGargAPI
+     :<|> Public.api
+
   --   :<|> orchestrator
   where
 

src/Gargantext/API/Admin/Auth.hs

@@ -201,8 +201,7 @@ withAccessM uId (PathNodeNode cId docId) m = do
 
 withAccess :: forall env err m api.
               (GargServerC env err m, HasServer api '[]) =>
-              Proxy api -> Proxy m ->
-              UserId -> PathId ->
+              Proxy api -> Proxy m -> UserId -> PathId ->
               ServerT api m -> ServerT api m
 withAccess p _ uId id = hoistServer p f
   where

src/Gargantext/API/HashedResponse.hs

@@ -2,13 +2,13 @@ module Gargantext.API.HashedResponse where
 
 import Data.Aeson
 import Data.Swagger
-import qualified Data.Digest.Pure.MD5 as DPMD5
-import GHC.Generics (Generic)
-import Protolude
+import Data.Text (Text)
 
-type MD5 = Text
+import Gargantext.Prelude
+import qualified Gargantext.Prelude.Utils as Crypto (hash)
+import GHC.Generics (Generic)
 
-data HashedResponse a = HashedResponse { md5 :: MD5, value :: a }
+data HashedResponse a = HashedResponse { hash :: Text, value :: a }
   deriving (Generic)
 
 instance ToSchema a => ToSchema (HashedResponse a)
@@ -16,6 +16,4 @@ instance ToJSON a => ToJSON (HashedResponse a) where
   toJSON = genericToJSON defaultOptions
 
 constructHashedResponse :: ToJSON a => a -> HashedResponse a
-constructHashedResponse v = HashedResponse { md5 = md5', value = v }
-  where
-    md5' = show $ DPMD5.md5 $ encode v
+constructHashedResponse v = HashedResponse { hash = Crypto.hash $ encode v, value = v }

src/Gargantext/API/Metrics.hs

@@ -20,28 +20,28 @@ module Gargantext.API.Metrics
 
 import Control.Lens
 import Data.Time (UTCTime)
-import Protolude
-import Servant
-import qualified Data.Map as Map
-
+import Data.Text (Text)
 import Gargantext.API.HashedResponse
 import Gargantext.API.Ngrams
 import Gargantext.API.Ngrams.NTree
 import Gargantext.API.Prelude (GargServer)
 import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..))
 import Gargantext.Database.Action.Flow
-import qualified Gargantext.Database.Action.Metrics as Metrics
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..))
 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..))
 import Gargantext.Database.Admin.Types.Node (NodeId)
+import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node (defaultList, getNodeWith)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
-import Gargantext.Database.Prelude
 import Gargantext.Database.Schema.Node (node_hyperdata)
+import Gargantext.Prelude
 import Gargantext.Text.Metrics (Scored(..))
 import Gargantext.Viz.Chart
 import Gargantext.Viz.Types
+import Servant
+import qualified Data.Map as Map
+import qualified Gargantext.Database.Action.Metrics as Metrics
 
 -------------------------------------------------------------
 -- | Scatter metrics API
@@ -55,16 +55,16 @@ type ScatterAPI = Summary "SepGen IncExc metrics"
                   :> QueryParamR "ngramsType" TabType
                   :> QueryParam  "limit"      Int
                   :> Post '[JSON] ()
-              :<|> "md5" :>
-                     Summary "Scatter MD5"
+              :<|> "hash" :>
+                     Summary "Scatter Hash"
                   :> QueryParam  "list"       ListId
                   :> QueryParamR "ngramsType" TabType
-                  :> Get '[JSON] MD5
+                  :> Get '[JSON] Text
 
 scatterApi :: NodeId -> GargServer ScatterAPI
 scatterApi id' = getScatter id'
             :<|> updateScatter id'
-            :<|> getScatterMD5 id'
+            :<|> getScatterHash id'
 
 getScatter :: FlowCmdM env err m =>
   CorpusId
@@ -77,7 +77,7 @@ getScatter cId maybeListId tabType _maybeLimit = do
     Just lid -> pure lid
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let HyperdataList { hd_scatter = mChart } = node ^. node_hyperdata
+  let HyperdataList { _hl_scatter = mChart } = node ^. node_hyperdata
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -116,18 +116,17 @@ updateScatter' cId maybeListId tabType maybeLimit = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
-  _ <- updateHyperdata listId $ hl { hd_scatter = Just $ Metrics metrics }
+  _ <- updateHyperdata listId $ hl { _hl_scatter = Just $ Metrics metrics }
 
   pure $ Metrics metrics
 
-getScatterMD5 :: FlowCmdM env err m =>
+getScatterHash :: FlowCmdM env err m =>
   CorpusId
   -> Maybe ListId
   -> TabType
-  -> m MD5
-getScatterMD5 cId maybeListId tabType = do
-  HashedResponse { md5 = md5' } <- getScatter cId maybeListId tabType Nothing
-  pure md5'
+  -> m Text
+getScatterHash cId maybeListId tabType = do
+  hash <$> getScatter cId maybeListId tabType Nothing
 
 
 -------------------------------------------------------------
@@ -143,16 +142,16 @@ type ChartApi = Summary " Chart API"
                 :> QueryParamR "ngramsType" TabType
                 :> QueryParam  "limit"      Int
                 :> Post '[JSON] ()
-              :<|> "md5" :>
-                     Summary "Chart MD5"
+              :<|> "hash" :>
+                     Summary "Chart Hash"
                   :> QueryParam  "list"       ListId
                   :> QueryParamR "ngramsType" TabType
-                  :> Get '[JSON] MD5
+                  :> Get '[JSON] Text
 
 chartApi :: NodeId -> GargServer ChartApi
 chartApi id' = getChart id'
           :<|> updateChart id'
-          :<|> getChartMD5 id'
+          :<|> getChartHash id'
                
 -- TODO add start / end
 getChart :: FlowCmdM env err m =>
@@ -167,7 +166,7 @@ getChart cId _start _end maybeListId tabType = do
     Just lid -> pure lid
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let HyperdataList { hd_chart = mChart } = node ^. node_hyperdata
+  let HyperdataList { _hl_chart = mChart } = node ^. node_hyperdata
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -199,19 +198,19 @@ updateChart' cId maybeListId _tabType _maybeLimit = do
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
   h <- histoData cId
-  _ <- updateHyperdata listId $ hl { hd_chart = Just $ ChartMetrics h }
+  _ <- updateHyperdata listId $ hl { _hl_chart = Just $ ChartMetrics h }
 
   pure $ ChartMetrics h
 
 
-getChartMD5 :: FlowCmdM env err m =>
+getChartHash :: FlowCmdM env err m =>
   CorpusId
   -> Maybe ListId
   -> TabType
-  -> m MD5
-getChartMD5 cId maybeListId tabType = do
-  HashedResponse { md5 = md5' } <- getChart cId Nothing Nothing maybeListId tabType
-  pure md5'
+  -> m Text
+getChartHash cId maybeListId tabType = do
+  hash <$> getChart cId Nothing Nothing maybeListId tabType
+ 
 -------------------------------------------------------------
 -- | Pie metrics API
 type PieApi = Summary "Pie Chart"
@@ -225,16 +224,16 @@ type PieApi = Summary "Pie Chart"
                 :> QueryParamR "ngramsType" TabType
                 :> QueryParam  "limit"      Int
                 :> Post '[JSON] ()
-              :<|> "md5" :>
-                     Summary "Pie MD5"
+              :<|> "hash" :>
+                     Summary "Pie Hash"
                   :> QueryParam  "list"       ListId
                   :> QueryParamR "ngramsType" TabType
-                  :> Get '[JSON] MD5
+                  :> Get '[JSON] Text
 
 pieApi :: NodeId -> GargServer PieApi
 pieApi id' = getPie id'
         :<|> updatePie id'
-        :<|> getPieMD5 id'
+        :<|> getPieHash id'
 
 getPie :: FlowCmdM env err m
        => CorpusId
@@ -248,7 +247,7 @@ getPie cId _start _end maybeListId tabType = do
     Just lid -> pure lid
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let HyperdataList { hd_pie = mChart } = node ^. node_hyperdata
+  let HyperdataList { _hl_pie = mChart } = node ^. node_hyperdata
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -281,18 +280,18 @@ updatePie' cId maybeListId tabType _maybeLimit = do
   let hl = node ^. node_hyperdata
 
   p <- pieData cId (ngramsTypeFromTabType tabType) MapTerm
-  _ <- updateHyperdata listId $ hl { hd_pie = Just $ ChartMetrics p }
+  _ <- updateHyperdata listId $ hl { _hl_pie = Just $ ChartMetrics p }
 
   pure $ ChartMetrics p
 
-getPieMD5 :: FlowCmdM env err m =>
+getPieHash :: FlowCmdM env err m =>
   CorpusId
   -> Maybe ListId
   -> TabType
-  -> m MD5
-getPieMD5 cId maybeListId tabType = do
-  HashedResponse { md5 = md5' } <- getPie cId Nothing Nothing maybeListId tabType
-  pure md5'
+  -> m Text
+getPieHash cId maybeListId tabType = do
+  hash <$> getPie cId Nothing Nothing maybeListId tabType
+
 -------------------------------------------------------------
 -- | Tree metrics API
 
@@ -308,12 +307,12 @@ type TreeApi = Summary " Tree API"
                 :> QueryParamR "ngramsType" TabType
                 :> QueryParamR "listType"   ListType
                 :> Post '[JSON] ()
-          :<|> "md5" :>
-                  Summary "Tree MD5"
+          :<|> "hash" :>
+                  Summary "Tree Hash"
               :> QueryParam  "list"       ListId
               :> QueryParamR "ngramsType" TabType
               :> QueryParamR "listType"   ListType
-              :> Get '[JSON] MD5
+              :> Get '[JSON] Text
 
                 -- Depending on the Type of the Node, we could post
                 -- New documents for a corpus
@@ -323,7 +322,7 @@ type TreeApi = Summary " Tree API"
 treeApi :: NodeId -> GargServer TreeApi
 treeApi id' = getTree id'
          :<|> updateTree id'
-         :<|> getTreeMD5 id'
+         :<|> getTreeHash id'
 
 getTree :: FlowCmdM env err m
         => CorpusId
@@ -339,7 +338,7 @@ getTree cId _start _end maybeListId tabType listType = do
     Nothing  -> defaultList cId
 
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let HyperdataList { hd_tree = mChart } = node ^. node_hyperdata
+  let HyperdataList { _hl_tree = mChart } = node ^. node_hyperdata
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -372,16 +371,15 @@ updateTree' cId maybeListId tabType listType = do
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
   t <- treeData cId (ngramsTypeFromTabType tabType) listType
-  _ <- updateHyperdata listId $ hl { hd_tree = Just $ ChartMetrics t }
+  _ <- updateHyperdata listId $ hl { _hl_tree = Just $ ChartMetrics t }
 
   pure $ ChartMetrics t
 
-getTreeMD5 :: FlowCmdM env err m =>
+getTreeHash :: FlowCmdM env err m =>
   CorpusId
   -> Maybe ListId
   -> TabType
   -> ListType
-  -> m MD5
-getTreeMD5 cId maybeListId tabType listType = do
-  HashedResponse { md5 = md5' } <- getTree cId Nothing Nothing maybeListId tabType listType
-  pure md5'
+  -> m Text
+getTreeHash cId maybeListId tabType listType = do
+  hash <$> getTree cId Nothing Nothing maybeListId tabType listType

src/Gargantext/API/Ngrams.hs

@@ -116,7 +116,7 @@ import Formatting.Clock (timeSpecs)
 import GHC.Generics (Generic)
 import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, HasInvalidError, assertValid)
 import Gargantext.Core.Types (TODO)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast')
 import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Database.Query.Table.Ngrams hiding (NgramsType(..), ngrams, ngramsType, ngrams_terms)
@@ -200,7 +200,7 @@ instance (Ord a, FromJSON a) => FromJSON (MSet a) where
 
 instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
   -- TODO
-  declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
+  declareNamedSchema _ = wellNamedSchema "" (Proxy :: Proxy TODO)
 
 ------------------------------------------------------------------------
 type NgramsTerm = Text
@@ -492,7 +492,7 @@ instance (Ord a, Arbitrary a) => Arbitrary (PatchMSet a) where
 
 instance ToSchema a => ToSchema (PatchMSet a) where
   -- TODO
-  declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
+  declareNamedSchema _ = wellNamedSchema "" (Proxy :: Proxy TODO)
 
 type instance Patched (PatchMSet a) = MSet a
 
@@ -665,8 +665,8 @@ data Versioned a = Versioned
   deriving (Generic, Show, Eq)
 deriveJSON (unPrefix "_v_") ''Versioned
 makeLenses ''Versioned
-instance ToSchema a => ToSchema (Versioned a) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_v_")
+instance (Typeable a, ToSchema a) => ToSchema (Versioned a) where
+  declareNamedSchema = wellNamedSchema "_v_"
 instance Arbitrary a => Arbitrary (Versioned a) where
   arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
 

src/Gargantext/API/Node.hs

@@ -47,6 +47,7 @@ import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Types.Main (Tree, NodeTree)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
 import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Prelude -- (Cmd, CmdM)
 import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
 import Gargantext.Database.Query.Table.Node
@@ -54,7 +55,6 @@ import Gargantext.Database.Query.Table.Node.Children (getChildren)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
-import Gargantext.Database.Query.Table.Node.User
 import Gargantext.Database.Query.Table.NodeNode
 import Gargantext.Database.Query.Tree (tree, TreeMode(..))
 import Gargantext.Prelude
@@ -144,6 +144,7 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "phylo"     :> PhyloAPI
              -- :<|> "add"       :> NodeAddAPI
              :<|> "move"      :> MoveAPI
+             :<|> "unpublish" :> Share.Unpublish
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
@@ -219,6 +220,8 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> moveNode   (RootId $ NodeId uId) id'
            -- :<|> nodeAddAPI id'
            -- :<|> postUpload id'
+           :<|> Share.unPublish id'
+
 
 ------------------------------------------------------------------------
 data RenameNode = RenameNode { r_name :: Text }

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

@@ -48,7 +48,7 @@ import Gargantext.Database.Query.Table.NodeNode (selectDocNodes)
 import Gargantext.Database.Schema.Node (_node_id, _node_hyperdata)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils (sha)
+import Gargantext.Prelude.Utils (hash)
 
 
 -- Corpus Export
@@ -97,6 +97,7 @@ type API = Summary "Corpus Export"
             :> Get '[JSON] Corpus
 
 --------------------------------------------------
+-- | Hashes are ordered by Set
 getCorpus :: CorpusId
           -> Maybe ListId
           -> Maybe NgramsType
@@ -114,15 +115,14 @@ getCorpus cId lId nt' = do
   repo <- getRepo
   ngs  <- getNodeNgrams cId lId nt repo
   let  -- uniqId is hash computed already for each document imported in database
-    r = Map.intersectionWith (\a b -> Document a (Ngrams (Set.toList b) (ng_hash b)) (d_hash a b)
+    r = Map.intersectionWith (\a b -> Document a (Ngrams (Set.toList b) (hash b)) (d_hash a b)
                              ) ns ngs
           where
-            ng_hash b   = sha $ List.foldl (\x y -> x<>y) "" $ List.sort $ Set.toList b
-            d_hash  a b = sha $ (fromMaybe "" (_hyperdataDocument_uniqId $ _node_hyperdata a))
-                             <> (ng_hash b)
-
-  pure $ Corpus (Map.elems r) (sha $ List.foldl (\a b -> a<>b) ""
-                                   $ List.map _d_hash $ Map.elems r
+            d_hash  a b = hash [ fromMaybe "" (_hd_uniqId $ _node_hyperdata a)
+                                       , hash b
+                                       ]
+  pure $ Corpus (Map.elems r) (hash $ List.map _d_hash
+                                            $ Map.elems r
                               )
 
 getNodeNgrams :: HasNodeError err

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

@@ -30,7 +30,7 @@ import Gargantext.API.Ngrams (TODO)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude -- (Cmd, CmdM)
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils (sha)
+import Gargantext.Prelude.Utils (hash)
 import Servant
 import Servant.Multipart
 import Servant.Swagger (HasSwagger(toSwagger))
@@ -107,6 +107,6 @@ postUpload _ (Just fileType) multipartData = do
     --pure $ cs content
   -- is <- inputs multipartData
 
-  pure $ map (sha . cs) is
+  pure $ map hash is
 
 -------------------------------------------------------------------

src/Gargantext/API/Node/Share.hs

@@ -20,8 +20,10 @@ import Data.Aeson
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
+import Gargantext.API.Prelude
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Action.Share (shareNodeWith)
+import Gargantext.Database.Action.Share (ShareNodeWith(..))
+import Gargantext.Database.Action.Share as DB (shareNodeWith, unPublish)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
@@ -31,28 +33,40 @@ import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 
 ------------------------------------------------------------------------
-data ShareNode = ShareNode { username :: Text }
+data ShareNodeParams = ShareTeamParams   { username :: Text  }
+                     | SharePublicParams { node_id  :: NodeId}
   deriving (Generic)
 ------------------------------------------------------------------------
 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
-instance FromJSON  ShareNode
-instance ToJSON    ShareNode
-instance ToSchema  ShareNode
-instance Arbitrary ShareNode where
-  arbitrary = elements [ ShareNode "user1"
-                       , ShareNode "user2"
+instance FromJSON  ShareNodeParams where
+  parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+instance ToJSON    ShareNodeParams where
+  toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+instance ToSchema  ShareNodeParams
+instance Arbitrary ShareNodeParams where
+  arbitrary = elements [ ShareTeamParams "user1"
+                       , SharePublicParams (NodeId 1)
                        ]
 ------------------------------------------------------------------------
 -- TODO permission
 api :: HasNodeError err
     => NodeId
-    -> ShareNode
+    -> ShareNodeParams
     -> Cmd err Int
-api nId (ShareNode user) =
-  fromIntegral <$> shareNodeWith nId (UserName user)
+api nId (ShareTeamParams user) =
+  fromIntegral <$> DB.shareNodeWith (ShareNodeWith_User NodeFolderShared (UserName user)) nId 
+api nId2 (SharePublicParams nId1) =
+  fromIntegral <$> DB.shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId1) nId2
 
 ------------------------------------------------------------------------
 type API = Summary " Share Node with username"
-         :> ReqBody '[JSON] ShareNode
+         :> ReqBody '[JSON] ShareNodeParams
          :> Post    '[JSON] Int
 
+------------------------------------------------------------------------
+type Unpublish = Summary " Unpublish Node"
+               :> Capture "node_id" NodeId
+               :> Put '[JSON] Int
+
+unPublish :: NodeId -> GargServer Unpublish
+unPublish n = DB.unPublish n

src/Gargantext/API/Public.hs

+{-|
+Module      : Gargantext.API.Public
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Gargantext.API.Public
+      where
+
+import Control.Lens ((^?), (^.), _Just)
+import Data.Maybe (maybe, catMaybes)
+import Data.Tuple (snd)
+import Data.Text (Text)
+import Data.List (replicate, null)
+import Data.Aeson
+import Data.Swagger
+import GHC.Generics (Generic)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
+import Gargantext.Database.Prelude
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Query.Table.NodeNode (selectPublicNodes)
+import Gargantext.Core.Utils.DateUtils (utc2year)
+import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Schema.Node -- (NodePoly(..))
+import Gargantext.Prelude
+import Servant
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+import qualified Data.Map as Map
+
+------------------------------------------------------------------------
+type API = Summary " Public API"
+         :> Get '[JSON] [PublicData]
+
+api :: HasNodeError err
+    => Cmd err [PublicData]
+api = catMaybes <$> map toPublicData <$> filterPublicDatas <$> selectPublic
+
+
+selectPublic :: HasNodeError err
+             => Cmd err [( Node HyperdataFolder, Maybe Int)] 
+selectPublic = selectPublicNodes
+
+  -- | For tests only
+  -- pure $ replicate 6 defaultPublicData
+
+filterPublicDatas :: [( Node HyperdataFolder, Maybe Int)] -> [(Node HyperdataFolder, [NodeId])]
+filterPublicDatas datas = map (\(n,mi) -> let mi' = NodeId <$> mi in
+                                              ( _node_id n, (n, maybe [] (:[]) mi' ))
+                              ) datas
+                        & Map.fromListWith (\(n1,i1) (_n2,i2) -> (n1, i1 <> i2))
+                        & Map.filter (not . null . snd)
+                        & Map.elems
+
+
+toPublicData :: (Node HyperdataFolder, [NodeId]) -> Maybe PublicData
+toPublicData (n , _mn) = PublicData <$> (hd ^? (_Just . hf_data . cf_title))
+                                   <*> (hd ^? (_Just . hf_data . cf_desc))
+                                   <*> Just "images/Gargantextuel-212x300.jpg"
+                                   <*> Just "https://.."
+                                   <*> Just (cs $ show $ utc2year (n^.node_date))
+                                   <*> (hd ^? (_Just . hf_data . cf_query))
+                                   <*> (hd ^? (_Just . hf_data . cf_authors))
+  where
+    hd = head
+       $ filter (\(HyperdataField cd _ _) -> cd == JSON)
+       $ n^. (node_hyperdata . hc_fields)
+
+
+data PublicData = PublicData
+  { title    :: Text
+  , abstract :: Text
+  , img      :: Text
+  , url      :: Text
+  , date     :: Text
+  , database :: Text
+  , author   :: Text
+  } | NoData { nodata:: Text}
+  deriving (Generic)
+
+
+instance FromJSON  PublicData where
+  parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+
+instance ToJSON    PublicData where
+  toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+
+instance ToSchema  PublicData
+instance Arbitrary PublicData where
+  arbitrary = elements
+            $ replicate 6 defaultPublicData 
+
+defaultPublicData :: PublicData
+defaultPublicData =
+  PublicData "Title"
+             (foldl (<>) "" $ replicate 100 "abstract ")
+             "images/Gargantextuel-212x300.jpg"
+             "https://.."
+             "YY/MM/DD"
+             "database"
+             "Author"
+
+
+
+

src/Gargantext/API/Routes.hs

@@ -24,34 +24,33 @@ Portability : POSIX
 module Gargantext.API.Routes
       where
 ---------------------------------------------------------------------
+
 import Control.Concurrent (threadDelay)
 import Data.Text (Text)
 import Data.Validity
-import Servant
-import Servant.Auth as SA
-import Servant.Auth.Swagger ()
-import Servant.Job.Async
-import Servant.Swagger.UI
-
 import Gargantext.API.Admin.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), withAccess, PathId(..))
 import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
-import Gargantext.API.Prelude
 import Gargantext.API.Count  (CountAPI, count, Query)
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableDoc)
 import Gargantext.API.Node
+import Gargantext.API.Prelude
 import Gargantext.API.Search (SearchPairsAPI, searchPairs)
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Query.Table.Node.Contact (HyperdataContact)
 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.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.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.Ngrams.List      as List
-
+import qualified Gargantext.API.Public                as Public
 
 
 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
@@ -75,6 +74,7 @@ type GargAPI' =
                    -- TODO-ACCESS here we want to request a particular header for
            -- auth and capabilities.
           :<|> GargPrivateAPI
+          :<|> "public" :> Public.API
 
 
 type GargPrivateAPI = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
@@ -147,7 +147,7 @@ type GargPrivateAPI' =
                           :> TreeAPI
 
            -- :<|> New.Upload
-           :<|> New.AddWithForm
+           :<|> New.AddWithForm 
            :<|> New.AddWithQuery
 
            -- :<|> "annuaire" :> Annuaire.AddWithForm
@@ -224,8 +224,8 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      :<|> withAccess (Proxy :: Proxy TreeAPI)        Proxy uid
           <$> PathNode <*> treeAPI
      -- TODO access
-     :<|> addCorpusWithForm  (UserDBId uid)
-     :<|> addCorpusWithQuery (RootId   (NodeId uid))
+     :<|> addCorpusWithForm  (RootId (NodeId uid))
+     :<|> addCorpusWithQuery (RootId (NodeId uid))
 
      -- :<|> addAnnuaireWithForm
      -- :<|> New.api  uid -- TODO-SECURITY

src/Gargantext/API/Table.hs

@@ -60,8 +60,8 @@ type TableApi = Summary "Table API"
             :<|> Summary "Table API (POST)"
               :> ReqBody '[JSON] TableQuery
               :> Post    '[JSON] FacetTableResult
-            :<|> "md5" :>
-                   Summary "Table md5"
+            :<|> "hash" :>
+                   Summary "Hash Table"
                 :> QueryParam "tabType" TabType
                 :> Get '[JSON] Text
 
@@ -87,7 +87,7 @@ instance Arbitrary TableQuery where
 tableApi :: NodeId -> GargServer TableApi
 tableApi id' = getTableApi id'
           :<|> postTableApi id'
-          :<|> getTableMd5Api id'
+          :<|> getTableHashApi id'
 
 
 getTableApi :: NodeId -> Maybe TabType -> Cmd err (HashedResponse FacetTableResult)
@@ -103,10 +103,10 @@ postTableApi cId (TableQuery o l order ft q) = case ft of
       Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
       x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
 
-getTableMd5Api :: NodeId -> Maybe TabType -> Cmd err Text
-getTableMd5Api cId tabType = do
-  HashedResponse { md5 = md5' } <- getTableApi cId tabType
-  pure md5'
+getTableHashApi :: NodeId -> Maybe TabType -> Cmd err Text
+getTableHashApi cId tabType = do
+  HashedResponse { hash = h } <- getTableApi cId tabType
+  pure h
 
 searchInCorpus' :: CorpusId
                 -> Bool

src/Gargantext/Core/Flow/Types.hs

@@ -22,7 +22,6 @@ import Gargantext.Text (HasText(..))
 import Gargantext.Core.Types.Main (HashId)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Query.Table.Node.Contact -- (HyperdataContact(..))
 import Gargantext.Database.Schema.Ngrams (Ngrams, NgramsType)
 import Gargantext.Prelude
 
@@ -32,7 +31,7 @@ class UniqId a
 
 instance UniqId HyperdataDocument
   where
-    uniqId = hyperdataDocument_uniqId
+    uniqId = hd_uniqId
 
 instance UniqId HyperdataContact
   where

src/Gargantext/Core/Types.hs

@@ -34,13 +34,13 @@ import Data.Monoid
 import Data.Semigroup
 import Data.Set (Set, empty)
 import Data.Swagger (ToParamSchema)
-import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
+import Data.Swagger (ToSchema(..))
 import Data.Text (Text, unpack)
 import Data.Validity
 import GHC.Generics
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, wellNamedSchema)
 import Gargantext.Prelude
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
@@ -150,8 +150,8 @@ data TableResult a = TableResult { tr_count :: Int
 
 $(deriveJSON (unPrefix "tr_") ''TableResult)
 
-instance ToSchema a => ToSchema (TableResult a) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tr_")
+instance (Typeable a, ToSchema a) => ToSchema (TableResult a) where
+  declareNamedSchema = wellNamedSchema "tr_"
 
 instance Arbitrary a => Arbitrary (TableResult a) where
   arbitrary = TableResult <$> arbitrary <*> arbitrary

src/Gargantext/Core/Types/Individu.hs

@@ -25,7 +25,7 @@ import Gargantext.Prelude hiding (reverse)
 import qualified Gargantext.Core.Auth as Auth
 
 -- FIXME UserName used twice
-data User = UserDBId UserId | UserName Text | RootId NodeId
+data User = UserDBId UserId | UserName Text | RootId NodeId | UserPublic
   deriving (Eq)
 
 type Username = Text

src/Gargantext/Core/Types/Main.hs

@@ -26,7 +26,7 @@ import Data.Monoid ((<>))
 import Data.Swagger
 import Data.Text (Text, unpack)
 import GHC.Generics (Generic)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Admin.Types.Node  -- (NodeType(..), Node, Hyperdata(..))
 import Gargantext.Prelude
 import Prelude (Enum, Bounded, minBound, maxBound)
@@ -98,8 +98,8 @@ data Tree a = TreeN { _tn_node :: a, _tn_children :: [Tree a] }
 
 $(deriveJSON (unPrefix "_tn_") ''Tree)
 
-instance ToSchema a => ToSchema (Tree a) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_tn_")
+instance (Typeable a, ToSchema a) => ToSchema (Tree a) where
+  declareNamedSchema = wellNamedSchema "_tn_"
 
 instance Arbitrary (Tree NodeTree) where
   arbitrary = elements [userTree, userTree]

src/Gargantext/Core/Utils/Prefix.hs

@@ -12,7 +12,10 @@ commentary with @some markup@.
 -}
 
 
-module Gargantext.Core.Utils.Prefix where
+module Gargantext.Core.Utils.Prefix
+  ( module Gargantext.Core.Utils.Prefix
+  , wellNamedSchema
+  ) where
 
 import Prelude
 
@@ -22,6 +25,7 @@ import Data.Aeson.Types (Parser)
 import Data.Char (toLower)
 import Data.Monoid ((<>))
 import Data.Swagger.SchemaOptions (SchemaOptions, fromAesonOptions)
+import Servant.Job.Utils (wellNamedSchema)
 import Text.Read (Read(..),readMaybe)
 
 

src/Gargantext/Database/Action/Delete.hs

@@ -29,7 +29,8 @@ import Gargantext.Prelude
 import qualified Gargantext.Database.Query.Table.Node as N (getNode, deleteNode)
 import Gargantext.Database.Action.Share (delFolderTeam)
 
-deleteNode :: HasNodeError err 
+------------------------------------------------------------------------
+deleteNode :: HasNodeError err
            => User
            -> NodeId
            -> Cmd err Int
@@ -46,3 +47,4 @@ deleteNode u nodeId = do
              else N.deleteNode nodeId
 
 
+

src/Gargantext/Database/Action/Flow.hs

@@ -66,7 +66,6 @@ import Gargantext.Database.Action.Flow.List
 import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Action.Flow.Utils (insertDocNgrams)
 import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.Contact -- (HyperdataContact(..), ContactWho(..))
 import Gargantext.Database.Query.Table.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
 import Gargantext.Database.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
 import Gargantext.Database.Action.Search (searchInDatabase)
@@ -203,11 +202,11 @@ flowCorpusUser l user corpusName ctype ids = do
   -- User Flow
   (userId, _rootId, userCorpusId) <- getOrMk_RootWithCorpus user corpusName ctype
   listId <- getOrMkList userCorpusId userId
-  _cooc  <- mkNode NodeListCooc listId userId
+  _cooc  <- insertDefaultNode NodeListCooc listId userId
   -- TODO: check if present already, ignore
   _ <- Doc.add userCorpusId ids
 
-  _tId <- mkNode NodeTexts userCorpusId userId
+  _tId <- insertDefaultNode NodeTexts userCorpusId userId
   -- printDebug "Node Text Id" tId
 
   -- User List Flow
@@ -218,8 +217,8 @@ flowCorpusUser l user corpusName ctype ids = do
   -- _ <- insertOccsUpdates userCorpusId mastListId
   -- printDebug "userListId" userListId
   -- User Graph Flow
-  _ <- mkDashboard userCorpusId userId
-  _ <- mkGraph  userCorpusId userId
+  _ <- insertDefaultNode NodeDashboard userCorpusId userId
+  _ <- insertDefaultNode NodeGraph     userCorpusId userId
   --_ <- mkPhylo  userCorpusId userId
 
   -- Annuaire Flow
@@ -273,7 +272,7 @@ insertMasterDocs c lang hs  =  do
                        ]
 
   _ <- Doc.add masterCorpusId ids'
-  _cooc <- mkNode NodeListCooc lId masterUserId
+  _cooc <- insertDefaultNode NodeListCooc lId masterUserId
   -- to be removed
   _   <- insertDocNgrams lId indexedNgrams
 
@@ -347,8 +346,8 @@ instance ExtractNgramsT HyperdataContact
 
 instance HasText HyperdataDocument
   where
-    hasText h = catMaybes [ _hyperdataDocument_title    h
-                          , _hyperdataDocument_abstract h
+    hasText h = catMaybes [ _hd_title    h
+                          , _hd_abstract h
                           ]
 
 instance ExtractNgramsT HyperdataDocument
@@ -364,15 +363,15 @@ instance ExtractNgramsT HyperdataDocument
         extractNgramsT' lang' doc = do
           let source    = text2ngrams
                         $ maybe "Nothing" identity
-                        $ _hyperdataDocument_source doc
+                        $ _hd_source doc
 
               institutes = map text2ngrams
                          $ maybe ["Nothing"] (map toSchoolName . (splitOn ", "))
-                         $ _hyperdataDocument_institutes doc
+                         $ _hd_institutes doc
 
               authors    = map text2ngrams
                          $ maybe ["Nothing"] (splitOn ", ")
-                         $ _hyperdataDocument_authors doc
+                         $ _hd_authors doc
 
           terms' <- map text2ngrams
                  <$> map (intercalate " " . _terms_label)

src/Gargantext/Database/Action/Flow/Pairing.hs

@@ -26,7 +26,7 @@ import Gargantext.Database.Action.Flow.Utils
 import Gargantext.Database.Admin.Types.Node (AnnuaireId, CorpusId, ListId{-, DocId, ContactId-})
 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
 import Gargantext.Database.Query.Table.Node.Children (getAllContacts)
-import Gargantext.Database.Query.Table.Node.Contact -- (HyperdataContact(..))
+import Gargantext.Database.Admin.Types.Hyperdata -- (HyperdataContact(..))
 import Gargantext.Database.Schema.Ngrams -- (NgramsType(..))
 import Gargantext.Prelude hiding (sum)
 import Safe (lastMay)

src/Gargantext/Database/Action/Flow/Utils.hs

@@ -40,7 +40,8 @@ getUserId (UserName u  ) = do
   case muser of
     Just user -> pure $ userLight_id user
     Nothing   -> nodeError NoUserFound
-
+getUserId UserPublic = nodeError NoUserFound
+ 
 
 toMaps :: Hyperdata a
        => (a -> Map (NgramsT Ngrams) Int)

src/Gargantext/Database/Action/Learn.hs

@@ -76,8 +76,8 @@ fav2bool ft = if (==) ft IsFav then True else False
 text :: FacetDoc -> Text
 text (FacetDoc _ _ _ h _ _)  = title <> "" <> Text.take 100 abstr
   where
-    title = maybe "" identity (_hyperdataDocument_title    h)
-    abstr = maybe "" identity (_hyperdataDocument_abstract h)
+    title = maybe "" identity (_hd_title    h)
+    abstr = maybe "" identity (_hd_abstract h)
 
 ---------------------------------------------------------------------------
 

src/Gargantext/Database/Action/Node.hs

@@ -26,9 +26,9 @@ import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
-import Gargantext.Database.Query.Table.Node.User
+import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils (sha)
+import Gargantext.Prelude.Utils (hash)
 import Gargantext.Database.Prelude
 import Control.Lens (view)
 import Gargantext.Config (GargConfig(..))
@@ -44,72 +44,64 @@ mkNodeWithParent :: (HasNodeError err)
 mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
 
 ------------------------------------------------------------------------
+-- | MkNode, insert and eventually configure Hyperdata
 mkNodeWithParent NodeUser Nothing uId name =
-  insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId]
+  insertNodesWithParentR Nothing [node NodeUser name defaultHyperdataUser Nothing uId]
 
 mkNodeWithParent _ Nothing _ _ = nodeError HasParent
 ------------------------------------------------------------------------
-mkNodeWithParent NodeFolder (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId]
-    where
-      hd = defaultFolder
-
-mkNodeWithParent NodeFolderPrivate (Just i) uId _ =
-   insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId]
-    where
-      hd = defaultFolder
-
-mkNodeWithParent NodeFolderShared (Just i) uId _ =
-   insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId]
-    where
-      hd = defaultFolder
-
-mkNodeWithParent NodeFolderPublic (Just i) uId _ =
-   insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId]
-    where
-      hd = defaultFolder
-
-mkNodeWithParent NodeTeam (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeTeam name hd Nothing uId]
-    where
-      hd = defaultFolder
-------------------------------------------------------------------------
-mkNodeWithParent NodeCorpus (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId]
-    where
-      hd = defaultCorpus
-
-mkNodeWithParent NodeAnnuaire (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId]
-    where
-      hd = defaultAnnuaire
-
-mkNodeWithParent NodeList (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeList name hd Nothing uId]
-    where
-      hd = defaultAnnuaire
-
-mkNodeWithParent NodeGraph (Just i) uId _name =
-   insertNodesWithParentR (Just i) [node NodeGraph "Graph" hd Nothing uId]
-    where
-      hd = arbitraryGraph
-
-mkNodeWithParent NodeFrameWrite (Just i) uId name = do
-  config <- view hasConfig
-  let
-    u = _gc_frame_write_url config
-    s = _gc_secretkey config
-    hd = HyperdataFrame u (sha $ s <> (cs $ show i))
-  insertNodesWithParentR (Just i) [node NodeFrameWrite name hd Nothing uId]
-
-mkNodeWithParent NodeFrameCalc (Just i) uId name = do
-  config <- view hasConfig
-  let
-    u = _gc_frame_calc_url config
-    s = _gc_secretkey config
-    hd = HyperdataFrame u (sha $ s <> (cs $ show i))
-
-  insertNodesWithParentR (Just i) [node NodeFrameCalc name hd Nothing uId]
-
-mkNodeWithParent _ _ _ _       = nodeError NotImplYet
+mkNodeWithParent NodeFrameWrite i u n =
+  mkNodeWithParent_ConfigureHyperdata NodeFrameWrite i u n
+
+mkNodeWithParent NodeFrameCalc i u n =
+  mkNodeWithParent_ConfigureHyperdata NodeFrameCalc i u n
+
+mkNodeWithParent nt (Just pId) uId name  = insertNode nt (Just name) Nothing pId uId
+-- mkNodeWithParent _ _ _ _ = errorWith "[G.D.A.Node.mkNodeWithParent] nees parent"
+
+
+-- | Sugar to create a node, get its NodeId and update its Hyperdata after
+mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err)
+                                    => NodeType
+                                    -> Maybe ParentId
+                                    -> UserId
+                                    -> Name
+                                    -> Cmd err [NodeId]
+mkNodeWithParent_ConfigureHyperdata NodeFrameWrite (Just i) uId name =
+  mkNodeWithParent_ConfigureHyperdata' NodeFrameWrite (Just i) uId name
+
+mkNodeWithParent_ConfigureHyperdata NodeFrameCalc (Just i) uId name =
+  mkNodeWithParent_ConfigureHyperdata' NodeFrameCalc (Just i) uId name
+
+mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
+
+
+-- | Function not exposed
+mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err)
+                                    => NodeType
+                                    -> Maybe ParentId
+                                    -> UserId
+                                    -> Name
+                                    -> Cmd err [NodeId]
+mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
+  maybeNodeId <- case nt of
+     NodeFrameWrite -> insertNode NodeFrameWrite (Just name) Nothing i uId
+     NodeFrameCalc  -> insertNode NodeFrameCalc  (Just name) Nothing i uId
+     _              -> nodeError NeedsConfiguration
+
+  case maybeNodeId of
+    []  -> nodeError (DoesNotExist i)
+    [n] -> do
+      config <- view hasConfig
+      u <- case nt of
+            NodeFrameWrite -> pure $ _gc_frame_write_url config
+            NodeFrameCalc  -> pure $ _gc_frame_calc_url  config
+            _              -> nodeError NeedsConfiguration
+      let
+        s = _gc_secretkey config
+        hd = HyperdataFrame u (hash $ s <> (cs $ show n))
+      _ <- updateHyperdata n hd
+      pure [n]
+    (_:_:_)  -> nodeError MkNode
+mkNodeWithParent_ConfigureHyperdata' _ _ _ _ = nodeError HasParent
 

src/Gargantext/Database/Action/Share.hs

@@ -9,55 +9,88 @@ Portability : POSIX
 
 -}
 
+
 module Gargantext.Database.Action.Share
   where
 
 import Control.Lens (view)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Flow.Utils (getUserId)
-import Gargantext.Database.Admin.Config (hasNodeType)
+import Gargantext.Database.Admin.Config (hasNodeType, isInNodeTypes)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny(..))
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Node (getNode, getNodesWith)
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError, errorWith)
 import Gargantext.Database.Query.Table.NodeNode (insertNodeNode, deleteNodeNode)
 import Gargantext.Database.Query.Tree.Root (getRootId)
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
 import Gargantext.Prelude
 
+-- | TODO move in Config of Gargantext
+publicNodeTypes :: [NodeType]
+publicNodeTypes = [NodeDashboard, NodeGraph, NodePhylo]
+
+------------------------------------------------------------------------
+
+data ShareNodeWith = ShareNodeWith_User { snwu_nodetype :: NodeType
+                                        , snwu_user    :: User }
+                   | ShareNodeWith_Node { snwn_nodetype :: NodeType
+                                        , snwn_node_id :: NodeId
+                                        }
+
 ------------------------------------------------------------------------
 shareNodeWith :: HasNodeError err
-              => NodeId
-              -> User
+              => ShareNodeWith
+              -> NodeId
               -> Cmd err Int64
-shareNodeWith n u = do
+shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
   nodeToCheck <- getNode   n
   userIdCheck <- getUserId u
   if not (hasNodeType nodeToCheck NodeTeam)
-    then panic "Can share node Team only"
-    else if (view node_userId nodeToCheck == userIdCheck)
-     then panic "Can share to others only"
-     else do 
-       folderSharedId  <- getFolderSharedId u
-       insertNodeNode [NodeNode folderSharedId n Nothing Nothing]
-------------------------------------------------------------------------
+    then errorWith "[G.D.A.S.shareNodeWith] Can share node Team only"
+    else
+      if (view node_userId nodeToCheck == userIdCheck)
+        then errorWith "[G.D.A.S.shareNodeWith] Can share to others only"
+        else do
+          folderSharedId  <- getFolderId u NodeFolderShared
+          insertNodeNode [NodeNode folderSharedId n Nothing Nothing]
 
-getFolderSharedId :: User -> Cmd err NodeId
-getFolderSharedId u = do
+shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
+  nodeToCheck <- getNode n
+  if not (isInNodeTypes nodeToCheck publicNodeTypes)
+    then errorWith $ "[G.D.A.S.shareNodeWith] Can share this nodesTypes only: "
+                   <> (cs $ show publicNodeTypes)
+    else do
+      folderToCheck <- getNode nId
+      if hasNodeType folderToCheck NodeFolderPublic
+         then insertNodeNode [NodeNode nId n Nothing Nothing]
+         else errorWith "[G.D.A.S.shareNodeWith] Can share NodeWith NodeFolderPublic only"
+
+shareNodeWith _ _ = errorWith "[G.D.A.S.shareNodeWith] Not implemented for this NodeType"
+
+------------------------------------------------------------------------
+getFolderId :: HasNodeError err => User -> NodeType -> Cmd err NodeId
+getFolderId u nt = do
   rootId <- getRootId u
-  s <- getNodesWith rootId HyperdataAny (Just NodeFolderShared) Nothing Nothing
+  s <- getNodesWith rootId HyperdataAny (Just nt) Nothing Nothing
   case head s of
-    Nothing -> panic "No folder shared found"
+    Nothing -> errorWith "[G.D.A.S.getFolderId] No folder shared found"
     Just  f -> pure (_node_id f)
 
+------------------------------------------------------------------------
 type TeamId = NodeId
 
-delFolderTeam :: User -> TeamId -> Cmd err Int
+delFolderTeam :: HasNodeError err => User -> TeamId -> Cmd err Int
 delFolderTeam u nId = do
-  folderSharedId <- getFolderSharedId u
+  folderSharedId <- getFolderId u NodeFolderShared
   deleteNodeNode folderSharedId nId
 
 
+unPublish :: HasNodeError err
+          => ParentId -> NodeId
+          -> Cmd err Int
+unPublish p n = deleteNodeNode p n
+

src/Gargantext/Database/Admin/Config.hs

@@ -56,15 +56,15 @@ nodeTypeId n =
 ----  Lists
     NodeList      -> 5
     NodeListCooc  -> 50
-    NodeListModel -> 52
+    NodeModel -> 52
 
 ----  Scores
 --    NodeOccurrences -> 10
     NodeGraph       -> 9
     NodePhylo       -> 90
-    NodeChart       -> 7
+--    NodeChart       -> 7
     NodeDashboard   -> 71
-    NodeNoteBook    -> 88
+--    NodeNoteBook    -> 88
 
     NodeFrameWrite  -> 991
     NodeFrameCalc   -> 992
@@ -84,11 +84,12 @@ nodeTypeId n =
 --  Node management
 --  NodeFavorites    -> 15
 
-
 hasNodeType :: forall a. Node a -> NodeType -> Bool
 hasNodeType n nt = (view node_typename n) == (nodeTypeId nt)
 
---
+isInNodeTypes :: forall a. Node a -> [NodeType] -> Bool
+isInNodeTypes n ts = elem (view node_typename n) (map nodeTypeId ts)
+
 -- | Nodes are typed in the database according to a specific ID
 --
 nodeTypeInv :: [(NodeTypeId, NodeType)]

src/Gargantext/Database/Admin/Types/Hyperdata/Any.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Any
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Gargantext.Database.Admin.Types.Hyperdata.Any
+  where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+------------------------------------------------------------------------
+newtype HyperdataAny = HyperdataAny Object
+  deriving (Show, Generic, ToJSON, FromJSON)
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+instance Hyperdata HyperdataAny
+
+instance Arbitrary HyperdataAny where
+    arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
+
+instance ToSchema HyperdataAny where
+  declareNamedSchema proxy =
+    pure $ genericNameSchema defaultSchemaOptions proxy mempty
+         & schema.description ?~ "Hyperdata of any node (Json Value)"
+         & schema.example ?~ emptyObject -- TODO
+
+instance FromField HyperdataAny where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataAny
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+

src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Contact
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE FunctionalDependencies     #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+
+module Gargantext.Database.Admin.Types.Hyperdata.Contact
+  where
+
+import Data.Time.Segment (jour)
+import Data.Time (UTCTime)
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+--------------------------------------------------------------------------------
+
+
+data HyperdataContact =
+     HyperdataContact { _hc_bdd    :: Maybe Text           -- ID of Database source
+                      , _hc_who    :: Maybe ContactWho
+                      , _hc_where  :: [ContactWhere]
+                      , _hc_title  :: Maybe Text -- TODO remove (only demo)
+                      , _hc_source :: Maybe Text -- TODO remove (only demo)
+                      , _hc_lastValidation  :: Maybe Text -- TODO UTCTime
+                      , _hc_uniqIdBdd       :: Maybe Text
+                      , _hc_uniqId          :: Maybe Text
+
+  } deriving (Eq, Show, Generic)
+
+
+defaultHyperdataContact :: HyperdataContact
+defaultHyperdataContact = HyperdataContact (Just "bdd")
+                                         (Just defaultContactWho)
+                                         [defaultContactWhere]
+                                         (Just "Title")
+                                         (Just "Source")
+                                         (Just "TODO lastValidation date")
+                                         (Just "DO NOT expose this")
+                                         (Just "DO NOT expose this")
+
+
+-- TOD0 contact metadata (Type is too flat)
+data ContactMetaData =
+     ContactMetaData { _cm_bdd :: Maybe Text
+                     , _cm_lastValidation  :: Maybe Text -- TODO UTCTIME
+  } deriving (Eq, Show, Generic)
+
+defaultContactMetaData :: ContactMetaData
+defaultContactMetaData = ContactMetaData (Just "bdd") (Just "TODO UTCTime")
+
+arbitraryHyperdataContact :: HyperdataContact
+arbitraryHyperdataContact = HyperdataContact Nothing Nothing []
+                                             Nothing Nothing Nothing
+                                             Nothing Nothing
+
+
+data ContactWho = 
+     ContactWho { _cw_id          :: Maybe Text
+                , _cw_firstName   :: Maybe Text
+                , _cw_lastName    :: Maybe Text
+                , _cw_keywords :: [Text]
+                , _cw_freetags :: [Text]
+  } deriving (Eq, Show, Generic)
+
+defaultContactWho :: ContactWho
+defaultContactWho = ContactWho (Just "123123")
+                             (Just "First Name")
+                             (Just "Last Name")
+                             ["keyword A"]
+                             ["freetag A"]
+
+data ContactWhere =
+     ContactWhere { _cw_organization :: [Text]
+                  , _cw_labTeamDepts :: [Text]
+
+                  , _cw_role         :: Maybe Text
+
+                  , _cw_office       :: Maybe Text
+                  , _cw_country      :: Maybe Text
+                  , _cw_city         :: Maybe Text
+
+                  , _cw_touch        :: Maybe ContactTouch
+
+                  , _cw_entry        :: Maybe UTCTime
+                  , _cw_exit         :: Maybe UTCTime
+  } deriving (Eq, Show, Generic)
+
+defaultContactWhere :: ContactWhere
+defaultContactWhere = ContactWhere ["Organization A"]
+                                 ["Organization B"]
+                                 (Just "Role")
+                                 (Just "Office")
+                                 (Just "Country")
+                                 (Just "City")
+                                 (Just defaultContactTouch)
+                                 (Just $ jour 01 01 2020)
+                                 (Just $ jour 01 01 2029)
+
+data ContactTouch =
+     ContactTouch { _ct_mail      :: Maybe Text
+                  , _ct_phone     :: Maybe Text
+                  , _ct_url       :: Maybe Text
+  } deriving (Eq, Show, Generic)
+
+defaultContactTouch :: ContactTouch
+defaultContactTouch = ContactTouch (Just "email@data.com")
+                                 (Just "+336 328 283 288")
+                                 (Just "https://url.com")
+
+-- | ToSchema instances
+instance ToSchema HyperdataContact where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hc_")
+instance ToSchema ContactWho where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
+instance ToSchema ContactWhere where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
+instance ToSchema ContactTouch where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ct_")
+instance ToSchema ContactMetaData where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cm_")
+
+-- | Arbitrary instances
+instance Arbitrary HyperdataContact where
+  arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing]
+
+-- | Specific Gargantext instance
+instance Hyperdata HyperdataContact
+
+-- | Database (Posgresql-simple instance)
+instance FromField HyperdataContact where
+  fromField = fromField'
+
+-- | Database (Opaleye instance)
+instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+-- | All lenses
+makeLenses ''ContactWho
+makeLenses ''ContactWhere
+makeLenses ''ContactTouch
+makeLenses ''ContactMetaData
+makeLenses ''HyperdataContact
+
+-- | All Json instances
+$(deriveJSON (unPrefix "_cw_") ''ContactWho)
+$(deriveJSON (unPrefix "_cw_") ''ContactWhere)
+$(deriveJSON (unPrefix "_ct_") ''ContactTouch)
+$(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
+$(deriveJSON (unPrefix "_hc_") ''HyperdataContact)

src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Corpus
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Gargantext.Database.Admin.Types.Hyperdata.Corpus
+  where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+
+data CodeType = JSON | Markdown | Haskell
+  deriving (Generic, Eq)
+instance ToJSON CodeType
+instance FromJSON CodeType
+instance ToSchema CodeType
+
+------------------------------------------------------------------------
+data CorpusField = MarkdownField { _cf_text    :: !Text }
+                  | HaskellField { _cf_haskell :: !Text }
+                  | JsonField    { _cf_title   :: !Text
+                                 , _cf_desc    :: !Text
+                                 , _cf_query   :: !Text
+                                 , _cf_authors :: !Text
+                                 -- , _cf_resources :: ![Resource]
+                                 }
+                  deriving (Generic)
+
+defaultCorpusField :: CorpusField
+defaultCorpusField = MarkdownField "# Title"
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+$(makeLenses ''CorpusField)
+$(deriveJSON (unPrefix "_cf_") ''CorpusField)
+
+instance ToSchema CorpusField where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_cf_") proxy
+    & mapped.schema.description ?~ "CorpusField"
+    & mapped.schema.example ?~ toJSON defaultCorpusField
+
+------------------------------------------------------------------------
+data HyperdataField a =
+  HyperdataField { _hf_type :: !CodeType
+                 , _hf_name :: !Text
+                 , _hf_data :: !a
+                 } deriving (Generic)
+defaultHyperdataField :: HyperdataField CorpusField
+defaultHyperdataField = HyperdataField Markdown "name" defaultCorpusField
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+$(makeLenses ''HyperdataField)
+$(deriveJSON (unPrefix "_hf_") ''HyperdataField)
+
+instance (Typeable a, ToSchema a) => ToSchema (HyperdataField a) where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hf_") proxy
+    & mapped.schema.description ?~ "Hyperdata Field"
+    & mapped.schema.example ?~ toJSON defaultCorpusField
+{-
+  declareNamedSchema =
+    wellNamedSchema "_hf_"
+    -- & mapped.schema.description ?~ "HyperdataField"
+    -- & mapped.schema.example ?~ toJSON defaultHyperdataField
+-}
+
+------------------------------------------------------------------------
+data HyperdataCorpus =
+  HyperdataCorpus { _hc_fields :: ![HyperdataField CorpusField] }
+    deriving (Generic)
+
+defaultHyperdataCorpus :: HyperdataCorpus
+defaultHyperdataCorpus =
+  HyperdataCorpus [ HyperdataField JSON
+                                   "Mandatory fields"
+                                   (JsonField "Title" "Descr" "Bool query" "Authors")
+                  , HyperdataField Markdown
+                                   "Optional Text"
+                                   (MarkdownField "# title\n## subtitle")
+                  ]
+
+------------------------------------------------------------------------
+------------------------------------------------------------------------
+-- | Annuaire and Corpus should be the same
+data HyperdataAnnuaire = HyperdataAnnuaire { _ha_title        :: !(Maybe Text)
+                                           , _ha_desc         :: !(Maybe Text)
+                                           } deriving (Show, Generic)
+
+defaultHyperdataAnnuaire :: HyperdataAnnuaire
+defaultHyperdataAnnuaire = HyperdataAnnuaire (Just "Title") (Just "Description")
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+instance Hyperdata HyperdataCorpus
+instance Hyperdata HyperdataAnnuaire
+
+$(makeLenses ''HyperdataCorpus)
+$(makeLenses ''HyperdataAnnuaire)
+
+$(deriveJSON (unPrefix "_hc_") ''HyperdataCorpus)
+$(deriveJSON (unPrefix "_ha_") ''HyperdataAnnuaire)
+
+------------------------------------------------------------------------
+instance ToSchema HyperdataCorpus where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hc_") proxy
+    & mapped.schema.description ?~ "Corpus Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataCorpus
+
+instance ToSchema HyperdataAnnuaire where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_ha_") proxy
+    & mapped.schema.description ?~ "Annuaire Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataAnnuaire
+------------------------------------------------------------------------
+instance Arbitrary HyperdataCorpus where
+    arbitrary = pure defaultHyperdataCorpus
+
+instance Arbitrary HyperdataAnnuaire where
+  arbitrary = pure defaultHyperdataAnnuaire
+------------------------------------------------------------------------
+instance FromField HyperdataCorpus
+  where
+    fromField = fromField'
+
+instance FromField HyperdataAnnuaire
+  where
+    fromField = fromField'
+------------------------------------------------------------------------
+instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn

src/Gargantext/Database/Admin/Types/Hyperdata/Dashboard.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Dashboard
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Gargantext.Database.Admin.Types.Hyperdata.Dashboard
+  where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+------------------------------------------------------------------------
+
+data HyperdataDashboard =
+  HyperdataDashboard { _hd_preferences :: !(Maybe Text)
+                     , _hd_charts      :: ![Chart]
+                     }
+  deriving (Show, Generic)
+
+
+defaultHyperdataDashboard :: HyperdataDashboard
+defaultHyperdataDashboard = HyperdataDashboard Nothing []
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+instance Hyperdata HyperdataDashboard
+
+$(makeLenses ''HyperdataDashboard)
+$(deriveJSON (unPrefix "_hd_") ''HyperdataDashboard)
+
+instance Arbitrary HyperdataDashboard where
+    arbitrary = pure defaultHyperdataDashboard
+
+instance ToSchema HyperdataDashboard where
+  declareNamedSchema proxy =
+    pure $ genericNameSchema defaultSchemaOptions proxy mempty
+    -- genericDeclareNamedSchema (unPrefixSwagger "hp_") proxy
+             & schema.description ?~ "Dashboard Hyperdata"
+             & schema.example ?~ toJSON defaultHyperdataDashboard
+
+instance FromField HyperdataDashboard where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataDashboard
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+

src/Gargantext/Database/Admin/Types/Hyperdata/Default.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Default
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Gargantext.Database.Admin.Types.Hyperdata.Default
+  where
+
+import Gargantext.Database.Admin.Types.Node (NodeType(..))
+import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+
+data DefaultHyperdata =
+    DefaultUser    HyperdataUser 
+  | DefaultContact HyperdataContact
+
+  | DefaultCorpus    HyperdataCorpus
+  | DefaultCorpusV3  HyperdataCorpus
+  | DefaultAnnuaire  HyperdataAnnuaire
+
+  | DefaultDocument  HyperdataDocument
+  | DefaultTexts     HyperdataTexts
+  | DefaultList      HyperdataList
+  | DefaultListCooc  HyperdataListCooc
+  | DefaultModel     HyperdataModel
+
+  | DefaultFolder        HyperdataFolder
+  | DefaultFolderPrivate HyperdataFolderPrivate
+  | DefaultFolderShared  HyperdataFolderShared
+  | DefaultTeam          HyperdataFolder
+  | DefaultFolderPublic  HyperdataFolderPublic
+
+  | DefaultGraph         HyperdataGraph
+  | DefaultPhylo         HyperdataPhylo
+  | DefaultDashboard     HyperdataDashboard
+
+  | DefaultFrameWrite    HyperdataFrame
+  | DefaultFrameCalc     HyperdataFrame
+
+instance Hyperdata DefaultHyperdata
+
+instance ToJSON DefaultHyperdata where
+  toJSON (DefaultUser    x) = toJSON x
+  toJSON (DefaultContact x) = toJSON x
+
+  toJSON (DefaultCorpus   x) = toJSON x
+  toJSON (DefaultCorpusV3 x) = toJSON x
+  toJSON (DefaultAnnuaire x) = toJSON x
+
+  toJSON (DefaultDocument x) = toJSON x
+  toJSON (DefaultTexts    x) = toJSON x
+  toJSON (DefaultList     x) = toJSON x
+  toJSON (DefaultListCooc x) = toJSON x
+  toJSON (DefaultModel    x) = toJSON x
+
+  toJSON (DefaultFolder        x) = toJSON x
+  toJSON (DefaultFolderPrivate x) = toJSON x
+  toJSON (DefaultFolderShared  x) = toJSON x
+  toJSON (DefaultTeam          x) = toJSON x
+  toJSON (DefaultFolderPublic  x) = toJSON x
+
+  toJSON (DefaultGraph     x) = toJSON x
+  toJSON (DefaultPhylo     x) = toJSON x
+  toJSON (DefaultDashboard x) = toJSON x
+
+  toJSON (DefaultFrameWrite x) = toJSON x
+  toJSON (DefaultFrameCalc  x) = toJSON x
+
+
+defaultHyperdata :: NodeType -> DefaultHyperdata
+defaultHyperdata NodeUser           = DefaultUser    defaultHyperdataUser
+defaultHyperdata NodeContact        = DefaultContact defaultHyperdataContact
+
+defaultHyperdata NodeCorpus         = DefaultCorpus   defaultHyperdataCorpus
+defaultHyperdata NodeCorpusV3       = DefaultCorpusV3 defaultHyperdataCorpus
+defaultHyperdata NodeAnnuaire       = DefaultAnnuaire defaultHyperdataAnnuaire
+
+defaultHyperdata NodeDocument       = DefaultDocument defaultHyperdataDocument
+defaultHyperdata NodeTexts          = DefaultTexts    defaultHyperdataTexts
+defaultHyperdata NodeList           = DefaultList     defaultHyperdataList
+defaultHyperdata NodeListCooc       = DefaultListCooc defaultHyperdataListCooc
+defaultHyperdata NodeModel          = DefaultModel    defaultHyperdataModel
+
+defaultHyperdata NodeFolder         = DefaultFolder        defaultHyperdataFolder
+defaultHyperdata NodeFolderPrivate  = DefaultFolderPrivate defaultHyperdataFolderPrivate
+defaultHyperdata NodeFolderShared   = DefaultFolderShared  defaultHyperdataFolderShared
+defaultHyperdata NodeTeam           = DefaultTeam          defaultHyperdataFolder
+defaultHyperdata NodeFolderPublic   = DefaultFolderPublic  defaultHyperdataFolderPublic
+
+defaultHyperdata NodeGraph          = DefaultGraph     defaultHyperdataGraph
+defaultHyperdata NodePhylo          = DefaultPhylo     defaultHyperdataPhylo
+defaultHyperdata NodeDashboard      = DefaultDashboard defaultHyperdataDashboard
+
+defaultHyperdata NodeFrameWrite     = DefaultFrameWrite defaultHyperdataFrame
+defaultHyperdata NodeFrameCalc      = DefaultFrameCalc  defaultHyperdataFrame
+
+
+

src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Document
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Gargantext.Database.Admin.Types.Hyperdata.Document where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+
+------------------------------------------------------------------------
+data HyperdataDocument = HyperdataDocument { _hd_bdd                :: !(Maybe Text)
+                                           , _hd_doi                :: !(Maybe Text)
+                                           , _hd_url                :: !(Maybe Text)
+                                           , _hd_uniqId             :: !(Maybe Text)
+                                           , _hd_uniqIdBdd          :: !(Maybe Text)
+                                           , _hd_page               :: !(Maybe Int)
+                                           , _hd_title              :: !(Maybe Text)
+                                           , _hd_authors            :: !(Maybe Text)
+                                           , _hd_institutes         :: !(Maybe Text)
+                                           , _hd_source             :: !(Maybe Text)
+                                           , _hd_abstract           :: !(Maybe Text)
+                                           , _hd_publication_date   :: !(Maybe Text)
+                                           , _hd_publication_year   :: !(Maybe Int)
+                                           , _hd_publication_month  :: !(Maybe Int)
+                                           , _hd_publication_day    :: !(Maybe Int)
+                                           , _hd_publication_hour   :: !(Maybe Int)
+                                           , _hd_publication_minute :: !(Maybe Int)
+                                           , _hd_publication_second :: !(Maybe Int)
+                                           , _hd_language_iso2      :: !(Maybe Text)
+                                           } deriving (Show, Generic)
+
+
+defaultHyperdataDocument :: HyperdataDocument
+defaultHyperdataDocument = case decode docExample of
+  Just hp -> hp
+  Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
+                               Nothing Nothing Nothing Nothing
+                               Nothing Nothing Nothing Nothing
+                               Nothing Nothing Nothing Nothing
+                               Nothing Nothing Nothing
+
+  where
+    docExample :: ByteString
+    docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",\"publication_minute\":0,\"publication_month\":7,\"language_iso3\":\"eng\",\"publication_second\":0,\"authors\":\"Nils Hovdenak, Kjell Haram\",\"publication_year\":2012,\"publication_date\":\"2012-07-06 00:00:00+00:00\",\"language_name\":\"English\",\"realdate_full_\":\"2012 01 12\",\"source\":\"European journal of obstetrics, gynecology, and reproductive biology\",\"abstract\":\"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome.\",\"title\":\"Influence of mineral and vitamin supplements on pregnancy outcome.\",\"publication_hour\":0}"
+
+------------------------------------------------------------------------
+-- | Legacy Garg V3 compatibility (to be removed one year after release)
+data StatusV3  = StatusV3 { statusV3_error  :: !(Maybe Text)
+                          , statusV3_action :: !(Maybe Text)
+                      } deriving (Show, Generic)
+$(deriveJSON (unPrefix "statusV3_") ''StatusV3)
+
+------------------------------------------------------------------------
+data HyperdataDocumentV3 = HyperdataDocumentV3 { _hdv3_publication_day    :: !(Maybe Int)
+                                               , _hdv3_language_iso2      :: !(Maybe Text)
+                                               , _hdv3_publication_second :: !(Maybe Int)
+                                               , _hdv3_publication_minute :: !(Maybe Int)
+                                               , _hdv3_publication_month  :: !(Maybe Int)
+                                               , _hdv3_publication_hour   :: !(Maybe Int)
+                                               , _hdv3_error              :: !(Maybe Text)
+                                               , _hdv3_language_iso3      :: !(Maybe Text)
+                                               , _hdv3_authors            :: !(Maybe Text)
+                                               , _hdv3_publication_year   :: !(Maybe Int)
+                                               , _hdv3_publication_date   :: !(Maybe Text)
+                                               , _hdv3_language_name      :: !(Maybe Text)
+                                               , _hdv3_statuses           :: !(Maybe [StatusV3])
+                                               , _hdv3_realdate_full_     :: !(Maybe Text)
+                                               , _hdv3_source             :: !(Maybe Text)
+                                               , _hdv3_abstract           :: !(Maybe Text)
+                                               , _hdv3_title              :: !(Maybe Text)
+                                               } deriving (Show, Generic)
+
+
+------------------------------------------------------------------------
+-- | Instances for Analysis
+------------------------------------------------------------------------
+class ToHyperdataDocument a where
+  toHyperdataDocument :: a -> HyperdataDocument
+
+instance ToHyperdataDocument HyperdataDocument
+  where
+    toHyperdataDocument = identity
+
+------------------------------------------------------------------------
+instance Eq HyperdataDocument where
+  (==) h1 h2 = (==) (_hd_uniqId h1) (_hd_uniqId h2)
+
+------------------------------------------------------------------------
+instance Ord HyperdataDocument where
+  compare h1 h2 = compare (_hd_publication_date h1) (_hd_publication_date h2)
+------------------------------------------------------------------------
+instance Arbitrary HyperdataDocument where
+    arbitrary = elements arbitraryHyperdataDocuments
+
+arbitraryHyperdataDocuments :: [HyperdataDocument]
+arbitraryHyperdataDocuments =
+  map toHyperdataDocument' ([ ("AI is big but less than crypto", "Troll System journal")
+                            , ("Crypto is big but less than AI", "System Troll review" )
+                            , ("Science is magic"              , "Closed Source review")
+                            , ("Open science for all"          , "No Time"             )
+                            , ("Closed science for me"         , "No Space"            )
+                            ] :: [(Text, Text)])
+  where
+    toHyperdataDocument' (t1,t2) =
+      HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
+                      Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
+                      Nothing Nothing Nothing   Nothing
+
+
+
+------------------------------------------------------------------------
+-- | Common Instances of Hyperdata
+------------------------------------------------------------------------
+instance Hyperdata HyperdataDocument
+instance Hyperdata HyperdataDocumentV3
+------------------------------------------------------------------------
+$(makeLenses ''HyperdataDocument)
+$(makeLenses ''HyperdataDocumentV3)
+
+$(deriveJSON (unPrefix "_hd_") ''HyperdataDocument)
+$(deriveJSON (unPrefix "_hdv3_") ''HyperdataDocumentV3)
+
+instance ToSchema HyperdataDocument where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hd_") proxy
+    & mapped.schema.description ?~ "Document Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataDocument
+
+{-
+-- | For now HyperdataDocumentV3 is not exposed with the API
+instance ToSchema HyperdataDocumentV3 where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "hyperdataDocumentV3_") proxy
+    & mapped.schema.description ?~ "Document Hyperdata for Garg V3"
+    & mapped.schema.example ?~ toJSON defaultHyperdataDocumentV3
+-}
+
+------------------------------------------------------------------------
+instance FromField HyperdataDocument
+  where
+    fromField = fromField'
+
+instance FromField HyperdataDocumentV3
+  where
+    fromField = fromField'
+
+-------
+instance ToField HyperdataDocument where
+  toField = toJSONField
+
+instance ToField HyperdataDocumentV3 where
+  toField = toJSONField
+
+------------------------------------------------------------------------
+instance QueryRunnerColumnDefault PGJsonb HyperdataDocument
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataDocumentV3
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+------------------------------------------------------------------------

src/Gargantext/Database/Admin/Types/Hyperdata/Folder.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Folder
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Gargantext.Database.Admin.Types.Hyperdata.Folder
+  where
+
+import Gargantext.Database.Admin.Types.Hyperdata.Corpus
+
+------------------------------------------------------------------------
+type HyperdataFolder = HyperdataCorpus
+
+defaultHyperdataFolder :: HyperdataFolder
+defaultHyperdataFolder = defaultHyperdataCorpus
+------------------------------------------------------------------------
+
+type HyperdataFolderPrivate = HyperdataFolder
+
+defaultHyperdataFolderPrivate :: HyperdataFolderPrivate
+defaultHyperdataFolderPrivate = defaultHyperdataFolder
+
+
+type HyperdataFolderShared = HyperdataFolder
+
+defaultHyperdataFolderShared :: HyperdataFolderShared
+defaultHyperdataFolderShared = defaultHyperdataFolder
+
+type HyperdataFolderPublic = HyperdataFolder
+
+defaultHyperdataFolderPublic :: HyperdataFolderPublic
+defaultHyperdataFolderPublic = defaultHyperdataFolder
+
+
+

src/Gargantext/Database/Admin/Types/Hyperdata/Frame.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Frame
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Gargantext.Database.Admin.Types.Hyperdata.Frame
+  where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+------------------------------------------------------------------------
+data HyperdataFrame =
+  HyperdataFrame { _hf_base     :: !Text
+                 , _hf_frame_id :: !Text
+                 }
+    deriving (Generic)
+
+
+defaultHyperdataFrame :: HyperdataFrame
+defaultHyperdataFrame = HyperdataFrame "" ""
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+-- | Specific Gargantext instance
+instance Hyperdata HyperdataFrame
+makeLenses ''HyperdataFrame
+
+-- | All Json instances
+$(deriveJSON (unPrefix "_hf_") ''HyperdataFrame)
+
+-- | Arbitrary instances for tests
+instance Arbitrary HyperdataFrame where
+  arbitrary = pure defaultHyperdataFrame
+
+instance FromField HyperdataFrame
+  where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataFrame
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance ToSchema HyperdataFrame where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hf_") proxy
+    & mapped.schema.description ?~ "Frame Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataFrame
+

src/Gargantext/Database/Admin/Types/Hyperdata/List.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.List
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Gargantext.Database.Admin.Types.Hyperdata.List
+  where
+
+import Gargantext.Prelude
+import Gargantext.Viz.Types (Histo(..))
+import Gargantext.API.Ngrams.NTree (MyTree)
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics)
+
+------------------------------------------------------------------------
+data HyperdataList =
+  HyperdataList { _hl_chart   :: !(Maybe (ChartMetrics Histo))
+                , _hl_list    :: !(Maybe Text)
+                , _hl_pie     :: !(Maybe (ChartMetrics Histo))
+                , _hl_scatter :: !(Maybe Metrics)
+                , _hl_tree    :: !(Maybe (ChartMetrics [MyTree]))
+                } deriving (Show, Generic)
+
+defaultHyperdataList :: HyperdataList
+defaultHyperdataList = HyperdataList Nothing Nothing Nothing Nothing Nothing
+
+data HyperdataListCooc =
+  HyperdataListCooc { _hlc_preferences :: !Text }
+  deriving (Generic)
+
+defaultHyperdataListCooc :: HyperdataListCooc
+defaultHyperdataListCooc = HyperdataListCooc ""
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+instance Hyperdata HyperdataList
+instance Hyperdata HyperdataListCooc
+
+$(makeLenses ''HyperdataList)
+$(makeLenses ''HyperdataListCooc)
+$(deriveJSON (unPrefix "_hl_") ''HyperdataList)
+$(deriveJSON (unPrefix "_hlc_") ''HyperdataListCooc)
+
+instance Arbitrary HyperdataList where
+  arbitrary = pure defaultHyperdataList
+instance Arbitrary HyperdataListCooc where
+  arbitrary = pure defaultHyperdataListCooc
+
+
+instance FromField HyperdataList
+  where
+    fromField = fromField'
+
+instance FromField HyperdataListCooc
+  where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataList
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+instance QueryRunnerColumnDefault PGJsonb HyperdataListCooc
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+
+instance ToSchema HyperdataList where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hl_") proxy
+    & mapped.schema.description ?~ "List Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataList
+instance ToSchema HyperdataListCooc where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hlc_") proxy
+    & mapped.schema.description ?~ "List Cooc Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataListCooc
+

src/Gargantext/Database/Admin/Types/Hyperdata/Model.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Model
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Gargantext.Database.Admin.Types.Hyperdata.Model
+  where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+------------------------------------------------------------------------
+data HyperdataModel =
+  HyperdataModel { _hm_params  :: !(Int, Int)
+                 , _hm_path    :: !Text
+                 , _hm_score   :: !(Maybe Double)
+                 } deriving (Show, Generic)
+
+defaultHyperdataModel :: HyperdataModel
+defaultHyperdataModel = HyperdataModel (400,500) "data/models/test.model" (Just 0.83)
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+instance Hyperdata HyperdataModel
+$(makeLenses ''HyperdataModel)
+$(deriveJSON (unPrefix "_hm_") ''HyperdataModel)
+
+instance Arbitrary HyperdataModel where
+  arbitrary = pure defaultHyperdataModel
+
+instance FromField HyperdataModel
+  where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataModel
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance ToSchema HyperdataModel where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hm_") proxy
+    & mapped.schema.description ?~ "Model Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataModel
+

src/Gargantext/Database/Admin/Types/Hyperdata/Phylo.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Phylo
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Gargantext.Database.Admin.Types.Hyperdata.Phylo
+  where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+import Gargantext.Viz.Phylo (Phylo(..))
+
+------------------------------------------------------------------------
+
+data HyperdataPhylo =
+  HyperdataPhylo    { _hp_preferences :: !(Maybe Text)
+                    , _hp_data        :: !(Maybe Phylo)
+                    }
+  deriving (Show, Generic)
+
+defaultHyperdataPhylo :: HyperdataPhylo
+defaultHyperdataPhylo = HyperdataPhylo Nothing Nothing
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+instance Hyperdata HyperdataPhylo
+
+$(makeLenses ''HyperdataPhylo)
+$(deriveJSON (unPrefix "_hp_") ''HyperdataPhylo)
+
+instance Arbitrary HyperdataPhylo where
+    arbitrary = pure defaultHyperdataPhylo
+
+instance ToSchema HyperdataPhylo where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hp_") proxy
+    & mapped.schema.description ?~ "Phylo Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataPhylo
+
+instance FromField HyperdataPhylo where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataPhylo
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn

src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Prelude
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+
+module Gargantext.Database.Admin.Types.Hyperdata.Prelude
+  ( module Control.Lens 
+  , module Data.Aeson
+  , module Data.Aeson.TH
+  , module Data.Aeson.Types
+  , module Data.ByteString.Lazy.Internal
+  , module Data.Maybe
+  , module Data.Monoid
+  , module Data.Swagger
+  , module Data.Text
+  , module Database.PostgreSQL.Simple.FromField
+  , module Database.PostgreSQL.Simple.ToField
+  , module GHC.Generics
+  , module Gargantext.Core.Utils.Prefix
+  , module Gargantext.Database.Prelude
+  , module Opaleye
+  , module Test.QuickCheck
+  , module Test.QuickCheck.Arbitrary
+  , Hyperdata
+  , Chart(..)
+  )
+  where
+
+import Control.Lens hiding (elements, (&), (.=))
+import Data.Aeson
+import Data.Aeson.TH (deriveJSON)
+import Data.Aeson.Types (emptyObject)
+import Data.ByteString.Lazy.Internal (ByteString)
+import Data.Maybe (Maybe(..))
+import Data.Monoid (mempty)
+import Data.Swagger hiding (unwrapUnaryRecords, constructorTagModifier, allNullaryToStringTag, allOf, fieldLabelModifier)
+import Data.Text (Text)
+import Database.PostgreSQL.Simple.FromField (FromField, fromField)
+import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
+import GHC.Generics (Generic)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
+import Gargantext.Database.Prelude (fromField')
+import Gargantext.Prelude
+import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+
+------------------------------------------------------------------------
+-- Only Hyperdata types should be member of this type class.
+class Hyperdata a
+
+
+data Chart =
+    CDocsHistogram
+  | CAuthorsPie
+  | CInstitutesTree
+  | CTermsMetrics
+  deriving (Generic, Show, Eq)
+instance ToJSON Chart
+instance FromJSON Chart
+instance ToSchema Chart
+
+
+
+
+

src/Gargantext/Database/Admin/Types/Hyperdata/Texts.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.Texts
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Gargantext.Database.Admin.Types.Hyperdata.Texts
+  where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+------------------------------------------------------------------------
+
+data HyperdataTexts =
+  HyperdataTexts { _ht_preferences :: !(Maybe Text)
+                 }
+  deriving (Show, Generic)
+
+defaultHyperdataTexts :: HyperdataTexts
+defaultHyperdataTexts = HyperdataTexts Nothing
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+instance Hyperdata HyperdataTexts
+
+$(makeLenses ''HyperdataTexts)
+$(deriveJSON (unPrefix "_ht_") ''HyperdataTexts)
+
+instance Arbitrary HyperdataTexts where
+    arbitrary = pure defaultHyperdataTexts
+
+instance ToSchema HyperdataTexts where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_ht_") proxy
+    & mapped.schema.description ?~ "Texts Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataTexts
+
+instance FromField HyperdataTexts where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataTexts
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+

src/Gargantext/Database/Admin/Types/Hyperdata/User.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.User
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE FunctionalDependencies     #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+
+module Gargantext.Database.Admin.Types.Hyperdata.User
+  where
+
+import Gargantext.Prelude
+import Gargantext.Core (Lang(..))
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Contact
+import Gargantext.Database.Admin.Types.Node (DocumentId)
+
+-- import Gargantext.Database.Schema.Node -- (Node(..))
+
+data HyperdataUser =
+     HyperdataUser { _hu_private   :: !(Maybe HyperdataPrivate)
+                   , _hu_shared    :: !(Maybe HyperdataContact)
+                   , _hu_public    :: !(Maybe HyperdataPublic)
+                   } deriving (Eq, Show, Generic)
+
+data HyperdataPrivate =
+     HyperdataPrivate { _hpr_password :: !Text
+                      , _hpr_lang     :: !Lang
+                      }
+     deriving (Eq, Show, Generic)
+
+data HyperdataPublic =
+     HyperdataPublic { _hpu_pseudo       :: !Text
+                     , _hpu_publications :: ![DocumentId]
+                     }
+     deriving (Eq, Show, Generic)
+
+-- | Default
+defaultHyperdataUser :: HyperdataUser
+defaultHyperdataUser = HyperdataUser (Just defaultHyperdataPrivate)
+                                   (Just defaultHyperdataContact)
+                                   (Just defaultHyperdataPublic)
+
+defaultHyperdataPublic :: HyperdataPublic
+defaultHyperdataPublic = HyperdataPublic "pseudo" [1..10]
+
+defaultHyperdataPrivate :: HyperdataPrivate
+defaultHyperdataPrivate = HyperdataPrivate "password" EN
+
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+-- | Specific Gargantext instance
+instance Hyperdata HyperdataUser
+instance Hyperdata HyperdataPrivate
+instance Hyperdata HyperdataPublic
+
+-- | All lenses
+makeLenses ''HyperdataUser
+makeLenses ''HyperdataPrivate
+makeLenses ''HyperdataPublic
+
+-- | All Json instances
+$(deriveJSON (unPrefix "_hu_")  ''HyperdataUser)
+$(deriveJSON (unPrefix "_hpr_") ''HyperdataPrivate)
+$(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic)
+
+-- | Arbitrary instances
+instance Arbitrary HyperdataUser where
+  arbitrary = HyperdataUser <$> arbitrary <*> arbitrary <*> arbitrary
+
+instance Arbitrary HyperdataPrivate where
+  arbitrary = pure defaultHyperdataPrivate
+
+instance Arbitrary HyperdataPublic where
+  arbitrary = pure defaultHyperdataPublic
+
+-- | ToSchema instances
+instance ToSchema HyperdataUser where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hu_") proxy
+    & mapped.schema.description ?~ "User Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataUser
+
+instance ToSchema HyperdataPrivate where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hpr_") proxy
+    & mapped.schema.description ?~ "User Private Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataPrivate
+
+
+instance ToSchema HyperdataPublic where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hpu_") proxy
+    & mapped.schema.description ?~ "User Public Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataPublic
+
+
+-- | Database (Posgresql-simple instance)
+instance FromField HyperdataUser where
+  fromField = fromField'
+instance FromField HyperdataPrivate where
+  fromField = fromField'
+instance FromField HyperdataPublic where
+  fromField = fromField'
+
+-- | Database (Opaleye instance)
+instance QueryRunnerColumnDefault PGJsonb HyperdataUser   where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataPrivate   where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataPublic   where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+

src/Gargantext/Database/Admin/Types/Metrics.hs

@@ -11,7 +11,7 @@ import Protolude
 import Test.QuickCheck.Arbitrary
 
 import Gargantext.Core.Types (ListType(..))
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 
 ----------------------------------------------------------------------------
 
@@ -48,8 +48,8 @@ deriveJSON (unPrefix "m_") ''Metric
 data ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
   deriving (Generic, Show)
 
-instance (ToSchema a) => ToSchema (ChartMetrics a) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "chartMetrics_")
+instance (Typeable a, ToSchema a) => ToSchema (ChartMetrics a) where
+  declareNamedSchema = wellNamedSchema "chartMetrics_"
 instance (Arbitrary a) => Arbitrary (ChartMetrics a)
   where
     arbitrary = ChartMetrics <$> arbitrary

src/Gargantext/Database/Admin/Types/Node.hs

@@ -29,6 +29,7 @@ import Data.Eq (Eq)
 import Data.Swagger
 import Data.Text (Text, unpack)
 import Data.Time (UTCTime)
+import Data.Typeable (Typeable)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import Database.PostgreSQL.Simple.ToField (ToField, toField)
 import GHC.Generics (Generic)
@@ -43,7 +44,7 @@ import Test.QuickCheck.Instances.Time ()
 import Text.Read (read)
 import Text.Show (Show())
 
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Prelude (fromField')
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
@@ -60,37 +61,37 @@ type NodeSearch json   = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId
 
 ------------------------------------------------------------------------
 
-instance ToSchema hyperdata =>
+instance (Typeable hyperdata, ToSchema hyperdata) =>
          ToSchema (NodePoly NodeId NodeTypeId
                             (Maybe UserId)
                             ParentId NodeName
                             UTCTime hyperdata
                   ) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
+  declareNamedSchema = wellNamedSchema "_node_"
 
-instance ToSchema hyperdata =>
+instance (Typeable hyperdata, ToSchema hyperdata) =>
          ToSchema (NodePoly NodeId NodeTypeId
                             UserId
                             (Maybe ParentId) NodeName
                             UTCTime hyperdata
                   ) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
+  declareNamedSchema = wellNamedSchema "_node_"
 
-instance ToSchema hyperdata =>
+instance (Typeable hyperdata, ToSchema hyperdata) =>
          ToSchema (NodePolySearch NodeId NodeTypeId
                             (Maybe UserId)
                             ParentId NodeName
                             UTCTime hyperdata (Maybe TSVector)
                   ) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_")
+  declareNamedSchema = wellNamedSchema "_ns_"
 
-instance ToSchema hyperdata =>
+instance (Typeable hyperdata, ToSchema hyperdata) =>
          ToSchema (NodePolySearch NodeId NodeTypeId
                             UserId
                             (Maybe ParentId) NodeName
                             UTCTime hyperdata (Maybe TSVector)
                   ) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_")
+  declareNamedSchema = wellNamedSchema "_ns_"
 
 instance (Arbitrary hyperdata
          ,Arbitrary nodeId
@@ -232,10 +233,6 @@ instance Arbitrary Resource where
 instance ToSchema Resource where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "resource_")
 
-------------------------------------------------------------------------
-
-
-
 ------------------------------------------------------------------------
 -- | Then a Node can be either a Folder or a Corpus or a Document
 data NodeType = NodeUser
@@ -247,8 +244,8 @@ data NodeType = NodeUser
               | NodeCorpus     | NodeCorpusV3 | NodeTexts | NodeDocument
               | NodeAnnuaire   | NodeContact
               | NodeGraph      | NodePhylo
-              | NodeDashboard  | NodeChart    | NodeNoteBook
-              | NodeList       | NodeListModel
+              | NodeDashboard  -- | NodeChart    | NodeNoteBook
+              | NodeList       | NodeModel
               | NodeListCooc
 
 {-
@@ -266,6 +263,34 @@ data NodeType = NodeUser
 allNodeTypes :: [NodeType]
 allNodeTypes = [minBound ..]
 
+defaultName :: NodeType -> Text
+defaultName NodeUser       = "User"
+defaultName NodeContact    = "Contact"
+
+defaultName NodeCorpus     = "Corpus"
+defaultName NodeCorpusV3   = "Corpus"
+defaultName NodeAnnuaire   = "Annuaire"
+
+defaultName NodeDocument   = "Doc"
+defaultName NodeTexts      = "Texts"
+defaultName NodeList       = "List"
+defaultName NodeListCooc   = "List"
+defaultName NodeModel      = "Model"
+
+defaultName NodeFolder     = "Folder"
+defaultName NodeFolderPrivate = "Private Folder"
+defaultName NodeFolderShared  = "Shared Folder"
+defaultName NodeTeam          = "Folder"
+defaultName NodeFolderPublic  = "Public Folder"
+
+defaultName NodeGraph         = "Graph"
+defaultName NodePhylo         = "Phylo"
+defaultName NodeDashboard     = "Dashboard"
+
+defaultName NodeFrameWrite    = "Frame Write"
+defaultName NodeFrameCalc     = "Frame Calc"
+
+
 instance FromJSON NodeType
 instance ToJSON NodeType
 
@@ -279,6 +304,8 @@ instance ToSchema      NodeType
 instance Arbitrary NodeType where
   arbitrary = elements allNodeTypes
 
+
+
 ------------------------------------------------------------------------
 -- Instances
 ------------------------------------------------------------------------
@@ -310,5 +337,3 @@ instance QueryRunnerColumnDefault (Nullable PGInt4) NodeId
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
 
-
-

src/Gargantext/Database/Prelude.hs

 {-|
 Module      : Gargantext.Database.Prelude
-Description : 
+Description : Specific Prelude for Database management
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org

src/Gargantext/Database/Query/Facet.hs

@@ -44,6 +44,7 @@ import Data.Swagger
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import Data.Time.Segment (jour)
+import Data.Typeable (Typeable)
 import GHC.Generics (Generic)
 import Opaleye
 import Prelude hiding (null, id, map, sum, not, read)
@@ -53,7 +54,7 @@ import Test.QuickCheck.Arbitrary
 import qualified Opaleye.Internal.Unpackspec()
 
 import Gargantext.Core.Types
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Query.Filter
@@ -105,8 +106,8 @@ data Pair i l = Pair {_p_id    :: i
 $(deriveJSON (unPrefix "_p_") ''Pair)
 $(makeAdaptorAndInstance "pPair" ''Pair)
 
-instance (ToSchema i, ToSchema l) => ToSchema (Pair i l) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_p_")
+instance (Typeable i, Typeable l, ToSchema i, ToSchema l) => ToSchema (Pair i l) where
+  declareNamedSchema = wellNamedSchema "_p_"
 instance (Arbitrary i, Arbitrary l) => Arbitrary (Pair i l) where
   arbitrary = Pair <$> arbitrary <*> arbitrary
 
@@ -125,8 +126,13 @@ instance ( ToSchema id
          , ToSchema hyperdata
          , ToSchema score
          , ToSchema pair
+         , Typeable id
+         , Typeable date
+         , Typeable hyperdata
+         , Typeable score
+         , Typeable pair
          ) => ToSchema (FacetPaired id date hyperdata score pair) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fp_")
+  declareNamedSchema = wellNamedSchema "_fp_"
 
 instance ( Arbitrary id
          , Arbitrary date

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

@@ -11,26 +11,24 @@ Portability : POSIX
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 {-# OPTIONS_GHC -fno-warn-orphans        #-}
 
-{-# LANGUAGE Arrows                 #-}
+{-# LANGUAGE Arrows                      #-}
 
 module Gargantext.Database.Query.Table.Node.Children
   where
 
 import Control.Arrow (returnA)
 import Data.Proxy
-import Opaleye
-import Protolude
-
 import Gargantext.Core.Types
 import Gargantext.Database.Admin.Config (nodeTypeId)
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument, HyperdataContact)
 import Gargantext.Database.Admin.Types.Node (pgNodeId)
-import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument)
+import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Filter
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.NodeNode
-import Gargantext.Database.Query.Table.Node.Contact (HyperdataContact)
-import Gargantext.Database.Prelude
 import Gargantext.Database.Schema.Node
+import Opaleye
+import Protolude
 
 getAllDocuments :: ParentId -> Cmd err (TableResult (Node HyperdataDocument))
 getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)

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

@@ -15,156 +15,11 @@ Portability : POSIX
 module Gargantext.Database.Query.Table.Node.Contact
   where
 
-import Control.Lens (makeLenses)
-import Data.Time.Segment (jour)
-import Data.Aeson.TH (deriveJSON)
-import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
-import Data.Text (Text)
-import Data.Time (UTCTime)
-import Database.PostgreSQL.Simple.FromField (FromField, fromField)
-import GHC.Generics (Generic)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Admin.Types.Node ( Node)
-import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata)
-import Gargantext.Database.Prelude (fromField')
-import Gargantext.Prelude
-import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import Gargantext.Database.Admin.Types.Hyperdata.Contact
 
 ------------------------------------------------------------------------
 
 type NodeContact  = Node HyperdataContact
 
-data HyperdataContact =
-     HyperdataContact { _hc_bdd    :: Maybe Text           -- ID of Database source
-                      , _hc_who    :: Maybe ContactWho
-                      , _hc_where  :: [ContactWhere]
-                      , _hc_title  :: Maybe Text -- TODO remove (only demo)
-                      , _hc_source :: Maybe Text -- TODO remove (only demo)
-                      , _hc_lastValidation  :: Maybe Text -- TODO UTCTime
-                      , _hc_uniqIdBdd       :: Maybe Text
-                      , _hc_uniqId          :: Maybe Text
 
-  } deriving (Eq, Show, Generic)
-
-
-fake_HyperdataContact :: HyperdataContact
-fake_HyperdataContact = HyperdataContact (Just "bdd")
-                                         (Just fake_ContactWho)
-                                         [fake_ContactWhere]
-                                         (Just "Title")
-                                         (Just "Source")
-                                         (Just "TODO lastValidation date")
-                                         (Just "DO NOT expose this")
-                                         (Just "DO NOT expose this")
-
-
--- TOD0 contact metadata (Type is too flat)
-data ContactMetaData =
-     ContactMetaData { _cm_bdd :: Maybe Text
-                     , _cm_lastValidation  :: Maybe Text -- TODO UTCTIME
-  } deriving (Eq, Show, Generic)
-
-fake_ContactMetaData :: ContactMetaData
-fake_ContactMetaData = ContactMetaData (Just "bdd") (Just "TODO UTCTime")
-
-arbitraryHyperdataContact :: HyperdataContact
-arbitraryHyperdataContact = HyperdataContact Nothing Nothing []
-                                             Nothing Nothing Nothing
-                                             Nothing Nothing
-
-
-data ContactWho = 
-     ContactWho { _cw_id          :: Maybe Text
-                , _cw_firstName   :: Maybe Text
-                , _cw_lastName    :: Maybe Text
-                , _cw_keywords :: [Text]
-                , _cw_freetags :: [Text]
-  } deriving (Eq, Show, Generic)
-
-fake_ContactWho :: ContactWho
-fake_ContactWho = ContactWho (Just "123123")
-                             (Just "First Name")
-                             (Just "Last Name")
-                             ["keyword A"]
-                             ["freetag A"]
-
-data ContactWhere =
-     ContactWhere { _cw_organization :: [Text]
-                  , _cw_labTeamDepts :: [Text]
-
-                  , _cw_role         :: Maybe Text
-
-                  , _cw_office       :: Maybe Text
-                  , _cw_country      :: Maybe Text
-                  , _cw_city         :: Maybe Text
-
-                  , _cw_touch        :: Maybe ContactTouch
-
-                  , _cw_entry        :: Maybe UTCTime
-                  , _cw_exit         :: Maybe UTCTime
-  } deriving (Eq, Show, Generic)
-
-fake_ContactWhere :: ContactWhere
-fake_ContactWhere = ContactWhere ["Organization A"]
-                                 ["Organization B"]
-                                 (Just "Role")
-                                 (Just "Office")
-                                 (Just "Country")
-                                 (Just "City")
-                                 (Just fake_ContactTouch)
-                                 (Just $ jour 01 01 2020)
-                                 (Just $ jour 01 01 2029)
-
-data ContactTouch =
-     ContactTouch { _ct_mail      :: Maybe Text
-                  , _ct_phone     :: Maybe Text
-                  , _ct_url       :: Maybe Text
-  } deriving (Eq, Show, Generic)
-
-fake_ContactTouch :: ContactTouch
-fake_ContactTouch = ContactTouch (Just "email@data.com")
-                                 (Just "+336 328 283 288")
-                                 (Just "https://url.com")
-
--- | ToSchema instances
-instance ToSchema HyperdataContact where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hc_")
-instance ToSchema ContactWho where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
-instance ToSchema ContactWhere where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cw_")
-instance ToSchema ContactTouch where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ct_")
-instance ToSchema ContactMetaData where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_cm_")
-
--- | Arbitrary instances
-instance Arbitrary HyperdataContact where
-  arbitrary = elements [HyperdataContact Nothing Nothing [] Nothing Nothing Nothing Nothing Nothing]
-
--- | Specific Gargantext instance
-instance Hyperdata HyperdataContact
-
--- | Database (Posgresql-simple instance)
-instance FromField HyperdataContact where
-  fromField = fromField'
-
--- | Database (Opaleye instance)
-instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
-
--- | All lenses
-makeLenses ''ContactWho
-makeLenses ''ContactWhere
-makeLenses ''ContactTouch
-makeLenses ''ContactMetaData
-makeLenses ''HyperdataContact
-
--- | All Json instances
-$(deriveJSON (unPrefix "_cw_") ''ContactWho)
-$(deriveJSON (unPrefix "_cw_") ''ContactWhere)
-$(deriveJSON (unPrefix "_ct_") ''ContactTouch)
-$(deriveJSON (unPrefix "_cm_") ''ContactMetaData)
-$(deriveJSON (unPrefix "_hc_") ''HyperdataContact)

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

@@ -67,17 +67,13 @@ import Database.PostgreSQL.Simple.SqlQQ
 import Database.PostgreSQL.Simple.ToField (toField, Action)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import GHC.Generics (Generic)
-import qualified Data.ByteString.Lazy.Char8  as DC (pack)
-import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
-import qualified Data.Text                   as DT (pack, unpack, concat, take)
-
-import Gargantext.Database.Query.Table.Node.Contact -- (HyperdataContact(..), ContactWho(..))
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils (sha)
+import Gargantext.Prelude.Utils (hash)
+import qualified Data.Text                   as DT (pack, concat, take)
 
 -- TODO : the import of Document constructor below does not work
 -- import Gargantext.Database.Types.Node (Document)
@@ -119,8 +115,8 @@ instance InsertDb HyperdataDocument
     insertDb' u p h = [ toField $ nodeTypeId NodeDocument
                       , toField u
                       , toField p
-                      , toField $ maybe "No Title" (DT.take 255)  (_hyperdataDocument_title h)
-                      , toField $ _hyperdataDocument_publication_date h -- TODO USE UTCTime
+                      , toField $ maybe "No Title" (DT.take 255)  (_hd_title h)
+                      , toField $ _hd_publication_date h -- TODO USE UTCTime
                       , (toField . toJSON) h
                       ]
 
@@ -202,17 +198,17 @@ instance AddUniqId HyperdataDocument
     addUniqId = addUniqIdsDoc
       where
         addUniqIdsDoc :: HyperdataDocument -> HyperdataDocument
-        addUniqIdsDoc doc = set hyperdataDocument_uniqIdBdd (Just shaBdd)
-                          $ set hyperdataDocument_uniqId    (Just shaUni) doc
+        addUniqIdsDoc doc = set hd_uniqIdBdd (Just shaBdd)
+                          $ set hd_uniqId    (Just shaUni) doc
           where
-            shaUni = sha $ DT.concat $ map ($ doc) shaParametersDoc
-            shaBdd = sha $ DT.concat $ map ($ doc) ([(\d -> maybeText (_hyperdataDocument_bdd d))] <> shaParametersDoc)
+            shaUni = hash $ DT.concat $ map ($ doc) shaParametersDoc
+            shaBdd = hash $ DT.concat $ map ($ doc) ([(\d -> maybeText (_hd_bdd d))] <> shaParametersDoc)
 
         shaParametersDoc :: [(HyperdataDocument -> Text)]
-        shaParametersDoc = [ \d -> maybeText (_hyperdataDocument_title    d)
-                            , \d -> maybeText (_hyperdataDocument_abstract d)
-                            , \d -> maybeText (_hyperdataDocument_source   d)
-                            , \d -> maybeText (_hyperdataDocument_publication_date   d)
+        shaParametersDoc = [ \d -> maybeText (_hd_title    d)
+                            , \d -> maybeText (_hd_abstract d)
+                            , \d -> maybeText (_hd_source   d)
+                            , \d -> maybeText (_hd_publication_date   d)
                             ]
 
     ---------------------------------------------------------------------------
@@ -227,11 +223,8 @@ addUniqIdsContact :: HyperdataContact -> HyperdataContact
 addUniqIdsContact hc = set (hc_uniqIdBdd) (Just shaBdd)
                      $ set (hc_uniqId   ) (Just shaUni) hc
   where
-    shaUni = uniqId $ DT.concat $ map ($ hc) shaParametersContact
-    shaBdd = uniqId $ DT.concat $ map ($ hc) ([\d -> maybeText (view hc_bdd d)] <> shaParametersContact)
-
-    uniqId :: Text -> Text
-    uniqId = DT.pack . SHA.showDigest . SHA.sha256 . DC.pack . DT.unpack
+    shaUni = hash $ DT.concat $ map ($ hc) shaParametersContact
+    shaBdd = hash $ DT.concat $ map ($ hc) ([\d -> maybeText (view hc_bdd d)] <> shaParametersContact)
 
     -- | TODO add more shaparameters
     shaParametersContact :: [(HyperdataContact -> Text)]

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

@@ -19,6 +19,7 @@ Portability : POSIX
 
 module Gargantext.Database.Query.Table.Node.Error where
 
+import Data.Text (Text)
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Control.Lens (Prism', (#), (^?))
 import Control.Monad.Error.Class (MonadError(..))
@@ -38,6 +39,8 @@ data NodeError = NoListFound
                | NotImplYet
                | ManyNodeUsers
                | DoesNotExist NodeId
+               | NeedsConfiguration
+               | NodeError Text
 
 instance Show NodeError
   where
@@ -53,11 +56,18 @@ instance Show NodeError
     show NotImplYet    = "Not implemented yet"
     show ManyParents   = "Too many parents"
     show ManyNodeUsers = "Many userNode/user"
-    show (DoesNotExist n) = "Node does not exist" <> show n
+    show (DoesNotExist n)   = "Node does not exist" <> show n
+    show NeedsConfiguration = "Needs configuration"
+    show (NodeError e)      = "NodeError: " <> cs e
 
 class HasNodeError e where
   _NodeError :: Prism' e NodeError
 
+errorWith :: ( MonadError e m
+            , HasNodeError e)
+          => Text -> m a
+errorWith x = nodeError (NodeError x)
+
 nodeError :: ( MonadError e m
              , HasNodeError e)
           => NodeError -> m a

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

@@ -15,124 +15,25 @@ Portability : POSIX
 module Gargantext.Database.Query.Table.Node.User
   where
 
-import Control.Lens (makeLenses)
-import Data.Aeson.TH (deriveJSON)
 import Data.Maybe (fromMaybe)
-import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
-import Data.Text (Text)
-import Database.PostgreSQL.Simple.FromField (FromField, fromField)
-import GHC.Generics (Generic)
-import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types (Name)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Admin.Types.Node (Node, DocumentId, NodeId(..), UserId, NodeType(..), pgNodeId)
-import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata)
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..), defaultHyperdataUser)
+import Gargantext.Database.Admin.Types.Node (Node, NodeId(..), UserId, NodeType(..), pgNodeId)
 import Gargantext.Database.Prelude -- (fromField', Cmd)
 import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.Contact (HyperdataContact, fake_HyperdataContact)
 import Gargantext.Database.Schema.Node -- (Node(..))
 import Gargantext.Prelude
-import Opaleye hiding (FromField)
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import Opaleye (limit)
 
-------------------------------------------------------------------------
-data HyperdataUser =
-     HyperdataUser { _hu_private   :: !(Maybe HyperdataPrivate)
-                   , _hu_shared    :: !(Maybe HyperdataContact)
-                   , _hu_public    :: !(Maybe HyperdataPublic)
-                   } deriving (Eq, Show, Generic)
 
-data HyperdataPrivate =
-     HyperdataPrivate { _hpr_password :: !Text
-                      , _hpr_lang     :: !Lang
-                      }
-     deriving (Eq, Show, Generic)
-
-data HyperdataPublic =
-     HyperdataPublic { _hpu_pseudo :: !Text
-                     , _hpu_publications :: ![DocumentId]
-                     }
-     deriving (Eq, Show, Generic)
-
--- | Fake instances
-
-fake_HyperdataUser :: HyperdataUser
-fake_HyperdataUser = HyperdataUser (Just fake_HyperdataPrivate)
-                                   (Just fake_HyperdataContact)
-                                   (Just fake_HyperdataPublic)
-
-fake_HyperdataPublic :: HyperdataPublic
-fake_HyperdataPublic = HyperdataPublic "pseudo" [1..10]
-
-fake_HyperdataPrivate :: HyperdataPrivate
-fake_HyperdataPrivate = HyperdataPrivate "password" EN
-
--- | ToSchema instances
-instance ToSchema HyperdataUser where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hu_")
-
-instance ToSchema HyperdataPrivate where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hpr_")
-
-instance ToSchema HyperdataPublic where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hpu_")
-
-
--- | Arbitrary instances
-instance Arbitrary HyperdataUser where
-  arbitrary = HyperdataUser <$> arbitrary <*> arbitrary <*> arbitrary
-
-instance Arbitrary HyperdataPrivate where
-  arbitrary = elements [HyperdataPrivate "" EN]
-
-instance Arbitrary HyperdataPublic where
-  arbitrary = elements [HyperdataPublic "pseudo" [NodeId 2]]
-
-
--- | Specific Gargantext instance
-instance Hyperdata HyperdataUser
-instance Hyperdata HyperdataPrivate
-instance Hyperdata HyperdataPublic
-
--- | Database (Posgresql-simple instance)
-instance FromField HyperdataUser where
-  fromField = fromField'
-instance FromField HyperdataPrivate where
-  fromField = fromField'
-instance FromField HyperdataPublic where
-  fromField = fromField'
-
--- | Database (Opaleye instance)
-instance QueryRunnerColumnDefault PGJsonb HyperdataUser   where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-instance QueryRunnerColumnDefault PGJsonb HyperdataPrivate   where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-instance QueryRunnerColumnDefault PGJsonb HyperdataPublic   where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
-
--- | All lenses
-makeLenses ''HyperdataUser
-makeLenses ''HyperdataPrivate
-makeLenses ''HyperdataPublic
-
--- | All Json instances
-$(deriveJSON (unPrefix "_hu_") ''HyperdataUser)
-$(deriveJSON (unPrefix "_hpr_") ''HyperdataPrivate)
-$(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic)
-
-
------------------------------------------------------------------
 getNodeUser :: NodeId -> Cmd err (Node HyperdataUser)
 getNodeUser nId = do
     fromMaybe (panic $ "Node does not exist: " <> (cs $ show nId)) . headMay
              <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
 
-
 nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite
 nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing
   where
     name = maybe "User" identity maybeName
-    user = maybe fake_HyperdataUser identity maybeHyperdata
+    user = maybe defaultHyperdataUser identity maybeHyperdata
+

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

@@ -28,6 +28,7 @@ module Gargantext.Database.Query.Table.NodeNode
   , getNodeNode
   , insertNodeNode
   , deleteNodeNode
+  , selectPublicNodes
   )
   where
 
@@ -122,7 +123,7 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
 selectDocsDates :: CorpusId -> Cmd err [Text]
 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
                    <$> catMaybes
-                   <$> map (view hyperdataDocument_publication_date)
+                   <$> map (view hd_publication_date)
                    <$> selectDocs cId
 
 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
@@ -153,3 +154,21 @@ joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 
+joinOn1 :: O.Query (NodeRead, NodeNodeReadNull)
+joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
+  where
+    cond :: (NodeRead, NodeNodeRead) -> Column PGBool
+    cond (n, nn) = nn^.nn_node1_id .== n^.node_id
+
+
+------------------------------------------------------------------------
+selectPublicNodes :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
+                  => Cmd err [(Node a, Maybe Int)]
+selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
+
+queryWithType :: NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
+queryWithType nt = proc () -> do
+  (n, nn) <- joinOn1 -< ()
+  restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId nt)
+  returnA  -<  (n, nn^.nn_node2_id)
+

src/Gargantext/Database/Query/Tree.hs

@@ -40,7 +40,7 @@ import Data.Text (Text)
 import Database.PostgreSQL.Simple
 import Database.PostgreSQL.Simple.SqlQQ
 import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
-import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId)
+import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId, fromNodeTypeId)
 import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTypes)
 import Gargantext.Database.Admin.Types.Node -- (pgNodeId, NodeType(..))
 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
@@ -88,28 +88,49 @@ tree_advanced :: HasTreeError err
        -> [NodeType]
        -> Cmd err (Tree NodeTree)
 tree_advanced r nodeTypes = do
-  mainRoot    <- dbTree r nodeTypes
-  sharedRoots <- findShared r nodeTypes
-  toTree      $ toTreeParent (mainRoot <> sharedRoots)
+  mainRoot    <- dbTree     r nodeTypes
+  sharedRoots <- findShared r NodeFolderShared nodeTypes sharedTreeUpdate
+  publicRoots <- findShared r NodeFolderPublic nodeTypes publicTreeUpdate
+  toTree      $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
 
 ------------------------------------------------------------------------
 -- | Collaborative Nodes in the Tree
-findShared :: RootId -> [NodeType] -> Cmd err [DbTreeNode]
-findShared r nt = do
-  folderSharedId <- maybe (panic "no folder found") identity
-                <$> head
-                <$> findNodesId r [NodeFolderShared]
-  folders <- getNodeNode folderSharedId
-  nodesSharedId <- mapM (\child -> sharedTree folderSharedId child nt)
-                   $ map _nn_node2_id folders
+findShared :: HasTreeError err
+           => RootId -> NodeType -> [NodeType] -> UpdateTree err
+           -> Cmd err [DbTreeNode]
+findShared r nt nts fun = do
+  foldersSharedId <- findNodesId r [nt]
+  trees       <- mapM (updateTree nts fun) foldersSharedId
+  pure $ concat trees
+
+
+updateTree :: HasTreeError err
+           => [NodeType] -> UpdateTree err -> RootId
+           -> Cmd err [DbTreeNode]
+updateTree nts fun r = do
+  folders       <- getNodeNode r
+  nodesSharedId <- mapM (fun r nts)
+                 $ map _nn_node2_id folders
   pure $ concat nodesSharedId
 
-sharedTree :: ParentId -> NodeId -> [NodeType] -> Cmd err [DbTreeNode]
-sharedTree p n nt = dbTree n nt
-               <&> map (\n' -> if _dt_nodeId n' == n 
+
+type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode]
+ 
+sharedTreeUpdate :: HasTreeError err => UpdateTree err
+sharedTreeUpdate p nt n = dbTree n nt
+               <&> map (\n' -> if _dt_nodeId n' == n
+                                  then set dt_parentId (Just p) n'
+                                  else n')
+
+publicTreeUpdate :: HasTreeError err => UpdateTree err
+publicTreeUpdate p nt n = dbTree n nt
+               <&> map (\n' -> if _dt_nodeId n' == n
+                                -- && (fromNodeTypeId $ _dt_typeId n') /= NodeFolderPublic
                                   then set dt_parentId (Just p) n'
                                   else n')
 
+
+
 -- | findNodesId returns all nodes matching nodeType but the root (Nodeuser)
 findNodesId :: RootId -> [NodeType] -> Cmd err [NodeId]
 findNodesId r nt = tail

src/Gargantext/Database/Query/Tree/Root.hs

@@ -27,7 +27,7 @@ import Gargantext.Database.Admin.Config (nodeTypeId, userMaster)
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.User (HyperdataUser)
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
 import Gargantext.Database.Action.Flow.Utils (getUserId)
 import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead)
 import Gargantext.Database.Schema.Node (queryNodeTable)
@@ -89,7 +89,7 @@ getOrMk_RootWithCorpus user cName c = do
                     c' <- mk (Just $ fromLeft "Default" cName) c rootId userId
                     _tId <- case head c' of
                               Nothing -> pure [0]
-                              Just c'' -> mkNode NodeTexts c'' userId
+                              Just c'' -> insertDefaultNode NodeTexts c'' userId
                     pure c'
 
   corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId')
@@ -147,4 +147,4 @@ selectRoot (RootId nid) =
     restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
     restrict -< _node_id   row   .== (pgNodeId nid)
     returnA  -< row
-
+selectRoot UserPublic = panic "No root for Public"

src/Gargantext/Ext/IMTUser.hs

@@ -20,7 +20,7 @@ import Codec.Serialise
 import Data.Maybe (Maybe, catMaybes)
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Gargantext.Database.Query.Table.Node.Contact -- (HyperdataContact, ContactWho, ContactWhere, ContactTouch, ContactMetaData)
+import Gargantext.Database.Admin.Types.Hyperdata.Contact
 import Gargantext.Prelude
 import System.IO (FilePath)
 import qualified Data.ByteString.Lazy as BSL

src/Gargantext/Prelude.hs

@@ -26,6 +26,7 @@ module Gargantext.Prelude
   , sortWith
   , module Prelude
   , MonadBase(..)
+  , Typeable
   )
   where
 
@@ -36,6 +37,7 @@ import GHC.Real (round)
 import Data.Map (Map, lookup)
 import Data.Maybe (isJust, fromJust, maybe)
 import Data.Text (Text)
+import Data.Typeable (Typeable)
 import Protolude ( Bool(True, False), Int, Int64, Double, Integer
                  , Fractional, Num, Maybe(Just,Nothing)
                  , Enum, Bounded, Float

src/Gargantext/Prelude/Utils.hs

@@ -9,10 +9,14 @@ Portability : POSIX
 
 -}
 
+{-# OPTIONS_GHC -fno-warn-orphans   #-}
 
 module Gargantext.Prelude.Utils
   where
 
+import Prelude (String)
+import Data.Set (Set)
+import Data.List (foldl)
 import Control.Lens (view)
 import Control.Monad.Random.Class (MonadRandom)
 import Control.Monad.Reader (MonadReader)
@@ -26,6 +30,7 @@ import System.Directory (createDirectoryIfMissing)
 import System.Random (newStdGen)
 import qualified Data.ByteString.Lazy.Char8  as Char
 import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
+import qualified Data.Set                    as Set
 import qualified Data.Text                   as Text
 import qualified System.Random.Shuffle as SRS
 
@@ -34,12 +39,32 @@ shuffle :: MonadRandom m => [a] -> m [a]
 shuffle ns = SRS.shuffleM ns 
 
 --------------------------------------------------------------------------
-sha :: Text -> Text
-sha = Text.pack
-     . SHA.showDigest
-     . SHA.sha256
-     . Char.pack
-     . Text.unpack
+-- | Use this datatype to keep traceability of hashes
+-- TODO use newtype
+type Hash = Text
+
+-- | Class to make hashes
+class IsHashable a where
+  hash :: a -> Hash
+
+-- | Main API to hash text
+-- using sha256 for now
+instance IsHashable Char.ByteString where
+  hash = Text.pack
+        . SHA.showDigest
+        . SHA.sha256
+
+instance {-# OVERLAPPING #-} IsHashable String where
+  hash = hash . Char.pack
+
+instance IsHashable Text where
+  hash = hash . Text.unpack
+
+instance IsHashable (Set Hash) where
+  hash = hash . foldl (<>) "" . Set.toList
+
+instance {-# OVERLAPPABLE #-} IsHashable a => IsHashable [a] where
+  hash = hash . Set.fromList . map hash
 
 --------------------------------------------------------------------------
 data NodeToHash = NodeToHash { nodeType :: NodeType
@@ -66,14 +91,14 @@ writeFile :: (MonadReader env m, MonadBase IO m, HasSettings env, SaveFile a)
          => a -> m FilePath
 writeFile a = do
   dataPath <- view (settings . fileFolder) <$> ask
-  (fp,fn)  <- liftBase $ (toPath 3) . sha . Text.pack . show <$> newStdGen
-  
+  (fp,fn)  <- liftBase $ (toPath 3) . hash . show <$> newStdGen
+
   let foldPath = dataPath <> "/" <> fp
       filePath = foldPath <> "/" <> fn
-  
+
   _ <- liftBase $ createDirectoryIfMissing True foldPath
   _ <- liftBase $ saveFile' filePath a
-  
+
   pure filePath
 
 

src/Gargantext/Text/Corpus/Parsers/CSV.hs

@@ -169,13 +169,13 @@ instance ToNamedRecord CsvDoc where
                ]
 
 hyperdataDocument2csvDoc :: HyperdataDocument -> CsvDoc
-hyperdataDocument2csvDoc h = CsvDoc (m $ _hyperdataDocument_title h)
-                                    (m $ _hyperdataDocument_source h)
-                                    (mI $ _hyperdataDocument_publication_year h)
-                                    (mI $ _hyperdataDocument_publication_month h)
-                                    (mI $ _hyperdataDocument_publication_day   h)
-                                    (m $ _hyperdataDocument_abstract h)
-                                    (m $ _hyperdataDocument_authors h)
+hyperdataDocument2csvDoc h = CsvDoc (m  $ _hd_title h)
+                                    (m  $ _hd_source h)
+                                    (mI $ _hd_publication_year h)
+                                    (mI $ _hd_publication_month h)
+                                    (mI $ _hd_publication_day   h)
+                                    (m  $ _hd_abstract h)
+                                    (m  $ _hd_authors h)
 
   where
     m = maybe "" identity

src/Gargantext/Viz/AdaptativePhylo.hs

@@ -31,7 +31,6 @@ import Data.Aeson.TH (deriveJSON)
 import Data.Text   (Text, pack)
 import Data.Vector (Vector)
 import Data.Map (Map)
-import Data.Set (Set)
 
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Prelude
@@ -144,11 +143,11 @@ defaultConfig =
             , phyloName      = pack "Default Phylo"
             , phyloLevel     = 2
             , phyloProximity = WeightedLogJaccard 10
-            , seaElevation   = Constante 0 0.1
+            , seaElevation   = Constante 0.6 1
             , phyloSynchrony = ByProximityThreshold 0.5 10 SiblingBranches MergeAllGroups
-            , phyloQuality   = Quality 0.6 1
+            , phyloQuality   = Quality 100 1
             , timeUnit       = Year 3 1 5
-            , clique         = Fis 1 5
+            , clique         = MaxClique 0
             , exportLabel    = [BranchLabel MostInclusive 2, GroupLabel MostEmergentInclusive 2]
             , exportSort     = ByHierarchy
             , exportFilter   = [ByBranchSize 2]  
@@ -267,6 +266,7 @@ data Phylo =
            , _phylo_timeCooc    :: !(Map Date Cooc)
            , _phylo_timeDocs    :: !(Map Date Double)
            , _phylo_termFreq    :: !(Map Int Double)
+           , _phylo_horizon     :: !(Map (PhyloGroupId,PhyloGroupId) Double)           
            , _phylo_groupsProxi :: !(Map (PhyloGroupId,PhyloGroupId) Double)
            , _phylo_param       :: PhyloParam
            , _phylo_periods     :: Map PhyloPeriodId PhyloPeriod
@@ -347,12 +347,22 @@ data PointerType = TemporalPointer | LevelPointer deriving (Generic, Show)
 type Support  = Int
 
 data PhyloClique = PhyloClique
-  { _phyloClique_nodes   :: Set Ngrams
+  { _phyloClique_nodes   :: [Int]
   , _phyloClique_support :: Support
   , _phyloClique_period  :: (Date,Date)
   } deriving (Generic,NFData,Show,Eq)
 
 
+------------------------
+-- | Phylo Ancestor | --
+------------------------
+
+data PhyloAncestor = PhyloAncestor
+  { _phyloAncestor_id   :: Int
+  , _phyloAncestor_ngrams :: [Int]
+  , _phyloAncestor_groups :: [PhyloGroupId]
+  } deriving (Generic,NFData,Show,Eq)
+
 ----------------
 -- | Export | --
 ----------------
@@ -393,8 +403,9 @@ data PhyloBranch =
 
 data PhyloExport =
       PhyloExport
-      { _export_groups   :: [PhyloGroup]
-      , _export_branches :: [PhyloBranch]
+      { _export_groups    :: [PhyloGroup]
+      , _export_branches  :: [PhyloBranch]
+      , _export_ancestors :: [PhyloAncestor]
       } deriving (Generic, Show)
 
 ----------------

src/Gargantext/Viz/Graph.hs

@@ -18,21 +18,14 @@ module Gargantext.Viz.Graph
 
 
 import Control.Lens (makeLenses)
-import Data.Aeson.TH (deriveJSON)
 import Data.ByteString.Lazy as DBL (readFile, writeFile)
-import Data.Swagger
 import Data.Text (Text, pack)
-import Database.PostgreSQL.Simple.FromField (FromField, fromField)
-import GHC.Generics (Generic)
 import GHC.IO (FilePath)
 import Gargantext.Core.Types (ListId)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata)
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Viz.Graph.Distances (GraphMetric)
-import Gargantext.Database.Prelude (fromField')
 import Gargantext.Prelude
-import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import qualified Data.Aeson as DA
@@ -43,7 +36,8 @@ import qualified Text.Read as T
 data TypeNode = Terms | Unknown
   deriving (Show, Generic)
 
-$(deriveJSON (unPrefix "") ''TypeNode)
+instance ToJSON TypeNode
+instance FromJSON TypeNode
 instance ToSchema TypeNode
 
 data Attributes = Attributes { clust_default :: Int }
@@ -72,7 +66,9 @@ data Edge = Edge { edge_source :: Text
                  , edge_id     :: Text
                  }
   deriving (Show, Generic)
+
 $(deriveJSON (unPrefix "edge_") ''Edge)
+
 instance ToSchema Edge where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "edge_")
 
@@ -116,8 +112,8 @@ instance ToSchema GraphMetadata where
 makeLenses ''GraphMetadata
 
 
-data Graph = Graph { _graph_nodes :: [Node]
-                   , _graph_edges :: [Edge]
+data Graph = Graph { _graph_nodes    :: [Node]
+                   , _graph_edges    :: [Edge]
                    , _graph_metadata :: Maybe GraphMetadata
                    }
   deriving (Show, Generic)
@@ -163,13 +159,17 @@ data GraphV3 = GraphV3 { go_links :: [EdgeV3]
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "go_") ''GraphV3)
 
------------------------------------------------------------
 
+-----------------------------------------------------------
 data HyperdataGraph =
   HyperdataGraph { _hyperdataGraph :: !(Maybe Graph)
                  } deriving (Show, Generic)
 $(deriveJSON (unPrefix "") ''HyperdataGraph)
 
+defaultHyperdataGraph :: HyperdataGraph 
+defaultHyperdataGraph = HyperdataGraph Nothing
+
+
 instance Hyperdata HyperdataGraph
 makeLenses ''HyperdataGraph
 
@@ -182,7 +182,6 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataGraph
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
 -----------------------------------------------------------
-
 graphV3ToGraph :: GraphV3 -> Graph
 graphV3ToGraph (GraphV3 links nodes) = Graph (map nodeV32node nodes) (zipWith linkV32edge [1..] links) Nothing
   where

src/Gargantext/Viz/Graph/API.hs

@@ -149,7 +149,7 @@ computeGraph cId d nt repo = do
 
   -- TODO split diagonal
   myCooc <- Map.filter (>1)
-         <$> getCoocByNgrams (Diagonal False)
+         <$> getCoocByNgrams (Diagonal True)
          <$> groupNodesByNgrams ngs
          <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
 

src/Gargantext/Viz/Graph/Tools.hs

@@ -60,7 +60,9 @@ cooc2graph distance threshold myCooc = do
   let
     (ti, _) = createIndices myCooc
     myCooc' = toIndex ti myCooc
-    matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
+    matCooc = map2mat 0 (Map.size ti)
+            $ Map.filterWithKey (\(a,b) _ -> a /= b) 
+            $ Map.filter (> 1) myCooc'
     distanceMat = measure distance matCooc
     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
 

src/Gargantext/Viz/Phylo/API.hs

@@ -17,6 +17,7 @@ Portability : POSIX
 module Gargantext.Viz.Phylo.API
   where
 
+import Control.Lens ((^.))
 import Data.String.Conversions
 --import Control.Monad.Reader (ask)
 import qualified Data.ByteString as DB
@@ -32,8 +33,8 @@ import Web.HttpApiData (parseUrlPiece, readTextData)
 import Gargantext.API.Prelude
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
-import Gargantext.Database.Query.Table.Node (insertNodes, nodePhyloW, getNodeWith)
-import Gargantext.Database.Schema.Node (_node_hyperdata)
+import Gargantext.Database.Query.Table.Node (insertNodes, node, getNodeWith)
+import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
 import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Main
@@ -95,15 +96,16 @@ type GetPhylo =  QueryParam "listId"      ListId
 -- Add real text processing
 -- Fix Filter parameters
 getPhylo :: PhyloId -> GargServer GetPhylo
---getPhylo phId _lId l msb _f _b _l' _ms _x _y _z _ts _s _o _e _d _b' = do
 getPhylo phId _lId l msb  = do
   phNode     <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo)
   let
     level = maybe 2 identity l
     branc = maybe 2 identity msb
-    maybePhylo = hyperdataPhylo_data $ _node_hyperdata phNode
+    maybePhylo = phNode ^. (node_hyperdata . hp_data)
 
-  p <- liftBase $ viewPhylo2Svg $ viewPhylo level branc  $ maybe phyloFromQuery identity maybePhylo
+  p <- liftBase $ viewPhylo2Svg
+                $ viewPhylo level branc
+                $ maybe phyloFromQuery identity maybePhylo
   pure (SVG p)
 ------------------------------------------------------------------------
 type PostPhylo =  QueryParam "listId" ListId
@@ -119,7 +121,7 @@ postPhylo n userId _lId = do
     -- _sft = Just (Software "Gargantext" "4")
     -- _prm = initPhyloParam vrs sft (Just q)
   phy  <- flowPhylo n
-  pId <- insertNodes [nodePhyloW (Just "Phylo") (Just $ HyperdataPhylo Nothing (Just phy)) n userId]
+  pId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just n) userId]
   pure $ NodeId (fromIntegral pId)
 
 ------------------------------------------------------------------------

src/Gargantext/Viz/Phylo/Main.hs

@@ -52,8 +52,8 @@ flowPhylo cId = do
   termList <- Map.toList <$> getTermsWith Text.words [list] NgramsTerms MapTerm
 
   docs' <- catMaybes
-          <$> map (\h -> (,) <$> _hyperdataDocument_publication_year h
-                             <*> _hyperdataDocument_abstract h
+          <$> map (\h -> (,) <$> _hd_publication_year h
+                             <*> _hd_abstract h
                   )
           <$> selectDocs cId
 

src/Gargantext/Viz/Phylo/PhyloExample.hs

@@ -104,7 +104,7 @@ config =
     defaultConfig { phyloName  = "Cesar et Cleopatre"
                   , phyloLevel = 2
                   , exportFilter = [ByBranchSize 0]
-                  , clique = Fis 0 0 }
+                  , clique = MaxClique 0 }
 
 
 docs :: [Document]
@@ -127,9 +127,31 @@ mapList = map (\a -> ([toLower a],[])) actants
 
 
 actants :: [Ngrams]
-actants = [ "Cleopatre"   , "Ptolemee", "Ptolemee-XIII", "Ptolemee-XIV"
+actants = [ "Cleopatre"   , "Ptolemee", "Ptolemee-XIII", "Ptolemee-XIV", "Ptolemee-X", "Berenice-III"
           , "Marc-Antoine", "Cesar"   , "Antoine"      , "Octave"  , "Rome"
-          , "Alexandrie"  , "Auguste" , "Pompee"       , "Cassius" , "Brutus"]
+          , "Alexandrie"  , "Auguste" , "Pompee"       , "Cassius" , "Brutus", "Caesar-III", "Aurelia-Cotta", "Pisae", "Pline"]
 
 corpus :: [(Date, Text)]
-corpus = sortOn fst [ (-51,"Cleopatre règne sur l’egypte entre 51 et 30 av. J.-C. avec ses frères-epoux Ptolemee-XIII et Ptolemee-XIV, puis aux côtes du general romain Marc-Antoine. Elle est celèbre pour avoir ete la compagne de Jules Cesar puis d'Antoine, avec lesquels elle a eu plusieurs enfants. Partie prenante dans la guerre civile opposant Antoine à Octave, elle est vaincue à la bataille d'Actium en 31 av. J.-C. Sa defaite va permettre aux Romains de mener à bien la conquête de l’egypte, evenement qui marquera la fin de l'epoque hellenistique."), (-40,"Il existe relativement peu d'informations sur son sejour à Rome, au lendemain de l'assassinat de Cesar, ou sur la periode passee à Alexandrie durant l'absence d'Antoine, entre -40 et -37."), (-48,"L'historiographie antique lui est globalement defavorable car inspiree par son vainqueur, l'empereur Auguste, et par son entourage, dont l'interêt est de la noircir, afin d'en faire l'adversaire malfaisant de Rome et le mauvais genie d'Antoine. On observe par ailleurs que Cesar ne fait aucune mention de sa liaison avec elle dans les Commentaires sur la Guerre civile"), (-69,"Cleopatre est nee au cours de l'hiver -69/-686 probablement à Alexandrie."), (-48,"Pompee a en effet ete le protecteur de Ptolemee XII, le père de Cleopatre et de Ptolemee-XIII dont il se considère comme le tuteur."), (-48,"Ptolemee-XIII et Cleopatre auraient d'ailleurs aide Pompee par l'envoi d'une flotte de soixante navires."), (-48,"Mais le jeune roi Ptolemee-XIII et ses conseillers jugent sa cause perdue et pensent s'attirer les bonnes graces du vainqueur en le faisant assassiner à peine a-t-il pose le pied sur le sol egyptien, près de Peluse, le 30 juillet 48 av. J.-C., sous les yeux de son entourage."), (-48,"Cesar fait enterrer la tête de Pompee dans le bosquet de Nemesis en bordure du mur est de l'enceinte d'Alexandrie. Pour autant la mort de Pompee est une aubaine pour Cesar qui tente par ailleurs de profiter des querelles dynastiques pour annexer l’egypte."), (-48,"Il est difficile de se prononcer clairement sur les raisons qui ont pousse Cesar à s'attarder à Alexandrie. Il y a des raisons politiques, mais aussi des raisons plus sentimentales (Cleopatre ?). Il tente d'abord d'obtenir le remboursement de dettes que Ptolemee XII"), (-46,"Les deux souverains sont convoques par Cesar au palais royal d'Alexandrie. Ptolemee-XIII s'y rend après diverses tergiversations ainsi que Cleopatre."), (-47,"A Rome, Cleopatre epouse alors un autre de ses frères cadets, à Alexandrie, Ptolemee-XIV, sur l'injonction de Jules Cesar"), (-46,"Cesar a-t-il comme objectif de montrer ce qu'il en coûte de se revolter contre Rome en faisant figurer dans son triomphe la sœur de Cleopatre et de Ptolemee-XIV, Arsinoe, qui s'est fait reconnaître reine par les troupes de Ptolemee-XIII ?"), (-44,"Au debut de l'annee -44, Cesar est assassine par Brutus. Profitant de la situation confuse qui s'ensuit, Cleopatre quitte alors Rome à la mi-avril, faisant escale en Grèce. Elle parvient à Alexandrie en juillet -44."), (-44,"La guerre que se livrent les assassins de Cesar, Cassius et Brutus et ses heritiers, Octave et Marc-Antoine, oblige Cleopatre à des contorsions diplomatiques."), (-41,"Nous ignorons depuis quand Cleopatre, agee de 29 ans en -41, et Marc-Antoine, qui a une quarantaine d'annees, se connaissent. Marc-Antoine est l'un des officiers qui ont participe au retablissement de Ptolemee XII.  Il est plus vraisemblable qu'ils se soient frequentes lors du sejour à Rome de Cleopatre."), (-42,"Brutus tient la Grèce tandis que Cassius s'installe en Syrie. Le gouverneur de Cleopatre à Chypre, Serapion, vient en aide à Cassius."), (-42,"Cassius aurait envisage de s'emparer d'Alexandrie quand le 'debarquement' en Grèce d'Antoine et d'Octave l'oblige à renoncer à ses projets")]          
\ No newline at end of file
+corpus = sortOn fst [ 
+  (-101,"La tutelle de sa mère lui étant difficile à endurer, en septembre 101 av. J.-C., Ptolemee-X la fait assassiner et peut enfin régner presque seul puisqu'il partage le pouvoir avec son épouse Berenice-III Cléopâtre Philopator."),
+  (-99,"Caesar-III est questeur en 99 av. J.-C. ou 98 av. J.-C., et préteur en 92 av. J.-C.."),
+  (-100,"Caius Julius Caesar-IV — dit Jules Cesar — naît vers 100 av. J.-C., il est le fils de Caius Julius Caesar-III et de Aurelia-Cotta"),
+  (-85,"Caesar-III meurt à Pisae de cause naturelle en 85 av. J.-C. : selon Pline l'Ancien, il décède brusquement en mettant ses chaussures"),
+  (-53,"Aurelia-Cotta décède peu de temps avant le meurtre de Clodius Pulcher, vers 53 av. J.-C."),
+  (-51,"Cleopatre règne sur l’egypte entre 51 et 30 av. J.-C. avec ses frères-epoux Ptolemee-XIII et Ptolemee-XIV, puis aux côtes du general romain Marc-Antoine. Elle est celèbre pour avoir ete la compagne de Jules Cesar puis d'Antoine, avec lesquels elle a eu plusieurs enfants. Partie prenante dans la guerre civile opposant Antoine à Octave, elle est vaincue à la bataille d'Actium en 31 av. J.-C. Sa defaite va permettre aux Romains de mener à bien la conquête de l’egypte, evenement qui marquera la fin de l'epoque hellenistique."), 
+  (-40,"Il existe relativement peu d'informations sur son sejour à Rome, au lendemain de l'assassinat de Cesar, ou sur la periode passee à Alexandrie durant l'absence d'Antoine, entre -40 et -37."), 
+  (-48,"L'historiographie antique lui est globalement defavorable car inspiree par son vainqueur, l'empereur Auguste, et par son entourage, dont l'interêt est de la noircir, afin d'en faire l'adversaire malfaisant de Rome et le mauvais genie d'Antoine. On observe par ailleurs que Cesar ne fait aucune mention de sa liaison avec elle dans les Commentaires sur la Guerre civile"), 
+  (-69,"Cleopatre est nee au cours de l'hiver -69/-686 probablement à Alexandrie."), 
+  (-48,"Pompee a en effet ete le protecteur de Ptolemee XII, le père de Cleopatre et de Ptolemee-XIII dont il se considère comme le tuteur."), 
+  (-48,"Ptolemee-XIII et Cleopatre auraient d'ailleurs aide Pompee par l'envoi d'une flotte de soixante navires."), 
+  (-48,"Mais le jeune roi Ptolemee-XIII et ses conseillers jugent sa cause perdue et pensent s'attirer les bonnes graces du vainqueur en le faisant assassiner à peine a-t-il pose le pied sur le sol egyptien, près de Peluse, le 30 juillet 48 av. J.-C., sous les yeux de son entourage."), 
+  (-48,"Cesar fait enterrer la tête de Pompee dans le bosquet de Nemesis en bordure du mur est de l'enceinte d'Alexandrie. Pour autant la mort de Pompee est une aubaine pour Cesar qui tente par ailleurs de profiter des querelles dynastiques pour annexer l’egypte."), 
+  (-48,"Il est difficile de se prononcer clairement sur les raisons qui ont pousse Cesar à s'attarder à Alexandrie. Il y a des raisons politiques, mais aussi des raisons plus sentimentales (Cleopatre ?). Il tente d'abord d'obtenir le remboursement de dettes que Ptolemee XII"), 
+  (-46,"Les deux souverains sont convoques par Cesar au palais royal d'Alexandrie. Ptolemee-XIII s'y rend après diverses tergiversations ainsi que Cleopatre."), 
+  (-47,"A Rome, Cleopatre epouse alors un autre de ses frères cadets, à Alexandrie, Ptolemee-XIV, sur l'injonction de Jules Cesar"), 
+  (-46,"Cesar a-t-il comme objectif de montrer ce qu'il en coûte de se revolter contre Rome en faisant figurer dans son triomphe la sœur de Cleopatre et de Ptolemee-XIV, Arsinoe, qui s'est fait reconnaître reine par les troupes de Ptolemee-XIII ?"), 
+  (-44,"Au debut de l'annee -44, Cesar est assassine par Brutus. Profitant de la situation confuse qui s'ensuit, Cleopatre quitte alors Rome à la mi-avril, faisant escale en Grèce. Elle parvient à Alexandrie en juillet -44."), 
+  (-44,"La guerre que se livrent les assassins de Cesar, Cassius et Brutus et ses heritiers, Octave et Marc-Antoine, oblige Cleopatre à des contorsions diplomatiques."), 
+  (-41,"Nous ignorons depuis quand Cleopatre, agee de 29 ans en -41, et Marc-Antoine, qui a une quarantaine d'annees, se connaissent. Marc-Antoine est l'un des officiers qui ont participe au retablissement de Ptolemee XII.  Il est plus vraisemblable qu'ils se soient frequentes lors du sejour à Rome de Cleopatre."), 
+  (-42,"Brutus tient la Grèce tandis que Cassius s'installe en Syrie. Le gouverneur de Cleopatre à Chypre, Serapion, vient en aide à Cassius."), 
+  (-42,"Cassius aurait envisage de s'emparer d'Alexandrie quand le 'debarquement' en Grèce d'Antoine et d'Octave l'oblige à renoncer à ses projets")]          
\ No newline at end of file

src/Gargantext/Viz/Phylo/PhyloExport.hs

@@ -19,7 +19,7 @@ import Data.Vector (Vector)
 import Prelude (writeFile)
 import Gargantext.Prelude
 import Gargantext.Viz.AdaptativePhylo
-import Gargantext.Viz.Phylo.PhyloTools 
+import Gargantext.Viz.Phylo.PhyloTools
 
 import Control.Lens
 import Data.GraphViz hiding (DotGraph, Order)
@@ -30,6 +30,7 @@ import Data.Text.Lazy (fromStrict, pack, unpack)
 import System.FilePath
 import Debug.Trace (trace)
 
+import qualified Data.Map as Map
 import qualified Data.Text as Text
 import qualified Data.Vector as Vector
 import qualified Data.Text.Lazy as Lazy
@@ -469,6 +470,27 @@ processDynamics groups =
                                             $ (g ^. phylo_groupNgrams))) [] groups
 
 
+-----------------
+-- | horizon | --
+-----------------
+
+horizonToAncestors :: Double -> Phylo -> [PhyloAncestor]
+horizonToAncestors delta phylo = 
+  let horizon = Map.toList $ Map.filter (\v -> v > delta) $ phylo ^. phylo_horizon
+      ct0 = fromList $ map (\g -> (getGroupId g, g)) $ getGroupsFromLevelPeriods 1 (take 1 (getPeriodIds phylo)) phylo
+      aDelta = toRelatedComponents
+                  (elems ct0)
+                  (map (\((g,g'),v) -> ((ct0 ! g,ct0 ! g'),v)) horizon)
+   in map (\(id,groups) -> toAncestor id groups) $ zip [1..] aDelta
+  where 
+    -- | note : possible bug if we sync clus more than once
+    -- | horizon is calculated at level 1, ancestors have to be related to the last level
+    toAncestor :: Int -> [PhyloGroup] -> PhyloAncestor
+    toAncestor id groups = PhyloAncestor id 
+                              (foldl' (\acc g -> union acc (g ^. phylo_groupNgrams)) [] groups) 
+                              (concat $ map (\g -> map fst (g ^. phylo_groupLevelParents)) groups) 
+
+
 ---------------------
 -- | phyloExport | --
 ---------------------   
@@ -481,7 +503,7 @@ toPhyloExport phylo = exportToDot phylo
                     $ processMetrics  export           
     where
         export :: PhyloExport
-        export = PhyloExport groups branches      
+        export = PhyloExport groups branches (horizonToAncestors 0 phylo)     
         --------------------------------------
         branches :: [PhyloBranch]
         branches = map (\g -> 

src/Gargantext/Viz/Phylo/PhyloTools.hs

@@ -14,7 +14,7 @@ module Gargantext.Viz.Phylo.PhyloTools where
 
 import Data.Vector (Vector, elemIndex)
 import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tail, partition, tails, nubBy)
-import Data.Set (Set, size, disjoint)
+import Data.Set (Set, disjoint)
 import Data.Map (Map, elems, fromList, unionWith, keys, member, (!), filterWithKey, fromListWith, empty)
 import Data.String (String)
 import Data.Text (Text, unwords)
@@ -174,7 +174,7 @@ traceClique mFis = foldl (\msg cpt -> msg <> show (countSup cpt cliques) <> " (>
     where
         --------------------------------------
         cliques :: [Double]
-        cliques = sort $ map (fromIntegral . size . _phyloClique_nodes) $ concat $ elems mFis
+        cliques = sort $ map (fromIntegral . length . _phyloClique_nodes) $ concat $ elems mFis
         -------------------------------------- 
 
 
@@ -225,6 +225,9 @@ listToKeys lst = (listToCombi' lst) ++ (listToEqual' lst)
 listToMatrix :: [Int] -> Map (Int,Int) Double
 listToMatrix lst = fromList $ map (\k -> (k,1)) $ listToKeys $ sort lst
 
+listToMatrix' :: [Ngrams] -> Map (Ngrams,Ngrams) Int
+listToMatrix' lst = fromList $ map (\k -> (k,1)) $ listToKeys $ sort lst
+
 listToSeq :: Eq a =>  [a] -> [(a,a)]
 listToSeq l = nubBy (\x y -> fst x == fst y) $ [ (x,y) | (x:rest) <- tails l,  y <- rest ]
 
@@ -394,6 +397,12 @@ relatedComponents graph = foldl' (\acc groups ->
         let acc' = partition (\groups' -> disjoint (Set.fromList groups') (Set.fromList groups)) acc
          in (fst acc') ++ [nub $ concat $ (snd acc') ++ [groups]]) [] graph
 
+toRelatedComponents :: [PhyloGroup] -> [((PhyloGroup,PhyloGroup),Double)] -> [[PhyloGroup]]
+toRelatedComponents nodes edges = 
+  let ref = fromList $ map (\g -> (getGroupId g, g)) nodes
+      clusters = relatedComponents $ ((map (\((g,g'),_) -> [getGroupId g, getGroupId g']) edges) ++ (map (\g -> [getGroupId g]) nodes)) 
+   in map (\cluster -> map (\gId -> ref ! gId) cluster) clusters 
+
 
 traceSynchronyEnd :: Phylo -> Phylo
 traceSynchronyEnd phylo = 

src/Gargantext/Viz/Phylo/SynchronicClustering.hs

@@ -173,14 +173,6 @@ groupsToEdges prox sync nbDocs diago groups =
                                                                   (g ^. phylo_groupNgrams) (g' ^. phylo_groupNgrams))) edges
                 _ -> undefined  
 
-
-
-toRelatedComponents :: [PhyloGroup] -> [((PhyloGroup,PhyloGroup),Double)] -> [[PhyloGroup]]
-toRelatedComponents nodes edges = 
-  let ref = fromList $ map (\g -> (getGroupId g, g)) nodes
-      clusters = relatedComponents $ ((map (\((g,g'),_) -> [getGroupId g, getGroupId g']) edges) ++ (map (\g -> [getGroupId g]) nodes)) 
-   in map (\cluster -> map (\gId -> ref ! gId) cluster) clusters 
-
 toParentId :: PhyloGroup -> PhyloGroupId
 toParentId child = ((child ^. phylo_groupPeriod, child ^. phylo_groupLevel + 1), child ^. phylo_groupIndex) 
 
@@ -230,10 +222,6 @@ synchronicClustering phylo =
      in toNextLevel' phylo $ concat newBranches'
 
 
-----------------
--- | probes | --
-----------------
-
 -- synchronicDistance :: Phylo -> Level -> String
 -- synchronicDistance phylo lvl = 
 --     foldl' (\acc branch -> 

src/Gargantext/Viz/Phylo/Tools.hs

@@ -112,7 +112,6 @@ listToEqualCombi l = [(x,y) | x <- l, y <- l, x == y]
 listToPairs :: Eq a => [a] -> [(a,a)]
 listToPairs l = (listToEqualCombi l) ++ (listToUnDirectedCombi l)
 
-
 -- | To get all combinations of a list and apply a function to the resulting list of pairs
 listToDirectedCombiWith :: Eq a => forall b. (a -> b) -> [a] -> [(b,b)]
 listToDirectedCombiWith f l = [(f x,f y) | x <- l, y <- l, x /= y]

stack.yaml

@@ -47,7 +47,7 @@ extra-deps:
   #- git: https://github.com/delanoe/servant-job.git
   #commit: 7a7b7100e6d132adb4c11b25b2128e6309690ac0
 - git: https://github.com/np/servant-job.git
-  commit: 5b994e20e90e344b67368b8c6ae3bd917322a35e
+  commit: 6487744c322baaa9229fdabd321a878a5b363c61
 - git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
   commit: 7d74f96dfea8e51fbab1793cc0429b2fe741f73d
 - git: https://github.com/np/patches-map