[REFACT] clean Hyperdatas

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

src/Gargantext/API/Routes.hs

@@ -39,7 +39,6 @@ import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Admin.Types.Node (NodeId, CorpusId, AnnuaireId)
-import Gargantext.Database.Query.Table.Node.Contact (HyperdataContact)
 import Gargantext.Prelude
 import Gargantext.Viz.Graph.API
 import Servant

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
 

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)

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/Node.hs

@@ -26,7 +26,6 @@ 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.Viz.Graph (defaultHyperdataGraph)
 import Gargantext.Prelude
@@ -47,7 +46,7 @@ mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
 
 ------------------------------------------------------------------------
 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
 ------------------------------------------------------------------------

src/Gargantext/Database/Admin/Config.hs

@@ -62,9 +62,9 @@ nodeTypeId n =
 --    NodeOccurrences -> 10
     NodeGraph       -> 9
     NodePhylo       -> 90
-    NodeChart       -> 7
+--    NodeChart       -> 7
     NodeDashboard   -> 71
-    NodeNoteBook    -> 88
+--    NodeNoteBook    -> 88
 
     NodeFrameWrite  -> 991
     NodeFrameCalc   -> 992

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

@@ -13,6 +13,7 @@ Portability : POSIX
 
 module Gargantext.Database.Admin.Types.Hyperdata
   ( module Gargantext.Database.Admin.Types.Hyperdata.Any
+  , module Gargantext.Database.Admin.Types.Hyperdata.Contact
   , module Gargantext.Database.Admin.Types.Hyperdata.Corpus
   , module Gargantext.Database.Admin.Types.Hyperdata.Dashboard
   , module Gargantext.Database.Admin.Types.Hyperdata.Document
@@ -23,10 +24,13 @@ module Gargantext.Database.Admin.Types.Hyperdata
   , module Gargantext.Database.Admin.Types.Hyperdata.Prelude
   , module Gargantext.Database.Admin.Types.Hyperdata.Texts
   , module Gargantext.Database.Admin.Types.Hyperdata.Phylo
+  , module Gargantext.Database.Admin.Types.Hyperdata.User
+  , module Gargantext.Viz.Graph
   )
   where
 
 import Gargantext.Database.Admin.Types.Hyperdata.Any
+import Gargantext.Database.Admin.Types.Hyperdata.Contact
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus
 import Gargantext.Database.Admin.Types.Hyperdata.Dashboard
 import Gargantext.Database.Admin.Types.Hyperdata.Document
@@ -37,6 +41,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Model
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata)
 import Gargantext.Database.Admin.Types.Hyperdata.Texts
 import Gargantext.Database.Admin.Types.Hyperdata.Phylo
-
+import Gargantext.Database.Admin.Types.Hyperdata.User
+import Gargantext.Viz.Graph (HyperdataGraph(..), defaultHyperdataGraph)
 
 

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/Folder.hs

@@ -28,3 +28,23 @@ 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

@@ -38,10 +38,14 @@ defaultHyperdataFrame = HyperdataFrame "" ""
 ------------------------------------------------------------------------
 -- Instances
 ------------------------------------------------------------------------
+-- | Specific Gargantext instance
 instance Hyperdata HyperdataFrame
-$(makeLenses ''HyperdataFrame)
+makeLenses ''HyperdataFrame
+
+-- | All Json instances
 $(deriveJSON (unPrefix "_hf_") ''HyperdataFrame)
 
+-- | Arbitrary instances for tests
 instance Arbitrary HyperdataFrame where
   arbitrary = pure defaultHyperdataFrame
 

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

@@ -39,27 +39,54 @@ data HyperdataList =
 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/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/Node.hs

@@ -244,7 +244,7 @@ data NodeType = NodeUser
               | NodeCorpus     | NodeCorpusV3 | NodeTexts | NodeDocument
               | NodeAnnuaire   | NodeContact
               | NodeGraph      | NodePhylo
-              | NodeDashboard  | NodeChart    | NodeNoteBook
+              | NodeDashboard  -- | NodeChart    | NodeNoteBook
               | NodeList       | NodeModel
               | NodeListCooc
 

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

@@ -27,21 +27,19 @@ import Data.Aeson
 import Data.Maybe (Maybe(..))
 import Data.Text (Text)
 import GHC.Int (Int64)
-import Opaleye hiding (FromField)
-import Opaleye.Internal.QueryArr (Query)
-import Prelude hiding (null, id, map, sum)
-
 import Gargantext.Core.Types
-import Gargantext.Database.Query.Filter (limit', offset')
 import Gargantext.Database.Admin.Config (nodeTypeId)
-import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node (NodeType(..))
 import Gargantext.Database.Prelude
-import Gargantext.Database.Query.Table.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact)
+import Gargantext.Database.Query.Filter (limit', offset')
+import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (sum, head)
 import Gargantext.Viz.Graph (HyperdataGraph(..), defaultHyperdataGraph)
