Skip to content

H
haskell-gargantext
Commit a759d5d6 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[NewType] Merge, NodeNgram* fix.

parents 6cacf848 3e2fa028
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 174 additions and 149 deletions
src/Gargantext/API.hs
View file @ a759d5d6
......@@ -83,7 +83,7 @@ import Gargantext.API.Node ( GargServer
, HyperdataAnnuaire
)
--import Gargantext.Database.Node.Contact (HyperdataContact)
import Gargantext.Database.Types.Node ()
import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
import Gargantext.API.Count ( CountAPI, count, Query)
import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
import Gargantext.Database.Facet
......@@ -222,19 +222,19 @@ type GargAPI' =
-- Node endpoint
:<|> "node" :> Summary "Node endpoint"
:> Capture "id" Int :> NodeAPI HyperdataAny
:> Capture "id" NodeId :> NodeAPI HyperdataAny
-- Corpus endpoint
:<|> "corpus":> Summary "Corpus endpoint"
:> Capture "id" Int :> NodeAPI HyperdataCorpus
:> Capture "id" CorpusId :> NodeAPI HyperdataCorpus
-- Annuaire endpoint
:<|> "annuaire":> Summary "Annuaire endpoint"
:> Capture "id" Int :> NodeAPI HyperdataAnnuaire
:> Capture "id" AnnuaireId :> NodeAPI HyperdataAnnuaire
-- Corpus endpoint
:<|> "nodes" :> Summary "Nodes endpoint"
:> ReqBody '[JSON] [Int] :> NodesAPI
:> ReqBody '[JSON] [NodeId] :> NodesAPI
-- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
-- Corpus endpoint
......@@ -250,11 +250,11 @@ type GargAPI' =
:> SearchAPI
:<|> "graph" :> Summary "Graph endpoint"
:> Capture "id" Int :> GraphAPI
:> Capture "id" NodeId :> GraphAPI
-- Tree endpoint
:<|> "tree" :> Summary "Tree endpoint"
:> Capture "id" Int :> TreeAPI
:> Capture "id" NodeId :> TreeAPI
-- :<|> "scraper" :> WithCallbacks ScraperAPI
......
src/Gargantext/API/Auth.hs
View file @ a759d5d6
......@@ -35,7 +35,7 @@ import Data.Text (Text, reverse)
import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Root (getRoot)
import Gargantext.Database.Types.Node (NodePoly(_node_id))
import Gargantext.Database.Types.Node (NodePoly(_node_id), NodeId)
import Gargantext.Database.Utils (Cmd)
import Gargantext.Prelude hiding (reverse)
import Test.QuickCheck (elements, oneof)
......@@ -67,7 +67,7 @@ data AuthValid = AuthValid { _authVal_token :: Token
deriving (Generic)
type Token = Text
type TreeId = Int
type TreeId = NodeId
-- | Main functions of authorization
......
src/Gargantext/API/Node.hs
View file @ a759d5d6
......@@ -62,7 +62,8 @@ import Gargantext.API.Search ( SearchAPI, searchIn, SearchInQuery)
import Gargantext.Viz.Graph hiding (Node)-- (Graph(_graph_metadata),LegendField(..), GraphMetadata(..),readGraphFromJson,defaultGraph)
-- import Gargantext.Core (Lang(..))
import Gargantext.Core.Types (Offset, Limit)
import Gargantext.Core.Types.Main (Tree, NodeTree, CorpusId, ContactId)
import Gargantext.Core.Types.Main (Tree, NodeTree)
import Gargantext.Database.Types.Node (CorpusId, ContactId)
-- import Gargantext.Text.Terms (TermType(..))
import Test.QuickCheck (elements)
......@@ -117,13 +118,13 @@ type NodeAPI a = Get '[JSON] (Node a)
:> QueryParam "order" OrderBy
:> SearchAPI
type RenameApi = Summary " RenameNode Node"
type RenameApi = Summary " Rename Node"
:> ReqBody '[JSON] RenameNode
:> Put '[JSON] [Int]
type PostNodeApi = Summary " PostNode Node with ParentId as {id}"
:> ReqBody '[JSON] PostNode
:> Post '[JSON] [Int]
:> Post '[JSON] [NodeId]
type ChildrenApi a = Summary " Summary children"
:> QueryParam "type" NodeType
......@@ -322,7 +323,7 @@ getChart :: NodeId -> Maybe UTCTime -> Maybe UTCTime
-> Cmd err [FacetChart]
getChart _ _ _ = undefined -- TODO
postNode :: NodeId -> PostNode -> Cmd err [Int]
postNode :: NodeId -> PostNode -> Cmd err [NodeId]
postNode pId (PostNode name nt) = mk nt (Just pId) name
putNode :: NodeId -> Cmd err Int
......
src/Gargantext/API/Search.hs
View file @ a759d5d6
......@@ -45,7 +45,7 @@ import Gargantext.Database.Utils (Cmd)
-- | SearchIn [NodesId] if empty then global search
-- TODO [Int]
data SearchQuery = SearchQuery { sq_query :: [Text]
, sq_corpus_id :: Int
, sq_corpus_id :: NodeId
} deriving (Generic)
$(deriveJSON (unPrefix "sq_") ''SearchQuery)
instance ToSchema SearchQuery where
......
src/Gargantext/Core/Types/Main.hs
View file @ a759d5d6
......@@ -42,7 +42,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
------------------------------------------------------------------------
data NodeTree = NodeTree { _nt_name :: Text
, _nt_type :: NodeType
, _nt_id :: Int
, _nt_id :: NodeId
} deriving (Show, Read, Generic)
$(deriveJSON (unPrefix "_nt_") ''NodeTree)
......@@ -80,24 +80,9 @@ corpusTree nId t = TreeN (NodeTree ("Corpus " <> t) NodeCorpus nId) ( [ leafT
--data Classification = Favorites | MyClassifcation
type UserId = Int
type MasterUserId = Int
type RootId = Int
type MasterCorpusId = Int
type HashId = Text
type AnnuaireId = NodeId
type ContactId = NodeId
type CorpusId = NodeId
type DocumentId = NodeId
type DocId = DocumentId -- todo: remove this
type ListId = NodeId
type TypeId = Int
-- TODO multiple ListType declaration, remove it
data ListType = StopList | CandidateList | GraphList
deriving (Generic, Eq, Ord, Show, Enum, Bounded)
......@@ -152,7 +137,6 @@ type TirankGlobal = Tficf
type ErrorMessage = Text
-- Queries
type ParentId = NodeId
type Limit = Int
type Offset = Int
......
src/Gargantext/Database/Facet.hs
View file @ a759d5d6
......@@ -219,7 +219,7 @@ viewAuthorsDoc cId _ nt = proc () -> do
-- restrict -< nodeNode_delete nn .== (pgBool t)
-}
restrict -< _node_id contact .== (toNullable $ pgInt4 cId)
restrict -< _node_id contact .== (toNullable $ pgNodeId cId)
restrict -< _node_typename doc .== (pgInt4 $ nodeTypeId nt)
returnA -< FacetDoc (_node_id doc) (_node_date doc) (_node_name doc) (_node_hyperdata doc) (pgBool True) (pgInt4 1)
......@@ -255,7 +255,7 @@ viewDocuments cId t ntId = proc () -> do
n <- queryNodeTable -< ()
nn <- queryNodeNodeTable -< ()
restrict -< _node_id n .== nodeNode_node2_id nn
restrict -< nodeNode_node1_id nn .== (pgInt4 cId)
restrict -< nodeNode_node1_id nn .== (pgNodeId cId)
restrict -< _node_typename n .== (pgInt4 ntId)
restrict -< nodeNode_delete nn .== (pgBool t)
returnA -< FacetDoc (_node_id n) (_node_date n) (_node_name n) (_node_hyperdata n) (nodeNode_favorite nn) (pgInt4 1)
......
src/Gargantext/Database/Flow.hs
View file @ a759d5d6
......@@ -42,8 +42,7 @@ import Gargantext.Database.Schema.Node (mkRoot, mkCorpus, getOrMkList, mkGraph,
import Gargantext.Database.Schema.NodeNgram (NodeNgramPoly(..), insertNodeNgrams)
import Gargantext.Database.Schema.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew)
import Gargantext.Database.Schema.User (getUser, UserLight(..))
import Gargantext.Database.Types.Node (HyperdataDocument(..))
import Gargantext.Database.Types.Node (NodeType(..), NodeId)
import Gargantext.Database.Types.Node (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
import Gargantext.Database.Utils (Cmd)
import Gargantext.Text.Terms (TermType(..))
import Gargantext.Ext.IMT (toSchoolName)
......@@ -53,6 +52,7 @@ import Gargantext.Text.Parsers (parseDocs, FileFormat)
import System.FilePath (FilePath)
import qualified Data.Map as DM
flowCorpus :: HasNodeError err => FileFormat -> FilePath -> CorpusName -> Cmd err CorpusId
flowCorpus ff fp cName = do
hyperdataDocuments' <- map addUniqIdsDoc <$> liftIO (parseDocs ff fp)
......@@ -67,10 +67,10 @@ flowInsert _nt hyperdataDocuments cName = do
(masterUserId, _, masterCorpusId) <- subFlowCorpus userMaster corpusMasterName
ids <- insertDocuments masterUserId masterCorpusId NodeDocument hyperdataDocuments'
(userId, _, userCorpusId) <- subFlowCorpus userArbitrary cName
_ <- add userCorpusId (map reId ids)
pure (ids, masterUserId, masterCorpusId, userId, userCorpusId)
......@@ -87,10 +87,10 @@ flowInsertAnnuaire name children = do
(masterUserId, _, masterCorpusId) <- subFlowCorpus userMaster corpusMasterName
ids <- insertDocuments masterUserId masterCorpusId NodeContact children
(userId, _, userCorpusId) <- subFlowAnnuaire userArbitrary name
_ <- add userCorpusId (map reId ids)
printDebug "AnnuaireID" userCorpusId
pure (ids, masterUserId, masterCorpusId, userId, userCorpusId)
......@@ -105,25 +105,25 @@ flowCorpus' NodeCorpus hyperdataDocuments (ids,masterUserId,masterCorpusId, user
-- List Ngrams Flow
userListId <- flowListUser userId userCorpusId
printDebug "Working on User ListId : " userListId
let documentsWithId = mergeData (toInserted ids) (toInsert hyperdataDocuments)
-- printDebug "documentsWithId" documentsWithId
docsWithNgrams <- documentIdWithNgrams extractNgramsT documentsWithId
-- printDebug "docsWithNgrams" docsWithNgrams
let maps = mapNodeIdNgrams docsWithNgrams
-- printDebug "maps" (maps)
indexedNgrams <- indexNgrams maps
-- printDebug "inserted ngrams" indexedNgrams
_ <- insertToNodeNgrams indexedNgrams
listId2 <- flowList masterUserId masterCorpusId indexedNgrams
printDebug "Working on ListId : " listId2
--}
--------------------------------------------------
_ <- mkDashboard userCorpusId userId
_ <- mkGraph userCorpusId userId
-- Annuaire Flow
-- _ <- mkAnnuaire rootUserId userId
......@@ -284,7 +284,7 @@ flowList uId cId ngs = do
pure lId
flowListUser :: HasNodeError err => UserId -> CorpusId -> Cmd err Int
flowListUser :: HasNodeError err => UserId -> CorpusId -> Cmd err NodeId
flowListUser uId cId = getOrMkList cId uId
------------------------------------------------------------------------
......
src/Gargantext/Database/Flow/Pairing.hs
View file @ a759d5d6
......@@ -37,8 +37,8 @@ import Gargantext.Database.Schema.Ngrams -- (NgramsType(..))
import Gargantext.Database.Node.Contact
import Gargantext.Database.Flow.Utils
import Gargantext.Database.Utils (Cmd, runPGSQuery)
import Gargantext.Database.Types.Node (AnnuaireId, CorpusId, ContactId)
import Gargantext.Database.Node.Children
import Gargantext.Core.Types.Main
import Gargantext.Core.Types (NodeType(..))
-- TODO mv this type in Types Main
......
src/Gargantext/Database/Node/Children.hs
View file @ a759d5d6
......@@ -26,6 +26,7 @@ import Gargantext.Database.Schema.NodeNode
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Queries.Filter
import Gargantext.Database.Node.Contact (HyperdataContact)
import Gargantext.Database.Schema.Node (pgNodeId)
import Control.Arrow (returnA)
-- | TODO: use getChildren with Proxy ?
......@@ -47,8 +48,8 @@ selectChildren parentId maybeNodeType = proc () -> do
let nodeType = maybe 0 nodeTypeId maybeNodeType
restrict -< typeName .== pgInt4 nodeType
restrict -< (.||) (parent_id .== (pgInt4 parentId))
( (.&&) (n1id .== pgInt4 parentId)
restrict -< (.||) (parent_id .== (pgNodeId parentId))
( (.&&) (n1id .== pgNodeId parentId)
(n2id .== nId))
returnA -< row
......
src/Gargantext/Database/Node/Contact.hs
View file @ a759d5d6
......@@ -28,9 +28,8 @@ import Data.Time (UTCTime)
import Database.PostgreSQL.Simple.FromField (FromField, fromField)
import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Core.Types.Main (AnnuaireId, UserId)
import Gargantext.Database.Schema.Node (NodeWrite, Name, node)
import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..))
import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..), UserId, AnnuaireId)
import Gargantext.Database.Utils (fromField')
import Gargantext.Prelude
import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
......
src/Gargantext/Database/Node/Document/Add.hs
View file @ a759d5d6
......@@ -40,7 +40,6 @@ import Gargantext.Prelude
import GHC.Generics (Generic)
---------------------------------------------------------------------------
type ParentId = Int
add :: ParentId -> [NodeId] -> Cmd err [Only Int]
add pId ns = runPGSQuery queryAdd (Only $ Values fields inputData)
......
src/Gargantext/Database/Node/Document/Insert.hs
View file @ a759d5d6
......@@ -180,7 +180,7 @@ prepare uId pId nodeType = map (\h -> InputData tId uId pId (name h) (toJSON' h)
-- | When documents are inserted
-- ReturnType after insertion
data ReturnId = ReturnId { reInserted :: Bool -- ^ if the document is inserted (True: is new, False: is not new)
, reId :: Int -- ^ always return the id of the document (even new or not new)
, reId :: NodeId -- ^ always return the id of the document (even new or not new)
-- this is the uniq id in the database
, reUniqId :: Text -- ^ Hash Id with concatenation of hash parameters
} deriving (Show, Generic)
......@@ -190,9 +190,6 @@ instance FromRow ReturnId where
-- ** Insert Types
type UserId = Int
type ParentId = Int
data InputData = InputData { inTypenameId :: NodeTypeId
, inUserId :: UserId
, inParentId :: ParentId
......
src/Gargantext/Database/Node/Update.hs
View file @ a759d5d6
......@@ -17,20 +17,18 @@ Portability : POSIX
module Gargantext.Database.Node.Update (Update(..), update) where
import Data.Text (Text)
import qualified Data.Text as DT
import Database.PostgreSQL.Simple
import Gargantext.Prelude
import Gargantext.Database.Utils
import Gargantext.Database.Types.Node (NodeId, ParentId)
import Gargantext.Database.Schema.Node (Name)
-- import Data.ByteString
--rename :: NodeId -> Text -> IO ByteString
--rename nodeId name = formatPGSQuery "UPDATE nodes SET name=? where id=?" (name,nodeId)
------------------------------------------------------------------------
type NodeId = Int
type Name = Text
type ParentId = Int
data Update = Rename NodeId Name
| Move NodeId ParentId
......
src/Gargantext/Database/Schema/Ngrams.hs
View file @ a759d5d6
......@@ -221,8 +221,8 @@ getNgramsTableDb nt ngrt ntp@(NgramsTableParam listIdUser _) limit_ offset_ = do
data NgramsTableParam =
NgramsTableParam { _nt_listId :: Int
, _nt_corpusId :: Int
NgramsTableParam { _nt_listId :: NodeId
, _nt_corpusId :: NodeId
}
type NgramsTableParamUser = NgramsTableParam
......@@ -289,8 +289,8 @@ querySelectTableNgrams = [sql|
|]
type ListIdUser = Int
type ListIdMaster = Int
type ListIdUser = NodeId
type ListIdMaster = NodeId
type MapToChildren = Map Text (Set Text)
type MapToParent = Map Text Text
......
src/Gargantext/Database/Schema/Node.hs
View file @ a759d5d6
This diff is collapsed.
src/Gargantext/Database/Schema/NodeNgram.hs
View file @ a759d5d6
......@@ -36,9 +36,11 @@ import Control.Monad (void)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Gargantext.Core.Types.Main (ListId, ListTypeId)
import Gargantext.Core.Types.Main (ListTypeId)
import Gargantext.Database.Utils (mkCmd, Cmd, execPGSQuery)
import Gargantext.Database.Schema.NodeNgramsNgrams
import Gargantext.Database.Types.Node (NodeId, ListId)
import Gargantext.Database.Schema.Node (pgNodeId)
import Gargantext.Database.Schema.NodeNgramsNgrams (NgramsChild, NgramsParent, ngramsGroup, Action(..))
import Gargantext.Prelude
import Opaleye
import qualified Database.PostgreSQL.Simple as PGS (Only(..))
......@@ -77,7 +79,7 @@ type NodeNgramReadNull =
(Column (Nullable PGInt4 ))
type NodeNgram =
NodeNgramPoly (Maybe Int) Int Int Double Int
NodeNgramPoly (Maybe NodeId) NodeId Int Double Int
$(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
$(makeLensesWith abbreviatedFields ''NodeNgramPoly)
......@@ -100,7 +102,7 @@ queryNodeNgramTable = queryTable nodeNgramTable
insertNodeNgrams :: [NodeNgram] -> Cmd err Int
insertNodeNgrams = insertNodeNgramW
. map (\(NodeNgram _ n g w t) ->
NodeNgram Nothing (pgInt4 n) (pgInt4 g)
NodeNgram Nothing (pgNodeId n) (pgInt4 g)
(pgDouble w) (pgInt4 t)
)
......
src/Gargantext/Database/Schema/NodeNgramsNgrams.hs
View file @ a759d5d6
......@@ -42,7 +42,8 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Gargantext.Database.Utils (Cmd, runOpaQuery, execPGSQuery, connection)
import Gargantext.Core.Types.Main (ListId)
import Gargantext.Database.Types.Node (ListId)
import Gargantext.Database.Schema.Node (pgNodeId)
import Gargantext.Prelude
import Opaleye
import qualified Database.PostgreSQL.Simple as PGS
......@@ -67,7 +68,7 @@ type NodeNgramsNgramsRead =
(Column PGFloat8)
type NodeNgramsNgrams =
NodeNgramsNgramsPoly Int
NodeNgramsNgramsPoly ListId
Int
Int
(Maybe Double)
......@@ -108,7 +109,7 @@ instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
insertNodeNgramsNgramsNew :: [NodeNgramsNgrams] -> Cmd err Int
insertNodeNgramsNgramsNew = insertNodeNgramsNgramsW
. map (\(NodeNgramsNgrams n ng1 ng2 maybeWeight) ->
NodeNgramsNgrams (pgInt4 n )
NodeNgramsNgrams (pgNodeId n )
(pgInt4 ng1)
(pgInt4 ng2)
(pgDouble <$> maybeWeight)
......
src/Gargantext/Database/Schema/NodeNode.hs
View file @ a759d5d6
......@@ -32,7 +32,7 @@ import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Gargantext.Database.Utils
import Gargantext.Core.Types.Main (CorpusId, DocId)
import Gargantext.Database.Types.Node (CorpusId, DocId)
import Gargantext.Prelude
import Opaleye
......
src/Gargantext/Database/TextSearch.hs
View file @ a759d5d6
......@@ -64,7 +64,7 @@ searchInCorpus cId q o l order = runOpaQuery (filterWith o l order $ queryInCorp
queryInCorpus :: CorpusId -> Text -> O.Query FacetDocRead
queryInCorpus cId q = proc () -> do
(n, nn) <- joinInCorpus -< ()
restrict -< ( nodeNode_node1_id nn) .== (toNullable $ pgInt4 cId)
restrict -< ( nodeNode_node1_id nn) .== (toNullable $ pgNodeId cId)
restrict -< (_ns_search n) @@ (pgTSQuery (unpack q))
restrict -< (_ns_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
returnA -< FacetDoc (_ns_id n) (_ns_date n) (_ns_name n) (_ns_hyperdata n) (pgBool True) (pgInt4 1)
......@@ -103,7 +103,7 @@ queryInCorpusWithContacts cId q _ _ _ = proc () -> do
(docs, (corpusDoc, (docNgrams, (ngrams', (_, contacts))))) <- joinInCorpusWithContacts -< ()
restrict -< (_ns_search docs) @@ (pgTSQuery $ unpack q )
restrict -< (_ns_typename docs) .== (pgInt4 $ nodeTypeId NodeDocument)
restrict -< (nodeNode_node1_id corpusDoc) .== (toNullable $ pgInt4 cId)
restrict -< (nodeNode_node1_id corpusDoc) .== (toNullable $ pgNodeId cId)
restrict -< (nodeNgram_type docNgrams) .== (toNullable $ pgInt4 $ ngramsTypeId Authors)
restrict -< (_node_typename contacts) .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
-- let contact_id = ifThenElse (isNull $ _node_id contacts) (toNullable $ pgInt4 0) (_node_id contacts)
......
src/Gargantext/Database/Tree.hs
View file @ a759d5d6
......@@ -27,6 +27,7 @@ import Database.PostgreSQL.Simple.SqlQQ
import Gargantext.Prelude
import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
import Gargantext.Database.Types.Node (NodeId)
import Gargantext.Database.Config (fromNodeTypeId)
import Gargantext.Database.Utils (Cmd, runPGSQuery)
------------------------------------------------------------------------
......@@ -48,8 +49,8 @@ treeError te = throwError $ _TreeError # te
treeDB :: HasTreeError err => RootId -> Cmd err (Tree NodeTree)
treeDB r = toTree =<< (toTreeParent <$> dbTree r)
type RootId = Int
type ParentId = Int
type RootId = NodeId
type ParentId = NodeId
------------------------------------------------------------------------
toTree :: (MonadError e m, HasTreeError e)
=> Map (Maybe ParentId) [DbTreeNode] -> m (Tree NodeTree)
......@@ -74,9 +75,9 @@ toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId
toTreeParent :: [DbTreeNode] -> Map (Maybe ParentId) [DbTreeNode]
toTreeParent = fromListWith (<>) . map (\n -> (dt_parentId n, [n]))
------------------------------------------------------------------------
data DbTreeNode = DbTreeNode { dt_nodeId :: Int
data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId
, dt_typeId :: Int
, dt_parentId :: Maybe Int
, dt_parentId :: Maybe NodeId
, dt_name :: Text
} deriving (Show)
......
src/Gargantext/Database/Types/Node.hs
View file @ a759d5d6
......@@ -18,6 +18,7 @@ Portability : POSIX
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- {-# LANGUAGE DuplicateRecordFields #-}
module Gargantext.Database.Types.Node
......@@ -48,6 +49,7 @@ import Text.Read (read)
import Text.Show (Show())
import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
import Database.PostgreSQL.Simple.FromField (FromField, fromField)
import Servant
import Test.QuickCheck.Arbitrary
......@@ -55,8 +57,45 @@ import Test.QuickCheck (elements)
import Gargantext.Prelude
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Utils
------------------------------------------------------------------------
type NodeId = Int
newtype NodeId = NodeId Int
deriving (Show, Read, Generic, Num, Eq, Ord, Enum)
instance ToField NodeId where
toField (NodeId n) = toField n
instance FromField NodeId where
fromField = fromField'
instance ToJSON NodeId
instance FromJSON NodeId
instance ToSchema NodeId
instance FromHttpApiData NodeId where
parseUrlPiece n = pure $ NodeId $ (read . cs) n
instance ToParamSchema NodeId
instance Arbitrary NodeId where
arbitrary = NodeId <$> arbitrary
type ParentId = NodeId
type GraphId = NodeId
type CorpusId = NodeId
type ListId = NodeId
type DocumentId = NodeId
type DocId = DocumentId -- todo: remove this
type RootId = NodeId
type MasterCorpusId = NodeId
type AnnuaireId = NodeId
type ContactId = NodeId
type UserId = Int
type MasterUserId = UserId
id2int :: NodeId -> Int
id2int (NodeId n) = n
type UTCTime' = UTCTime
......@@ -328,12 +367,10 @@ instance Hyperdata HyperdataNotebook
-- | NodePoly indicates that Node has a Polymorphism Type
type Node json = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json
type Node json = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
-- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
type NodeTypeId = Int
type NodeParentId = Int
type NodeUserId = Int
type NodeName = Text
type TSVector = Text
......@@ -375,8 +412,8 @@ allNodeTypes = [minBound ..]
instance FromJSON NodeType
instance ToJSON NodeType
instance FromHttpApiData NodeType
where
instance FromHttpApiData NodeType
where
parseUrlPiece = Right . read . unpack
instance ToParamSchema NodeType
......@@ -416,16 +453,16 @@ data NodePolySearch id typename userId
$(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
$(makeLenses ''NodePolySearch)
type NodeSearch json = NodePolySearch NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json (Maybe TSVector)
type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
------------------------------------------------------------------------
instance (Arbitrary hyperdata
,Arbitrary nodeId
,Arbitrary nodeTypeId
,Arbitrary nodeUserId
,Arbitrary userId
,Arbitrary nodeParentId
) => Arbitrary (NodePoly nodeId nodeTypeId nodeUserId nodeParentId
) => Arbitrary (NodePoly nodeId nodeTypeId userId nodeParentId
NodeName UTCTime hyperdata) where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
......@@ -435,9 +472,9 @@ instance (Arbitrary hyperdata
instance (Arbitrary hyperdata
,Arbitrary nodeId
,Arbitrary nodeTypeId
,Arbitrary nodeUserId
,Arbitrary userId
,Arbitrary nodeParentId
) => Arbitrary (NodePolySearch nodeId nodeTypeId nodeUserId nodeParentId
) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
NodeName UTCTime hyperdata (Maybe TSVector)) where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
......@@ -484,30 +521,30 @@ instance ToSchema HyperdataAny where
instance ToSchema hyperdata =>
ToSchema (NodePoly NodeId NodeTypeId
(Maybe NodeUserId)
NodeParentId NodeName
(Maybe UserId)
ParentId NodeName
UTCTime hyperdata
)
instance ToSchema hyperdata =>
ToSchema (NodePoly NodeId NodeTypeId
NodeUserId
(Maybe NodeParentId) NodeName
UserId
(Maybe ParentId) NodeName
UTCTime hyperdata
)
instance ToSchema hyperdata =>
ToSchema (NodePolySearch NodeId NodeTypeId
(Maybe NodeUserId)
NodeParentId NodeName
(Maybe UserId)
ParentId NodeName
UTCTime hyperdata (Maybe TSVector)
)
instance ToSchema hyperdata =>
ToSchema (NodePolySearch NodeId NodeTypeId
NodeUserId
(Maybe NodeParentId) NodeName
UserId
(Maybe ParentId) NodeName
UTCTime hyperdata (Maybe TSVector)
)
......
src/Gargantext/Database/Utils.hs
View file @ a759d5d6
......@@ -129,4 +129,3 @@ fromField' field mb = do
printSqlOpa :: Default Unpackspec a a => Query a -> IO ()
printSqlOpa = putStrLn . maybe "Empty query" identity . showSqlForPostgres
src/Gargantext/Viz/Graph.hs
View file @ a759d5d6
......@@ -38,6 +38,7 @@ import Data.Swagger
import Gargantext.Prelude
import Gargantext.Core.Types (Label)
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Types.Node (NodeId)
import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
......@@ -98,7 +99,7 @@ instance ToSchema LegendField where
makeLenses ''LegendField
--
data GraphMetadata = GraphMetadata { _gm_title :: Text -- title of the graph
, _gm_corpusId :: [Int] -- we can map with different corpus
, _gm_corpusId :: [NodeId] -- we can map with different corpus
, _gm_legend :: [LegendField] -- legend of the Graph
}
deriving (Show, Generic)
......@@ -140,24 +141,23 @@ data AttributesV3 = AttributesV3 { cl :: Int }
$(deriveJSON (unPrefix "") ''AttributesV3)
data NodeV3 = NodeV3 { no_id :: Int
, no_at :: AttributesV3
, no_s :: Int
, no_lb :: Text
}
, no_at :: AttributesV3
, no_s :: Int
, no_lb :: Text
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "no_") ''NodeV3)
data EdgeV3 = EdgeV3 { eo_s :: Int
, eo_t :: Int
, eo_w :: Text
}
, eo_t :: Int
, eo_w :: Text
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "eo_") ''EdgeV3)
data GraphV3 = GraphV3 {
go_links :: [EdgeV3]
, go_nodes :: [NodeV3]
}
data GraphV3 = GraphV3 { go_links :: [EdgeV3]
, go_nodes :: [NodeV3]
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "go_") ''GraphV3)
......
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