Skip to content

haskell-gargantext
haskell-gargantext
Commit 0e6d71de authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[REFACT] clean Hyperdatas

parent 5a43e4bd
Hide whitespace changes
Inline Side-by-side
Showing with 414 additions and 302 deletions
src/Gargantext/API/Node.hs
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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 0 → 100644
View file @ 0e6d71de
{-|
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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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 0 → 100644
View file @ 0e6d71de
{-|
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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
View file @ 0e6d71de
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment