Skip to content

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

[Database][Queries] Filter.

parent 21131f40
Hide whitespace changes
Inline Side-by-side
Showing with 75 additions and 96 deletions
package.yaml
View file @ 192f2030
......@@ -36,6 +36,7 @@ library:
- Gargantext.Core.Types.Main
- Gargantext.Core.Utils.Prefix
- Gargantext.Database
- Gargantext.Database.Schema.Node
- Gargantext.Database.Cooc
- Gargantext.Database.Tree
- Gargantext.Prelude
......
src/Gargantext/Database/Facet.hs
View file @ 192f2030
......@@ -47,8 +47,8 @@ import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.NodeNgram
import Gargantext.Database.Schema.NodeNode
import Gargantext.Database.Queries
import Gargantext.Database.Queries.Join
import Gargantext.Database.Queries.Filter
import Opaleye
import Prelude hiding (null, id, map, sum, not, read)
import Servant.API
......
src/Gargantext/Database/Node/Children.hs
View file @ 192f2030
......@@ -23,7 +23,7 @@ import Gargantext.Core.Types
import Gargantext.Database.Schema.Node
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/Queries.hs deleted 100644 → 0
View file @ 21131f40
{-|
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))
(Column (Nullable PGTSVector))
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/Join.hs
View file @ 192f2030
......@@ -27,8 +27,9 @@ module Gargantext.Database.Queries.Join
where
------------------------------------------------------------------------
import Control.Applicative ((<*>))
import Control.Arrow ((>>>))
import Data.Profunctor.Product.Default
import Gargantext.Database.Queries
import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.NodeNode
......@@ -37,6 +38,17 @@ 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))
......
src/Gargantext/Database/Root.hs
View file @ 192f2030
......@@ -31,7 +31,7 @@ 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.Schema.Node (NodeRead)
import Gargantext.Database.Schema.Node (queryNodeTable)
import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..))
import Gargantext.Database.Config (nodeTypeId)
......
src/Gargantext/Database/Schema/Node.hs
View file @ 192f2030
......@@ -45,7 +45,7 @@ import Gargantext.Core.Types
import Gargantext.Core.Types.Individu (Username)
import Gargantext.Core.Types.Main (UserId)
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Queries
import Gargantext.Database.Queries.Filter (limit', offset')
import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
import Gargantext.Database.Utils (fromField')
import Gargantext.Prelude hiding (sum, head)
......@@ -143,12 +143,46 @@ instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector)
------------------------------------------------------------------------
-- WIP
-- TODO Classe HasDefault where
-- default NodeType = Hyperdata
------------------------------------------------------------------------
$(makeAdaptorAndInstance "pNode" ''NodePoly)
$(makeLensesWith abbreviatedFields ''NodePoly)
type NodeWrite' = NodePoly (Maybe Int) Int Int (Maybe ParentId) Text (Maybe UTCTime) ByteString (Maybe TSVector)
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))
(Column (Nullable PGTSVector))
nodeTable :: Table NodeWrite NodeRead
nodeTable = Table "nodes" (pNode Node { _node_id = optional "id"
nodeTable = Table "nodes" (pNode Node { _node_id = optional "id"
, _node_typename = required "typename"
, _node_userId = required "user_id"
......@@ -160,7 +194,21 @@ nodeTable = Table "nodes" (pNode Node { _node_id = optional "id"
, _node_search = optional "search"
}
)
{-
nodeTableSearch :: Table NodeWriteSearch NodeReadSearch
nodeTableSearch = 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_search = optional "search"
}
)
--}
nodeTable' :: Table (Maybe (Column PGInt4)
, Column PGInt4
......@@ -198,6 +246,12 @@ nodeTable' = Table "nodes" (PP.p8 ( optional "id"
queryNodeTable :: Query NodeRead
queryNodeTable = queryTable nodeTable
{-
queryNodeTableSearch :: Query NodeReadSearch
queryNodeTableSearch = queryTable nodeTableSearch
-}
selectNode :: Column PGInt4 -> Query NodeRead
selectNode id = proc () -> do
row <- queryNodeTable -< ()
......@@ -312,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 (Maybe TSVector)
------------------------------------------------------------------------
defaultUser :: HyperdataUser
defaultUser = HyperdataUser (Just $ (pack . show) EN)
......
src/Gargantext/Database/TextSearch.hs
View file @ 192f2030
......@@ -6,8 +6,6 @@ License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE Arrows #-}
......@@ -27,7 +25,6 @@ import Gargantext.Database.Types.Node (NodeType(..))
import Gargantext.Prelude
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.NodeNode
import Gargantext.Database.Queries
import Gargantext.Core.Types
import Control.Arrow (returnA)
import qualified Opaleye as O hiding (Order)
......
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