Skip to content

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

Merge branch 'tsvector'

parents d22876cb 50585129
Show whitespace changes
Inline Side-by-side
Showing with 629 additions and 476 deletions
package.yaml
View file @ cadd8650
name: gargantext
version: '4.0.0.2'
version: '4.0.0.3'
synopsis: Search, map, share
description: Please see README.md
category: Data
......@@ -36,12 +36,8 @@ library:
- Gargantext.Core.Types.Main
- Gargantext.Core.Utils.Prefix
- Gargantext.Database
- Gargantext.Database.Bashql
- Gargantext.Database.Node.Document.Insert
- Gargantext.Database.Node.Document.Add
- Gargantext.Database.Node.Contact
- Gargantext.Database.Types.Node
- Gargantext.Database.User
- Gargantext.Database.Flow
- Gargantext.Database.Schema.Node
- Gargantext.Database.Cooc
- Gargantext.Database.Tree
- Gargantext.Prelude
......
src/Gargantext/API/Ngrams.hs
View file @ cadd8650
......@@ -34,7 +34,7 @@ module Gargantext.API.Ngrams
where
import Prelude (round)
-- import Gargantext.Database.User (UserId)
-- import Gargantext.Database.Schema.User (UserId)
import Data.Patch.Class (Replace, replace)
--import qualified Data.Map.Strict.Patch as PM
import Data.Monoid
......@@ -57,7 +57,7 @@ import GHC.Generics (Generic)
--import Gargantext.Core.Types.Main (Tree(..))
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Types.Node (NodeType(..))
import qualified Gargantext.Database.Ngrams as Ngrams
import qualified Gargantext.Database.Schema.Ngrams as Ngrams
import Gargantext.Prelude
import Gargantext.Core.Types (ListType(..), ListId, CorpusId)
import Prelude (Enum, Bounded, minBound, maxBound)
......
src/Gargantext/API/Node.hs
View file @ cadd8650
......@@ -51,15 +51,13 @@ import Servant
import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, TableNgramsApiGet,tableNgramsPatch, getTableNgrams, NgramsIdPatchsFeed, NgramsIdPatchsBack, NgramsTable)
import Gargantext.Prelude
import Gargantext.Database.Types.Node
import Gargantext.Database.Node ( runCmd
, getNodesWithParentId
, getNode
, deleteNode, deleteNodes, mk, JSONB)
import Gargantext.Database.Utils (runCmd)
import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, deleteNode, deleteNodes, mk, JSONB)
import Gargantext.Database.Node.Children (getChildren)
import qualified Gargantext.Database.Node.Update as U (update, Update(..))
import Gargantext.Database.Facet (FacetDoc , runViewDocuments', OrderBy(..),FacetChart,runViewAuthorsDoc)
import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
import Gargantext.Database.NodeNode (nodesToFavorite, nodesToTrash)
import Gargantext.Database.Schema.NodeNode (nodesToFavorite, nodesToTrash)
-- Graph
--import Gargantext.Text.Flow
import Gargantext.Viz.Graph (Graph,readGraphFromJson,defaultGraph)
......
src/Gargantext/Core/Types/Main.hs
View file @ cadd8650
......@@ -21,7 +21,6 @@ Portability : POSIX
module Gargantext.Core.Types.Main where
------------------------------------------------------------------------
import Prelude (Enum, Bounded, minBound, maxBound)
import Data.Aeson (FromJSON, ToJSON, toJSON)
import Data.Aeson as A
......
src/Gargantext/Database/Bashql.hs
View file @ cadd8650
......@@ -80,8 +80,8 @@ import Data.Text (Text)
import Data.List (concat, last)
import Gargantext.Core.Types
import Gargantext.Database.Utils (connectGargandb)
import Gargantext.Database.Node
import Gargantext.Database.Utils (connectGargandb, Cmd(..), runCmd, mkCmd)
import Gargantext.Database.Schema.Node
import qualified Gargantext.Database.Node.Update as U (Update(..), update)
import Gargantext.Prelude
......
src/Gargantext/Database/Facet.hs
View file @ cadd8650
......@@ -33,7 +33,6 @@ import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.TH (deriveJSON)
import Data.Either(Either(Left))
import Data.Maybe (Maybe)
import Data.Profunctor.Product.Default
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.Swagger
import Data.Text (Text)
......@@ -44,14 +43,14 @@ import GHC.Generics (Generic)
import Gargantext.Core.Types
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Ngrams
import Gargantext.Database.Node
import Gargantext.Database.NodeNgram
import Gargantext.Database.NodeNode
import Gargantext.Database.Queries
import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.NodeNgram
import Gargantext.Database.Schema.NodeNode
import Gargantext.Database.Utils
import Gargantext.Database.Queries.Join
import Gargantext.Database.Queries.Filter
import Opaleye
import Opaleye.Internal.Join (NullMaker)
import Prelude (Enum, Bounded, minBound, maxBound)
import Prelude hiding (null, id, map, sum, not, read)
import Servant.API
import Test.QuickCheck (elements)
......@@ -193,8 +192,6 @@ queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNgramTable queryNgramsTable
cond45 (contact, (nodeNgram2, (_, (_,_)))) = _node_id contact .== nodeNgram_NodeNgramNodeId nodeNgram2
------------------------------------------------------------------------
runViewDocuments :: CorpusId -> Trash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd [FacetDoc]
......@@ -238,144 +235,3 @@ filterDocuments o l order q = limit' l $ offset' o $ orderBy ordering q
(Just FavDesc) -> desc facetDoc_favorite
_ -> desc facetDoc_created
------------------------------------------------------------------------
-- | TODO move this queries utilties elsewhere
leftJoin3' :: Query (NodeRead, (NodeNodeReadNull, NodeReadNull))
leftJoin3' = leftJoin3 queryNodeNodeTable queryNodeTable queryNodeTable cond12 cond23
where
cond12 = undefined
cond23 :: (NodeRead, (NodeNodeRead, NodeReadNull)) -> Column PGBool
cond23 = undefined
leftJoin3 :: ( Default Unpackspec columnsL1 columnsL1
, Default Unpackspec columnsL2 columnsL2
, Default Unpackspec columnsL3 columnsL3
, Default Unpackspec nullableColumnsL2 nullableColumnsL2
, Default NullMaker columnsL2 nullableColumnsL2
, Default NullMaker (columnsL1, nullableColumnsL2) nullableColumnsL3
)
=>
Query columnsL1 -> Query columnsL2 -> Query columnsL3
-> ((columnsL1, columnsL2) -> Column PGBool)
-> ((columnsL3, (columnsL1, nullableColumnsL2)) -> Column PGBool)
-> Query (columnsL3, nullableColumnsL3)
leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
--{-
leftJoin4' :: Query (NodeRead, (NodeReadNull, (NodeReadNull, NodeReadNull)))
leftJoin4' = leftJoin4 queryNodeTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34
where
cond12 = undefined
cond23 :: (NodeRead, (NodeRead, NodeReadNull)) -> Column PGBool
cond23 = undefined
cond34 :: (NodeRead, (NodeRead, (NodeReadNull, NodeReadNull))) -> Column PGBool
cond34 = undefined
leftJoin4 :: ( Default Unpackspec fieldsL1 fieldsL1,
Default Unpackspec fieldsL2 fieldsL2,
Default Unpackspec fieldsL3 fieldsL3,
Default Unpackspec fieldsR fieldsR,
Default Unpackspec nullableFieldsL1 nullableFieldsL1,
Default Unpackspec nullableFieldsL2 nullableFieldsL2,
Default NullMaker fieldsR nullableFieldsL2,
Default NullMaker (fieldsL2, nullableFieldsL1) nullableFieldsL3,
Default NullMaker (fieldsL3, nullableFieldsL2) nullableFieldsL1) =>
Query fieldsL3
-> Query fieldsR
-> Query fieldsL2
-> Query fieldsL1
-> ((fieldsL3, fieldsR)
-> Column PGBool)
-> ((fieldsL2, (fieldsL3, nullableFieldsL2))
-> Column PGBool)
-> ((fieldsL1, (fieldsL2, nullableFieldsL1))
-> Column PGBool)
-> Query (fieldsL1, nullableFieldsL3)
leftJoin4 q1 q2 q3 q4 cond12 cond23 cond34 = leftJoin q4 (leftJoin q3 (leftJoin q1 q2 cond12) cond23) cond34
--}
{-
-}
leftJoin5' :: Query (NodeRead, (NodeReadNull, (NodeReadNull, (NodeReadNull, NodeReadNull))))
leftJoin5' = leftJoin5 queryNodeTable queryNodeTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34 cond45
where
cond12 :: (NodeRead, NodeRead) -> Column PGBool
cond12 = undefined
cond23 :: (NodeRead, (NodeRead, NodeReadNull)) -> Column PGBool
cond23 = undefined
cond34 :: (NodeRead, (NodeRead, (NodeReadNull, NodeReadNull))) -> Column PGBool
cond34 = undefined
cond45 :: (NodeRead, (NodeRead, (NodeReadNull, (NodeReadNull, NodeReadNull)))) -> Column PGBool
cond45 = undefined
leftJoin5 :: ( Default Unpackspec fieldsL1 fieldsL1,
Default Unpackspec fieldsL2 fieldsL2,
Default Unpackspec nullableFieldsR1 nullableFieldsR1,
Default Unpackspec fieldsL3 fieldsL3,
Default Unpackspec nullableFieldsR2 nullableFieldsR2,
Default Unpackspec fieldsL4 fieldsL4,
Default Unpackspec nullableFieldsR3 nullableFieldsR3,
Default Unpackspec fieldsR fieldsR,
Default NullMaker fieldsR nullableFieldsR3,
Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR4,
Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1,
Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2) =>
Query fieldsR
-> Query fieldsL4
-> Query fieldsL3
-> Query fieldsL2
-> Query fieldsL1
-> ((fieldsL4, fieldsR) -> Column PGBool)
-> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool)
-> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
-> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
-> Query (fieldsL1, nullableFieldsR4)
leftJoin5 q1 q2 q3 q4 q5 cond12 cond23 cond34 cond45 = leftJoin q5 (leftJoin q4 (leftJoin q3 (leftJoin q2 q1 cond12) cond23) cond34) cond45
leftJoin6 :: ( Default Unpackspec fieldsL1 fieldsL1,
Default Unpackspec fieldsL2 fieldsL2,
Default Unpackspec nullableFieldsR1 nullableFieldsR1,
Default Unpackspec fieldsL3 fieldsL3,
Default Unpackspec nullableFieldsR2 nullableFieldsR2,
Default Unpackspec fieldsL4 fieldsL4,
Default Unpackspec nullableFieldsR3 nullableFieldsR3,
Default Unpackspec fieldsL5 fieldsL5,
Default Unpackspec nullableFieldsR4 nullableFieldsR4,
Default Unpackspec fieldsR fieldsR,
Default NullMaker fieldsR nullableFieldsR4,
Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR5,
Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1,
Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2,
Default NullMaker (fieldsL5, nullableFieldsR4) nullableFieldsR3) =>
Query fieldsR
-> Query fieldsL5
-> Query fieldsL4
-> Query fieldsL3
-> Query fieldsL2
-> Query fieldsL1 -> ((fieldsL5, fieldsR) -> Column PGBool)
-> ((fieldsL4, (fieldsL5, nullableFieldsR4)) -> Column PGBool)
-> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool)
-> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
-> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
-> Query (fieldsL1, nullableFieldsR5)
leftJoin6 q1 q2 q3 q4 q5 q6 cond12 cond23 cond34 cond45 cond56 =
leftJoin q6 (leftJoin q5 (leftJoin q4 (leftJoin q3 (leftJoin q2 q1 cond12) cond23) cond34) cond45) cond56
src/Gargantext/Database/Flow.hs
View file @ cadd8650
......@@ -27,17 +27,18 @@ import qualified Data.Map as DM
import Gargantext.Core.Types (NodePoly(..), ListType(..), listTypeId)
import Gargantext.Database.Bashql (runCmd') -- , del)
import Gargantext.Database.Config (userMaster, userArbitrary, corpusMasterName)
import Gargantext.Database.Ngrams (insertNgrams, Ngrams(..), NgramsT(..), NgramsIndexed(..), indexNgramsT, NgramsType(..), text2ngrams)
import Gargantext.Database.Node (mkRoot, mkCorpus, Cmd(..), mkList, mkGraph, mkDashboard, mkAnnuaire, getCorporaWithParentId')
import Gargantext.Database.Schema.Ngrams (insertNgrams, Ngrams(..), NgramsT(..), NgramsIndexed(..), indexNgramsT, NgramsType(..), text2ngrams)
import Gargantext.Database.Schema.Node (mkRoot, mkCorpus, mkList, mkGraph, mkDashboard, mkAnnuaire, getCorporaWithParentId')
import Gargantext.Database.Root (getRootCmd)
import Gargantext.Database.Types.Node (NodeType(..), NodeId)
import Gargantext.Database.Node.Document.Add (add)
import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
import Gargantext.Database.NodeNgram (NodeNgramPoly(..), insertNodeNgrams)
import Gargantext.Database.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew)
import Gargantext.Database.Schema.NodeNgram (NodeNgramPoly(..), insertNodeNgrams)
import Gargantext.Database.Schema.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew)
import Gargantext.Database.Types.Node (HyperdataDocument(..))
import Gargantext.Database.Utils (Cmd(..))
--import Gargantext.Database.Node.Contact (HyperdataContact(..))
import Gargantext.Database.User (getUser, UserLight(..))
import Gargantext.Database.Schema.User (getUser, UserLight(..))
import Gargantext.Core.Types.Individu (Username)
import Gargantext.Ext.IMT (toSchoolName)
import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
......
src/Gargantext/Database/Flow/Pairing.hs
View file @ cadd8650
......@@ -31,12 +31,12 @@ import qualified Data.Map as DM
import Data.Text (Text, toLower)
import qualified Data.Text as DT
import Gargantext.Prelude hiding (sum)
import Gargantext.Database.Ngrams -- (NgramsType(..))
import Gargantext.Database.Schema.Ngrams -- (NgramsType(..))
--import Gargantext.Database.Node.Contact -- (HyperdataContact(..))
--import Gargantext.Database.Types.Node -- (Hyperdata(..))
import Gargantext.Database.Node.Contact
import Gargantext.Database.Flow.Utils
import Gargantext.Database.Node (Cmd, mkCmd)
import Gargantext.Database.Utils (Cmd, mkCmd)
import Gargantext.Database.Node.Children
import Gargantext.Core.Types.Main
import Gargantext.Core.Types (NodeType(..))
......
src/Gargantext/Database/Flow/Utils.hs
View file @ cadd8650
......@@ -18,10 +18,10 @@ module Gargantext.Database.Flow.Utils
import Data.Map (Map)
import qualified Data.Map as DM
import Gargantext.Prelude
import Gargantext.Database.Ngrams
import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Types.Node (NodeId, Node, NodePoly(..), Hyperdata)
import Gargantext.Database.Node -- (Cmd)
import Gargantext.Database.NodeNgram
import Gargantext.Database.Utils (Cmd)
import Gargantext.Database.Schema.NodeNgram
toMaps :: Hyperdata a => (a -> Map (NgramsT Ngrams) Int) -> [Node a] -> Map (NgramsT Ngrams) (Map NodeId Int)
toMaps fun ns = mapNodeIdNgrams $ documentIdWithNgrams fun ns'
......
src/Gargantext/Database/Instances.hs deleted 100644 → 0
View file @ d22876cb
{-|
Module : Gargantext.Database.Instances
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Here is a longer description of this module, containing some
commentary with @some markup@.
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.Database.Instances where
import Gargantext.Prelude
import Data.Text (Text)
import Data.Time (UTCTime)
import Opaleye (PGInt4, PGTimestamptz, PGFloat8
, QueryRunnerColumnDefault
, queryRunnerColumnDefault
, fieldQueryRunnerColumn
, Nullable, PGText)
instance QueryRunnerColumnDefault PGInt4 Integer where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault (Nullable PGText) Text where
queryRunnerColumnDefault = fieldQueryRunnerColumn
src/Gargantext/Database/Node/Children.hs
View file @ cadd8650
......@@ -20,10 +20,11 @@ module Gargantext.Database.Node.Children where
import Database.PostgreSQL.Simple (Connection)
import Opaleye
import Gargantext.Core.Types
import Gargantext.Database.Node
import Gargantext.Database.NodeNode
import Gargantext.Database.Schema.Node
import Gargantext.Database.Utils
import Gargantext.Database.Schema.NodeNode
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Queries
import Gargantext.Database.Queries.Filter
import Gargantext.Database.Node.Contact (HyperdataContact)
import Control.Arrow (returnA)
......
src/Gargantext/Database/Node/Contact.hs
View file @ cadd8650
......@@ -29,7 +29,7 @@ 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.Node (NodeWrite', Name, node)
import Gargantext.Database.Schema.Node (NodeWrite', Name, node)
import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..))
import Gargantext.Database.Utils (fromField')
import Gargantext.Prelude
......
src/Gargantext/Database/Node/Document/Add.hs
View file @ cadd8650
......@@ -32,7 +32,7 @@ import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Data.Text (Text)
import Gargantext.Database.Node (mkCmd, Cmd(..))
import Gargantext.Database.Utils (mkCmd, Cmd(..))
import Gargantext.Database.Types.Node
import Gargantext.Prelude
......
src/Gargantext/Database/Node/Document/Insert.hs
View file @ cadd8650
......@@ -74,7 +74,7 @@ import Database.PostgreSQL.Simple.ToRow (ToRow(..))
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import GHC.Generics (Generic)
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Node (mkCmd, Cmd(..))
import Gargantext.Database.Utils (mkCmd, Cmd(..))
import Gargantext.Database.Node.Contact -- (HyperdataContact(..), ContactWho(..))
import Gargantext.Database.Types.Node
import Gargantext.Prelude
......
src/Gargantext/Database/Queries.hs deleted 100644 → 0
View file @ d22876cb
{-|
Module : Gargantext.Database.Queries
Description : Main requests of Node to the database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.Database.Queries where
import Gargantext.Prelude
import Gargantext.Core.Types (Limit, Offset, NodePoly)
import Data.Maybe (Maybe, maybe)
import Control.Arrow ((>>>))
import Control.Applicative ((<*>))
import Opaleye
-- (Query, limit, offset)
type NodeWrite = NodePoly (Maybe (Column PGInt4 ))
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Maybe (Column PGTimestamptz))
(Column PGJsonb )
-- (Maybe (Column PGTSVector))
type NodeRead = NodePoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Column PGTimestamptz )
(Column PGJsonb)
-- (Column PGTSVector)
type NodeReadNull = NodePoly (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGText ))
(Column (Nullable PGTimestamptz ))
(Column (Nullable PGJsonb))
join3 :: Query columnsA -> Query columnsB -> Query columnsC
-> ((columnsA, columnsB, columnsC) -> Column PGBool)
-> Query (columnsA, columnsB, columnsC)
join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
--leftJoin3 :: Query columnsL1 -> Query columnsR -> Query columnsL
-- -> ((columnsL1, columnsR) -> Column PGBool)
-- -> ((columnsL, (columnsL1, nullableColumnsR1)) -> Column PGBool)
-- -> Query (columnsL, nullableColumnsR)
--leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
limit' :: Maybe Limit -> Query a -> Query a
limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
offset' :: Maybe Offset -> Query a -> Query a
offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
src/Gargantext/Database/Queries/Filter.hs 0 → 100644
View file @ cadd8650
{-|
Module : Gargantext.Database.Queries.Filter
Description : Main requests of Node to the database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.Database.Queries.Filter where
import Gargantext.Core.Types (Limit, Offset)
import Data.Maybe (Maybe, maybe)
import Opaleye (Query, limit, offset)
limit' :: Maybe Limit -> Query a -> Query a
limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
offset' :: Maybe Offset -> Query a -> Query a
offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
src/Gargantext/Database/Queries/Join.hs 0 → 100644
View file @ cadd8650
{-|
Module : Gargantext.Database.Queries.Join
Description : Main requests of Node to the database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
------------------------------------------------------------------------
module Gargantext.Database.Queries.Join
where
------------------------------------------------------------------------
import Control.Applicative ((<*>))
import Control.Arrow ((>>>))
import Data.Profunctor.Product.Default
import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.NodeNode
import Gargantext.Prelude
import Opaleye
import Opaleye.Internal.Join (NullMaker(..))
import qualified Opaleye.Internal.Unpackspec()
--leftJoin3 :: Query columnsL1 -> Query columnsR -> Query columnsL
-- -> ((columnsL1, columnsR) -> Column PGBool)
-- -> ((columnsL, (columnsL1, nullableColumnsR1)) -> Column PGBool)
-- -> Query (columnsL, nullableColumnsR)
--leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
join3 :: Query columnsA -> Query columnsB -> Query columnsC
-> ((columnsA, columnsB, columnsC) -> Column PGBool)
-> Query (columnsA, columnsB, columnsC)
join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
------------------------------------------------------------------------
leftJoin3' :: Query (NodeRead, (NodeNodeReadNull, NodeReadNull))
leftJoin3' = leftJoin3 queryNodeNodeTable queryNodeTable queryNodeTable cond12 cond23
where
cond12 = undefined
cond23 :: (NodeRead, (NodeNodeRead, NodeReadNull)) -> Column PGBool
cond23 = undefined
leftJoin3 :: ( Default Unpackspec columnsL1 columnsL1
, Default Unpackspec columnsL2 columnsL2
, Default Unpackspec columnsL3 columnsL3
, Default Unpackspec nullableColumnsL2 nullableColumnsL2
, Default NullMaker columnsL2 nullableColumnsL2
, Default NullMaker (columnsL1, nullableColumnsL2) nullableColumnsL3
)
=>
Query columnsL1 -> Query columnsL2 -> Query columnsL3
-> ((columnsL1, columnsL2) -> Column PGBool)
-> ((columnsL3, (columnsL1, nullableColumnsL2)) -> Column PGBool)
-> Query (columnsL3, nullableColumnsL3)
leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
--{-
leftJoin4' :: Query (NodeRead, (NodeReadNull, (NgramsReadNull, NodeReadNull)))
leftJoin4' = leftJoin4 queryNgramsTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34
where
cond12 :: (NgramsRead, NodeRead) -> Column PGBool
cond12 = undefined
cond23 :: (NodeRead, (NgramsRead, NodeReadNull)) -> Column PGBool
cond23 = undefined
cond34 :: (NodeRead, (NodeRead, (NgramsReadNull, NodeReadNull))) -> Column PGBool
cond34 = undefined
{-
rightJoin4' :: Query (((NodeReadNull, NodeReadNull), NodeReadNull), NodeRead)
rightJoin4' = rightJoin4 queryNodeTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34
where
cond12 :: (NodeRead, NodeRead) -> Column PGBool
cond12 = undefined
cond23 :: ((NodeReadNull, NodeRead), NodeRead) -> Column PGBool
cond23 = undefined
cond34 :: (((NodeReadNull, NodeReadNull), NodeRead), NodeRead) -> Column PGBool
cond34 = undefined
--}
leftJoin4
:: (Default Unpackspec fieldsL1 fieldsL1,
Default Unpackspec fieldsL2 fieldsL2,
Default Unpackspec nullableFieldsR1 nullableFieldsR1,
Default Unpackspec fieldsL3 fieldsL3,
Default Unpackspec nullableFieldsR2 nullableFieldsR2,
Default Unpackspec fieldsR fieldsR,
Default NullMaker fieldsR nullableFieldsR2,
Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR3,
Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1) =>
Opaleye.Select fieldsL3
-> Opaleye.Select fieldsR
-> Opaleye.Select fieldsL2
-> Opaleye.Select fieldsL1
-> ((fieldsL3, fieldsR) -> Column PGBool)
-> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
-> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
-> Opaleye.Select (fieldsL1, nullableFieldsR3)
leftJoin4 q1 q2 q3 q4 cond12 cond23 cond34 = leftJoin q4 (leftJoin q3 (leftJoin q1 q2 cond12) cond23) cond34
-- rightJoin4 q1 q2 q3 q4 cond12 cond23 cond34 = rightJoin q4 (rightJoin q3 (rightJoin q1 q2 cond12) cond23) cond34
leftJoin5' :: Query (NodeRead, (NodeReadNull, (NodeReadNull, (NodeReadNull, NodeReadNull))))
leftJoin5' = leftJoin5 queryNodeTable queryNodeTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34 cond45
where
cond12 :: (NodeRead, NodeRead) -> Column PGBool
cond12 = undefined
cond23 :: (NodeRead, (NodeRead, NodeReadNull)) -> Column PGBool
cond23 = undefined
cond34 :: (NodeRead, (NodeRead, (NodeReadNull, NodeReadNull))) -> Column PGBool
cond34 = undefined
cond45 :: (NodeRead, (NodeRead, (NodeReadNull, (NodeReadNull, NodeReadNull)))) -> Column PGBool
cond45 = undefined
leftJoin5 :: ( Default Unpackspec fieldsL1 fieldsL1,
Default Unpackspec fieldsL2 fieldsL2,
Default Unpackspec nullableFieldsR1 nullableFieldsR1,
Default Unpackspec fieldsL3 fieldsL3,
Default Unpackspec nullableFieldsR2 nullableFieldsR2,
Default Unpackspec fieldsL4 fieldsL4,
Default Unpackspec nullableFieldsR3 nullableFieldsR3,
Default Unpackspec fieldsR fieldsR,
Default NullMaker fieldsR nullableFieldsR3,
Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR4,
Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1,
Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2) =>
Query fieldsR
-> Query fieldsL4
-> Query fieldsL3
-> Query fieldsL2
-> Query fieldsL1
-> ((fieldsL4, fieldsR) -> Column PGBool)
-> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool)
-> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
-> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
-> Query (fieldsL1, nullableFieldsR4)
leftJoin5 q1 q2 q3 q4 q5 cond12 cond23 cond34 cond45 = leftJoin q5 (leftJoin q4 (leftJoin q3 (leftJoin q2 q1 cond12) cond23) cond34) cond45
leftJoin6 :: ( Default Unpackspec fieldsL1 fieldsL1,
Default Unpackspec fieldsL2 fieldsL2,
Default Unpackspec nullableFieldsR1 nullableFieldsR1,
Default Unpackspec fieldsL3 fieldsL3,
Default Unpackspec nullableFieldsR2 nullableFieldsR2,
Default Unpackspec fieldsL4 fieldsL4,
Default Unpackspec nullableFieldsR3 nullableFieldsR3,
Default Unpackspec fieldsL5 fieldsL5,
Default Unpackspec nullableFieldsR4 nullableFieldsR4,
Default Unpackspec fieldsR fieldsR,
Default NullMaker fieldsR nullableFieldsR4,
Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR5,
Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1,
Default NullMaker (fieldsL4, nullableFieldsR3) nullableFieldsR2,
Default NullMaker (fieldsL5, nullableFieldsR4) nullableFieldsR3) =>
Query fieldsR
-> Query fieldsL5
-> Query fieldsL4
-> Query fieldsL3
-> Query fieldsL2
-> Query fieldsL1 -> ((fieldsL5, fieldsR) -> Column PGBool)
-> ((fieldsL4, (fieldsL5, nullableFieldsR4)) -> Column PGBool)
-> ((fieldsL3, (fieldsL4, nullableFieldsR3)) -> Column PGBool)
-> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
-> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
-> Query (fieldsL1, nullableFieldsR5)
leftJoin6 q1 q2 q3 q4 q5 q6 cond12 cond23 cond34 cond45 cond56 =
leftJoin q6 (leftJoin q5 (leftJoin q4 (leftJoin q3 (leftJoin q2 q1 cond12) cond23) cond34) cond45) cond56
src/Gargantext/Database/Root.hs
View file @ cadd8650
......@@ -31,12 +31,12 @@ import Opaleye.PGTypes (pgStrictText, pgInt4)
import Control.Arrow (returnA)
import Gargantext.Prelude
import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser), HyperdataUser)
import Gargantext.Database.Queries (NodeRead)
import Gargantext.Database.Node (queryNodeTable)
import Gargantext.Database.User (queryUserTable, UserPoly(..))
import Gargantext.Database.Schema.Node (NodeRead)
import Gargantext.Database.Schema.Node (queryNodeTable)
import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..))
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Core.Types.Individu (Username)
import Gargantext.Database.Node (Cmd(..), mkCmd)
import Gargantext.Database.Utils (Cmd(..), mkCmd)
getRootCmd :: Username -> Cmd [Node HyperdataUser]
getRootCmd u = mkCmd $ \c -> getRoot u c
......
src/Gargantext/Database/Ngrams.hs → src/Gargantext/Database/Schema/Ngrams.hs
View file @ cadd8650
{-|
Module : Gargantext.Database.Ngrams
Module : Gargantext.Database.Schema.Ngrams
Description : Ngram connection to the Database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
......@@ -21,17 +21,16 @@ Ngrams connection to the Database.
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Ngrams where
module Gargantext.Database.Schema.Ngrams where
import Database.PostgreSQL.Simple as DPS (Connection)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Opaleye
import Control.Lens (makeLenses, view)
import Data.ByteString.Internal (ByteString)
import Data.Map (Map, fromList, lookup, fromListWith)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.Set (Set)
import Data.Text (Text, splitOn)
import Database.PostgreSQL.Simple as DPS (Connection)
import Database.PostgreSQL.Simple.FromRow (fromRow, field)
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.ToField (toField)
......@@ -39,13 +38,15 @@ import Database.PostgreSQL.Simple.ToRow (toRow)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Debug.Trace (trace)
import GHC.Generics (Generic)
import Gargantext.Core.Types (CorpusId)
import Gargantext.Core.Types -- (fromListTypeId, ListType, NodePoly(Node))
import Gargantext.Database.Config (nodeTypeId,userMaster)
import Gargantext.Database.Node (mkCmd, Cmd(..),getListsWithParentId, getCorporaWithParentId)
import Gargantext.Database.Root (getRoot)
import Gargantext.Core.Types (CorpusId)
import Gargantext.Database.Types.Node (NodeType)
import Gargantext.Database.Schema.Node (getListsWithParentId, getCorporaWithParentId)
import Gargantext.Database.Utils (mkCmd, Cmd(..))
import Gargantext.Prelude
import Opaleye
import Prelude (Enum, Bounded, minBound, maxBound)
import qualified Data.Set as DS
import qualified Database.PostgreSQL.Simple as DPS
......
src/Gargantext/Database/Node.hs → src/Gargantext/Database/Schema/Node.hs
View file @ cadd8650
{-|
Module : Gargantext.Database.Node
Module : Gargantext.Database.Schema.Node
Description : Main requests of Node to the database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
......@@ -17,74 +17,41 @@ Portability : POSIX
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Node where
module Gargantext.Database.Schema.Node where
import Data.Text (pack)
import GHC.Int (Int64)
import Control.Arrow (returnA)
import Control.Lens (set)
import Data.Maybe
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Data.Aeson
import Data.ByteString (ByteString)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.Text (Text, pack)
import Data.Time (UTCTime)
import Database.PostgreSQL.Simple (Connection)
import Database.PostgreSQL.Simple.FromField (FromField, fromField)
import Prelude hiding (null, id, map, sum)
import GHC.Int (Int64)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu (Username)
import Gargantext.Database.Utils (fromField')
import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
import Gargantext.Database.Queries
import Gargantext.Core.Types.Main (UserId)
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Queries.Filter (limit', offset')
import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
import Gargantext.Database.Utils
import Gargantext.Prelude hiding (sum, head)
import Gargantext.Core.Types.Main (UserId)
import Control.Applicative (Applicative)
import Control.Arrow (returnA)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Aeson
import Data.Maybe (Maybe, fromMaybe)
import Data.Text (Text)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import qualified Data.ByteString as DB
import qualified Data.ByteString.Lazy as DBL
import Data.ByteString (ByteString)
import Database.PostgreSQL.Simple (Connection)
import Opaleye hiding (FromField)
import Opaleye.Internal.QueryArr (Query)
import Prelude hiding (null, id, map, sum)
import qualified Data.ByteString as DB
import qualified Data.ByteString.Lazy as DBL
import qualified Data.Profunctor.Product as PP
------------------------------------------------------------------------
------------------------------------------------------------------------
{- | Reader Monad reinvented here:
newtype Cmd a = Cmd { unCmd :: Connection -> IO a }
instance Monad Cmd where
return a = Cmd $ \_ -> return a
m >>= f = Cmd $ \c -> do
a <- unCmd m c
unCmd (f a) c
-}
newtype Cmd a = Cmd (ReaderT Connection IO a)
deriving (Functor, Applicative, Monad, MonadReader Connection, MonadIO)
runCmd :: Connection -> Cmd a -> IO a
runCmd c (Cmd f) = runReaderT f c
mkCmd :: (Connection -> IO a) -> Cmd a
mkCmd = Cmd . ReaderT
------------------------------------------------------------------------
------------------------------------------------------------------------
instance FromField HyperdataAny
where
......@@ -141,25 +108,68 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataList
instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire
where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector)
where
queryRunnerColumnDefault = fieldQueryRunnerColumn
------------------------------------------------------------------------
-- WIP
-- TODO Classe HasDefault where
-- default NodeType = Hyperdata
------------------------------------------------------------------------
$(makeAdaptorAndInstance "pNode" ''NodePoly)
$(makeLensesWith abbreviatedFields ''NodePoly)
$(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
$(makeLensesWith abbreviatedFields ''NodePolySearch)
type NodeWrite = NodePoly (Maybe (Column PGInt4 ))
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Maybe (Column PGTimestamptz))
(Column PGJsonb )
type NodeRead = NodePoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Column PGTimestamptz )
(Column PGJsonb)
type NodeReadNull = NodePoly (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGText ))
(Column (Nullable PGTimestamptz ))
(Column (Nullable PGJsonb))
nodeTable :: Table NodeWrite NodeRead
nodeTable = Table "nodes" (pNode Node { _node_id = optional "id"
, _node_typename = required "typename"
, _node_userId = required "user_id"
, _node_parentId = required "parent_id"
, _node_name = required "name"
, _node_date = optional "date"
, _node_hyperdata = required "hyperdata"
-- , node_titleAbstract = optional "title_abstract"
}
)
queryNodeTable :: Query NodeRead
queryNodeTable = queryTable nodeTable
-- | TODO remove below
type NodeWrite' = NodePoly (Maybe Int) Int Int (Maybe ParentId) Text (Maybe UTCTime) ByteString
--{-
nodeTable' :: Table (Maybe (Column PGInt4)
, Column PGInt4
, Column PGInt4
......@@ -180,16 +190,67 @@ nodeTable' :: Table (Maybe (Column PGInt4)
nodeTable' = Table "nodes" (PP.p7 ( optional "id"
, required "typename"
, required "user_id"
, optional "parent_id"
, required "name"
, optional "date"
, required "hyperdata"
)
)
--}
------------------------------------------------------------------------
-- | Node(Read|Write)Search is slower than Node(Write|Read) use it
-- for full text search only
type NodeSearchWrite = NodePolySearch (Maybe (Column PGInt4 ))
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Maybe (Column PGTimestamptz))
(Column PGJsonb )
(Maybe (Column PGTSVector))
type NodeSearchRead = NodePolySearch (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Column PGTimestamptz )
(Column PGJsonb)
(Column PGTSVector)
type NodeSearchReadNull = NodePolySearch (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGText ))
(Column (Nullable PGTimestamptz ))
(Column (Nullable PGJsonb))
(Column (Nullable PGTSVector))
--{-
nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optional "id"
, _ns_typename = required "typename"
, _ns_userId = required "user_id"
, _ns_parentId = required "parent_id"
, _ns_name = required "name"
, _ns_date = optional "date"
, _ns_hyperdata = required "hyperdata"
, _ns_search = optional "search"
}
)
--}
queryNodeSearchTable :: Query NodeSearchRead
queryNodeSearchTable = queryTable nodeTableSearch
queryNodeTable :: Query NodeRead
queryNodeTable = queryTable nodeTable
selectNode :: Column PGInt4 -> Query NodeRead
selectNode id = proc () -> do
......@@ -197,6 +258,7 @@ selectNode id = proc () -> do
restrict -< _node_id row .== id
returnA -< row
runGetNodes :: Query NodeRead -> Cmd [NodeAny]
runGetNodes q = mkCmd $ \conn -> runQuery conn q
......@@ -304,11 +366,7 @@ getNodesWithType conn type_id = do
runQuery conn $ selectNodesWithType type_id
------------------------------------------------------------------------
-- WIP
-- TODO Classe HasDefault where
-- default NodeType = Hyperdata
------------------------------------------------------------------------
type NodeWrite' = NodePoly (Maybe Int) Int Int (Maybe ParentId) Text (Maybe UTCTime) ByteString
------------------------------------------------------------------------
defaultUser :: HyperdataUser
defaultUser = HyperdataUser (Just $ (pack . show) EN)
......@@ -395,16 +453,20 @@ node nodeType name hyperData parentId userId = Node Nothing typeId userId parent
-------------------------------
node2row :: (Functor maybe1, Functor maybe2, Functor maybe3) =>
NodePoly (maybe2 Int) Int Int (maybe1 Int)
Text (maybe3 UTCTime) ByteString
-> (maybe2 (Column PGInt4), Column PGInt4, Column PGInt4, maybe1 (Column PGInt4)
, Column PGText, maybe3 (Column PGTimestamptz), Column PGJsonb)
NodePoly (maybe1 Int) Int Int
(maybe2 Int) Text (maybe3 UTCTime)
ByteString
-> ( maybe1 (Column PGInt4), Column PGInt4, Column PGInt4
, maybe2 (Column PGInt4), Column PGText, maybe3 (Column PGTimestamptz)
, Column PGJsonb)
node2row (Node id tn ud pid nm dt hp) = ((pgInt4 <$> id)
,(pgInt4 tn)
,(pgInt4 ud)
,(pgInt4 <$> pid)
,(pgStrictText nm)
,(pgUTCTime <$> dt)
,(pgStrictJSONB hp)
)
------------------------------------------------------------------------
......@@ -451,7 +513,7 @@ data Node' = Node' { _n_type :: NodeType
, _n_children :: [Node']
} deriving (Show)
-- | TODO NodeWriteT -> NodeWrite
type NodeWriteT = ( Maybe (Column PGInt4)
, Column PGInt4
, Column PGInt4
......@@ -461,9 +523,12 @@ type NodeWriteT = ( Maybe (Column PGInt4)
, Column PGJsonb
)
mkNode' :: [NodeWrite] -> Cmd Int64
mkNode' ns = mkCmd $ \conn -> runInsertMany conn nodeTable ns
mkNode' :: [NodeWriteT] -> Cmd Int64
mkNode' ns = mkCmd $ \conn -> runInsertMany conn nodeTable' ns
-- TODO: replace mkNodeR'
mkNodeR'' :: [NodeWrite] -> Cmd [Int]
mkNodeR'' ns = mkCmd $ \conn -> runInsertManyReturning conn nodeTable ns (_node_id)
mkNodeR' :: [NodeWriteT] -> Cmd [Int]
mkNodeR' ns = mkCmd $ \conn -> runInsertManyReturning conn nodeTable' ns (\(i,_,_,_,_,_,_) -> i)
......
src/Gargantext/Database/NodeNgram.hs → src/Gargantext/Database/Schema/NodeNgram.hs
View file @ cadd8650
{-|
Module : Gargantext.Database.NodeNgrams
Module : Gargantext.Database.Schema.NodeNgrams
Description : NodeNgram for Ngram indexation or Lists
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
......@@ -27,7 +27,7 @@ if Node is a List then it is listing (either Stop, Candidate or Map)
-- TODO NodeNgrams
module Gargantext.Database.NodeNgram where
module Gargantext.Database.Schema.NodeNgram where
import Data.Text (Text)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
......@@ -35,7 +35,7 @@ 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.Database.Node (mkCmd, Cmd(..))
import Gargantext.Database.Utils (mkCmd, Cmd(..))
import Gargantext.Prelude
import Opaleye
import qualified Database.PostgreSQL.Simple as PGS (Connection, query, Only(..))
......
src/Gargantext/Database/NodeNgramsNgrams.hs → src/Gargantext/Database/Schema/NodeNgramsNgrams.hs
View file @ cadd8650
{-|
Module : Gargantext.Database.NodeNgramsNgrams
Module : Gargantext.Database.Schema.NodeNgramsNgrams
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
......@@ -28,7 +28,7 @@ Next Step benchmark:
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.Database.NodeNgramsNgrams
module Gargantext.Database.Schema.NodeNgramsNgrams
where
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
......@@ -37,7 +37,7 @@ import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Gargantext.Database.Node (mkCmd, Cmd(..))
import Gargantext.Database.Utils (mkCmd, Cmd(..))
import Gargantext.Prelude
import Opaleye
import qualified Database.PostgreSQL.Simple as DPS
......
src/Gargantext/Database/NodeNode.hs → src/Gargantext/Database/Schema/NodeNode.hs
View file @ cadd8650
{-|
Module : Gargantext.Database.NodeNode
Module : Gargantext.Database.Schema.NodeNode
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
......@@ -22,7 +22,7 @@ commentary with @some markup@.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.NodeNode where
module Gargantext.Database.Schema.NodeNode where
import qualified Database.PostgreSQL.Simple as PGS (Connection, Query, query, Only(..))
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
......@@ -30,7 +30,7 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Gargantext.Database.Node (Cmd(..), mkCmd)
import Gargantext.Database.Utils
import Gargantext.Core.Types.Main (CorpusId, DocId)
import Gargantext.Prelude
import Opaleye
......
src/Gargantext/Database/NodeNodeNgram.hs → src/Gargantext/Database/Schema/NodeNodeNgram.hs
View file @ cadd8650
{-|
Module : Gargantext.Database.NodeNodeNgram
Module : Gargantext.Database.Schema.NodeNodeNgram
Description : TODO: remove this module and table in database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
......@@ -18,7 +18,7 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.Database.NodeNodeNgram where
module Gargantext.Database.Schema.NodeNodeNgram where
import Prelude
import Data.Maybe (Maybe)
......
src/Gargantext/Database/User.hs → src/Gargantext/Database/Schema/User.hs
View file @ cadd8650
......@@ -20,7 +20,7 @@ Functions to deal with users, database side.
{-# LANGUAGE Arrows #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.Database.User where
module Gargantext.Database.Schema.User where
import Control.Arrow (returnA)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
......@@ -31,8 +31,8 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.Show(Show(..))
import Gargantext.Database.Node (Cmd(..), mkCmd, runCmd)
import Gargantext.Core.Types.Individu (Username)
import Gargantext.Database.Utils
import Gargantext.Prelude
import Opaleye
......
src/Gargantext/Database/TextSearch.hs
View file @ cadd8650
......@@ -6,33 +6,96 @@ License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Database.TextSearch where
import Data.Aeson
import Data.List (intersperse)
import Data.String (IsString(..))
import Data.Text (Text, words)
import Database.PostgreSQL.Simple
import Data.Text (Text, words, unpack)
import Database.PostgreSQL.Simple -- (Query, Connection)
import Database.PostgreSQL.Simple.ToField
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Types.Node (NodeType(..))
import Gargantext.Prelude
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.NodeNode
import Gargantext.Core.Types
import Control.Arrow (returnA)
import qualified Opaleye as O hiding (Order)
import Opaleye hiding (Query, Order)
newtype TSQuery = UnsafeTSQuery [Text]
globalTextSearch :: Connection -> ParentId -> Text -> IO [(NodeId, HyperdataDocument)]
globalTextSearch c p t = runQuery c (globalTextSearchQuery p t)
-- | Global search query where ParentId is Master Node Corpus Id
globalTextSearchQuery :: ParentId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
globalTextSearchQuery _ q = proc () -> do
row <- queryNodeSearchTable -< ()
restrict -< (_ns_search row) @@ (pgTSQuery (unpack q))
restrict -< (_ns_typename row) .== (pgInt4 $ nodeTypeId NodeDocument)
returnA -< (_ns_id row, _ns_hyperdata row)
------------------------------------------------------------------------
{-
graphCorpusAuthorQuery :: O.Query (NodeRead, (NodeNgramRead, (NgramsReadNull, NodeNgramReadNull)))
graphCorpusAuthorQuery = leftJoin4 queryNgramsTable queryNodeNgramTable queryNodeNgramTable queryNodeTable cond12 cond23 cond34
where
--cond12 :: (NgramsRead, NodeNgramRead) -> Column PGBool
cond12 = undefined
cond23 :: (NodeNgramRead, (NodeNgramRead, NodeNgramReadNull)) -> Column PGBool
cond23 = undefined
cond34 :: (NodeRead, (NodeNgramRead, (NodeReadNull, NodeNgramReadNull))) -> Column PGBool
cond34 = undefined
--}
--runGraphCorpusDocSearch :: Connection -> CorpusId -> Text -> IO [(Column PGInt4, Column PGJsonb)]
--runGraphCorpusDocSearch c cId t = runQuery c $ graphCorpusDocSearch cId t
-- | todo add limit and offset and order
graphCorpusDocSearch :: CorpusId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
graphCorpusDocSearch cId t = proc () -> do
(n, nn) <- graphCorpusDocSearchQuery -< ()
restrict -< (_ns_search n) @@ (pgTSQuery (unpack t))
restrict -< ( nodeNode_node1_id nn) .== (toNullable $ pgInt4 cId)
restrict -< (_ns_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
returnA -< (_ns_id n, _ns_hyperdata n)
graphCorpusDocSearchQuery :: O.Query (NodeSearchRead, NodeNodeReadNull)
graphCorpusDocSearchQuery = leftJoin queryNodeSearchTable queryNodeNodeTable cond
where
cond :: (NodeSearchRead, NodeNodeRead) -> Column PGBool
cond (n, nn) = nodeNode_node1_id nn .== _ns_id n
-- | TODO [""] -> panic "error"
toTSQuery :: [Text] -> TSQuery
toTSQuery txt = UnsafeTSQuery txt
instance IsString TSQuery
where
fromString = UnsafeTSQuery . words . cs
......@@ -48,9 +111,6 @@ instance ToField TSQuery
]
) xs
type ParentId = Int
type Limit = Int
type Offset = Int
data Order = Asc | Desc
instance ToField Order
......
src/Gargantext/Database/Types/Node.hs
View file @ cadd8650
......@@ -63,8 +63,6 @@ type UTCTime' = UTCTime
instance Arbitrary UTCTime' where
arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
------------------------------------------------------------------------
data Status = Status { status_failed :: Int
, status_succeeded :: Int
......@@ -324,18 +322,15 @@ instance Hyperdata HyperdataNotebook
-- | NodePoly indicates that Node has a Polymorphism Type
type Node json = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
type Node json = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) 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 NodeVector = Vector
type TSVector = Text
--type NodeUser = Node HyperdataUser
type NodeAny = Node HyperdataAny
-- | Then a Node can be either a Folder or a Corpus or a Document
type NodeUser = Node HyperdataUser
......@@ -347,6 +342,9 @@ type NodeDocument = Node HyperdataDocument
type NodeAnnuaire = Node HyperdataAnnuaire
-- | Any others nodes
type NodeAny = Node HyperdataAny
---- | Then a Node can be either a Graph or a Phylo or a Notebook
type NodeList = Node HyperdataList
type NodeGraph = Node HyperdataGraph
......@@ -379,23 +377,67 @@ instance ToParamSchema NodeType
instance ToSchema NodeType
------------------------------------------------------------------------
data NodePoly id typename userId parentId name date hyperdata = Node { _node_id :: id
data NodePoly id typename userId
parentId name date
hyperdata = Node { _node_id :: id
, _node_typename :: typename
, _node_userId :: userId
-- , nodeUniqId :: hashId
, _node_parentId :: parentId
, _node_name :: name
, _node_date :: date
, _node_hyperdata :: hyperdata
} deriving (Show, Generic)
$(deriveJSON (unPrefix "_node_") ''NodePoly)
$(makeLenses ''NodePoly)
instance Arbitrary hyperdata => Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime hyperdata) where
arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) <$> arbitrary
instance Arbitrary hyperdata => Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime hyperdata) where
arbitrary = Node 1 1 1 (Just 1) "name" (jour 2018 01 01) <$> arbitrary
data NodePolySearch id typename userId
parentId name date
hyperdata search = NodeSearch { _ns_id :: id
, _ns_typename :: typename
, _ns_userId :: userId
-- , nodeUniqId :: hashId
, _ns_parentId :: parentId
, _ns_name :: name
, _ns_date :: date
, _ns_hyperdata :: hyperdata
, _ns_search :: search
} deriving (Show, Generic)
$(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
$(makeLenses ''NodePolySearch)
type NodeSearch json = NodePolySearch NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json (Maybe TSVector)
------------------------------------------------------------------------
instance (Arbitrary hyperdata
,Arbitrary nodeId
,Arbitrary nodeTypeId
,Arbitrary nodeUserId
,Arbitrary nodeParentId
) => Arbitrary (NodePoly nodeId nodeTypeId nodeUserId nodeParentId
NodeName UTCTime hyperdata) where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary
instance (Arbitrary hyperdata
,Arbitrary nodeId
,Arbitrary nodeTypeId
,Arbitrary nodeUserId
,Arbitrary nodeParentId
) => Arbitrary (NodePolySearch nodeId nodeTypeId nodeUserId 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
<*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary
------------------------------------------------------------------------
hyperdataDocument :: HyperdataDocument
......@@ -449,6 +491,20 @@ instance ToSchema hyperdata =>
)
instance ToSchema hyperdata =>
ToSchema (NodePolySearch NodeId NodeTypeId
(Maybe NodeUserId)
NodeParentId NodeName
UTCTime hyperdata (Maybe TSVector)
)
instance ToSchema hyperdata =>
ToSchema (NodePolySearch NodeId NodeTypeId
NodeUserId
(Maybe NodeParentId) NodeName
UTCTime hyperdata (Maybe TSVector)
)
instance ToSchema Status
......
src/Gargantext/Database/Utils.hs
View file @ cadd8650
......@@ -14,37 +14,54 @@ commentary with @some markup@.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Gargantext.Database.Utils where
import qualified Database.PostgreSQL.Simple as PGS
import Control.Applicative (Applicative)
import Control.Monad.Reader
import Data.Aeson (Result(Error,Success), fromJSON, FromJSON)
import Data.Typeable (Typeable)
import Data.Monoid ((<>))
import Data.Either.Extra (Either(Left, Right))
import Database.PostgreSQL.Simple.Internal (Field)
import qualified Data.ByteString as DB
import Database.PostgreSQL.Simple.FromField ( Conversion
, ResultError(ConversionFailed)
, fromField
, returnError
)
import Data.Ini (readIniFile, lookupValue)
import Data.Maybe (maybe)
import Data.Monoid ((<>))
import Data.Profunctor.Product.Default (Default)
import Data.Text (unpack, pack)
import Data.Typeable (Typeable)
import Data.Word (Word16)
import Database.PostgreSQL.Simple (Connection, connect)
import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
import Database.PostgreSQL.Simple.Internal (Field)
import Gargantext.Prelude
import Opaleye (Query, Unpackspec, showSqlForPostgres)
import System.IO (FilePath)
import Text.Read (read)
import qualified Data.ByteString as DB
import qualified Database.PostgreSQL.Simple as PGS
-- Utilities
import Opaleye (Query, Unpackspec, showSqlForPostgres)
import Data.Profunctor.Product.Default (Default)
import Data.Maybe (maybe)
-- TODO add a reader Monad here
-- read this in the init file
------------------------------------------------------------------------
{- | Reader Monad reinvented here:
newtype Cmd a = Cmd { unCmd :: Connection -> IO a }
instance Monad Cmd where
return a = Cmd $ \_ -> return a
m >>= f = Cmd $ \c -> do
a <- unCmd m c
unCmd (f a) c
-}
newtype Cmd a = Cmd (ReaderT Connection IO a)
deriving (Functor, Applicative, Monad, MonadReader Connection, MonadIO)
runCmd :: Connection -> Cmd a -> IO a
runCmd c (Cmd f) = runReaderT f c
mkCmd :: (Connection -> IO a) -> Cmd a
mkCmd = Cmd . ReaderT
------------------------------------------------------------------------
databaseParameters :: FilePath -> IO PGS.ConnectInfo
databaseParameters fp = do
......@@ -80,4 +97,4 @@ fromField' field mb = do
Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
-- | Opaleye leftJoin* functions
-- TODO add here from Node.hs
src/Gargantext/Text/Flow.hs
View file @ cadd8650
......@@ -29,7 +29,7 @@ import qualified Data.Map.Strict as M
----------------------------------------------
import Gargantext.Database (Connection)
import Gargantext.Database.Node
import Gargantext.Database.Schema.Node
import Gargantext.Database.Types.Node
import Gargantext.Core (Lang)
......
src/Gargantext/Viz/Phylo.hs
View file @ cadd8650
......@@ -33,7 +33,7 @@ import Data.Maybe (Maybe)
import Data.Text (Text)
import Data.Time.Clock.POSIX (POSIXTime)
import GHC.Generics (Generic)
import Gargantext.Database.Ngrams (NgramsId)
import Gargantext.Database.Schema.Ngrams (NgramsId)
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Prelude
......
stack.yaml
View file @ cadd8650
......@@ -7,6 +7,7 @@ packages:
- 'deps/clustering-louvain'
- 'deps/patches-map'
- 'deps/patches-class'
- 'deps/haskell-opaleye'
allow-newer: true
extra-deps:
......@@ -17,7 +18,7 @@ extra-deps:
- git: https://github.com/delanoe/servant-static-th.git
commit: ba5347e7d8a13ce5275af8470c15b2305fbb23af
- accelerate-1.2.0.0
- opaleye-0.6.7002.0
#- opaleye-0.6.7002.0
- aeson-lens-0.5.0.0
- duckling-0.1.3.0
- full-text-search-0.2.1.4
......
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