+import Opaleye hiding (FromField)
+import Opaleye.Internal.QueryArr (Query)
+import Prelude hiding (null, id, map, sum)
 
 
 queryNodeSearchTable :: Query NodeSearchRead
@@ -216,15 +214,34 @@ mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
 insertGraph :: ParentId -> UserId -> HyperdataGraph -> Cmd err [GraphId]
 insertGraph p u h = insertNodesR [nodeGraphW Nothing (Just h) p u]
 
-
 ------------------------------------------------------------------------
 nodeDefault :: NodeType -> ParentId -> UserId -> NodeWrite
-nodeDefault NodeList      parentId = node NodeList      "List"   defaultHyperdataList      (Just parentId)
-nodeDefault NodeCorpus    parentId = node NodeCorpus    "Corpus" defaultHyperdataCorpus    (Just parentId)
-nodeDefault NodeDocument  parentId = node NodeDocument  "Doc"    defaultHyperdataDocument  (Just parentId)
-nodeDefault NodeTexts     parentId = node NodeTexts     "Texts"  defaultHyperdataTexts     (Just parentId)
-nodeDefault NodeModel parentId = node NodeModel "Model"  defaultHyperdataModel (Just parentId)
-nodeDefault nt _ = panic $ "G.D.Q.T.Node.nodeDefault " <> (cs $ show nt)
+nodeDefault NodeUser      parentId = node NodeUser     "User"   defaultHyperdataUser     (Just parentId)
+nodeDefault NodeContact   parentId = node NodeContact  "Contact" defaultHyperdataContact   (Just parentId)
+
+nodeDefault NodeCorpus    parentId = node NodeCorpus   "Corpus" defaultHyperdataCorpus   (Just parentId)
+nodeDefault NodeCorpusV3  parentId = node NodeCorpus   "Corpus" defaultHyperdataCorpus   (Just parentId)
+nodeDefault NodeAnnuaire  parentId = node NodeAnnuaire "Annuaire" defaultHyperdataAnnuaire   (Just parentId)
+
+nodeDefault NodeDocument  parentId = node NodeDocument "Doc"    defaultHyperdataDocument (Just parentId)
+nodeDefault NodeTexts     parentId = node NodeTexts    "Texts"  defaultHyperdataTexts    (Just parentId)
+nodeDefault NodeList      parentId = node NodeList     "List"   defaultHyperdataList     (Just parentId)
+nodeDefault NodeListCooc  parentId = node NodeListCooc "List"   defaultHyperdataListCooc (Just parentId)
+nodeDefault NodeModel     parentId = node NodeModel    "Model"  defaultHyperdataModel    (Just parentId)
+
+nodeDefault NodeFolder    parentId = node NodeFolder   "Folder" defaultHyperdataFolder   (Just parentId)
+nodeDefault NodeFolderPrivate parentId = node NodeFolderPrivate  "Private Folder" defaultHyperdataFolderPrivate   (Just parentId)
+nodeDefault NodeFolderShared  parentId = node NodeFolderShared   "Shared Folder"  defaultHyperdataFolderShared   (Just parentId)
+nodeDefault NodeTeam          parentId = node NodeFolder  "Folder" defaultHyperdataFolder  (Just parentId)
+nodeDefault NodeFolderPublic  parentId = node NodeFolderPublic   "Public Folder"  defaultHyperdataFolderPublic   (Just parentId)
+
+nodeDefault NodeGraph         parentId = node NodeGraph   "Graph"  defaultHyperdataGraph   (Just parentId)
+nodeDefault NodePhylo         parentId = node NodePhylo   "Phylo"  defaultHyperdataPhylo   (Just parentId)
+nodeDefault NodeDashboard     parentId = node NodeDashboard   "Dashboard"  defaultHyperdataDashboard   (Just parentId)
+
+nodeDefault NodeFrameWrite   parentId = node NodeFrameWrite "Frame Write"  defaultHyperdataFrame   (Just parentId)
+nodeDefault NodeFrameCalc    parentId = node NodeFrameCalc "Frame Calc"  defaultHyperdataFrame   (Just parentId)
+-- nodeDefault nt _ = panic $ "G.D.Q.T.Node.nodeDefault " <> (cs $ show nt)
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------

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,15 @@ 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 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)
 
 -- TODO : the import of Document constructor below does not work
 -- import Gargantext.Database.Types.Node (Document)

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/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)

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/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_")
 
@@ -163,8 +159,8 @@ data GraphV3 = GraphV3 { go_links :: [EdgeV3]
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "go_") ''GraphV3)
 
------------------------------------------------------------
 
+-----------------------------------------------------------
 data HyperdataGraph =
   HyperdataGraph { _hyperdataGraph :: !(Maybe Graph)
                  } deriving (Show, Generic)
@@ -186,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