Skip to content

haskell-gargantext
haskell-gargantext
Commit 7647ad93 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

Merge branch 'dev' into dev-corpora-from-write-nodes

parents 32f009eb 0866ac4b
Pipeline #1911 passed with stage
    in 40 minutes and 54 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 415 additions and 322 deletions
    CHANGELOG.md
    View file @ 7647ad93
    ## Version 0.0.4.1
    * Refact/code design better syntax for DataType fields
    ## Version 0.0.4
    * Fix the search in Title and abstracts.
    * [UPGRADE] execute devops/postgres/upgrade/0.0.4.sql to your database to upgrade it
    ## Version 0.0.3.9.1
    * Graph Update fix
    * Document view: full text removed
    ......
    bin/gargantext-hs.gource → bin/gource
    View file @ 7647ad93
    ......@@ -8,8 +8,8 @@ DATE="2018-03-08 07:18:18"
    #tmux -d video
    #xterm -e "tutoriel"
    gource --start-date $DATE ../gargantext-hs &
    gource --start-date $DATE ../gargantext-hs/purescript-gargantext
    gource --start-date $DATE $1 &
    gource --start-date $DATE $1/purescript-gargantext
    #tmux -a video
    # Share video ?
    ......
    devops/docker/docker-compose.yaml
    View file @ 7647ad93
    ......@@ -2,7 +2,8 @@ version: '3'
    services:
    postgres:
    image: 'postgres:latest'
    #image: 'postgres:latest'
    image: 'postgres:11'
    network_mode: host
    #ports:
    #- 5432:5432
    ......
    devops/postgres/schema.sql
    View file @ 7647ad93
    ......@@ -38,6 +38,9 @@ CREATE TABLE public.nodes (
    FOREIGN KEY (user_id) REFERENCES public.auth_user(id) ON DELETE CASCADE
    );
    ALTER TABLE public.nodes OWNER TO gargantua;
    ALTER TABLE nodes ADD COLUMN IF NOT EXISTS search_title tsvector;
    UPDATE nodes SET search_title = to_tsvector('english', coalesce("hyperdata"->>'title', '') || ' ' || coalesce("hyperdata"->>'abstract', ''));
    CREATE INDEX IF NOT EXISTS search_title_idx ON nodes USING GIN (search_title);
    --------------------------------------------------------------
    -- | Ngrams
    ......@@ -207,5 +210,5 @@ CREATE OR REPLACE function node_pos(int, int) returns bigint
    LANGUAGE SQL immutable;
    --drop index node_by_pos;
    create index node_by_pos on nodes using btree(node_pos(id,typename));
    --create index node_by_pos on nodes using btree(node_pos(id,typename));
    devops/postgres/upgrade/0.0.4.sql 0 → 100644
    View file @ 7647ad93
    ALTER TABLE nodes
    DROP COLUMN IF EXISTS search_title,
    DROP COLUMN IF EXISTS tsvector;
    ALTER TABLE nodes ADD COLUMN search_title tsvector;
    UPDATE nodes SET search_title = to_tsvector('english', coalesce("hyperdata"->>'title', '') || ' ' || coalesce("hyperdata"->>'abstract', ''));
    CREATE INDEX search_title_idx ON nodes USING GIN (search_title);
    package.yaml
    View file @ 7647ad93
    name: gargantext
    version: '0.0.3.9.1'
    version: '0.0.4.1'
    synopsis: Search, map, share
    description: Please see README.md
    category: Data
    ......
    src/Gargantext/Core/Viz/Graph.hs
    View file @ 7647ad93
    ......@@ -188,9 +188,9 @@ instance FromField HyperdataGraph
    where
    fromField = fromField'
    instance QueryRunnerColumnDefault PGJsonb HyperdataGraph
    instance DefaultFromField PGJsonb HyperdataGraph
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    -----------------------------------------------------------
    -- This type is used to return graph via API
    ......
    src/Gargantext/Database/Action/Flow.hs
    View file @ 7647ad93
    ......@@ -103,7 +103,7 @@ import qualified Gargantext.Core.Text.Corpus.API as API
    import qualified Gargantext.Database.Query.Table.Node.Document.Add as Doc (add)
    ------------------------------------------------------------------------
    -- Impots for upgrade function
    -- Imports for upgrade function
    import Gargantext.Database.Query.Tree.Root (getRootId)
    import Gargantext.Database.Query.Tree (findNodesId)
    import qualified Data.List as List
    ......
    src/Gargantext/Database/Action/Flow/Pairing.hs
    View file @ 7647ad93
    ......@@ -55,7 +55,7 @@ isPairedWith nId nt = runOpaQuery (selectQuery nt nId)
    selectQuery :: NodeType -> NodeId -> Query (Column PGInt4)
    selectQuery nt' nId' = proc () -> do
    (node, node_node) <- queryJoin -< ()
    restrict -< (node^.node_typename) .== (pgInt4 $ toDBid nt')
    restrict -< (node^.node_typename) .== (sqlInt4 $ toDBid nt')
    restrict -< (node_node^.nn_node1_id) .== (toNullable $ pgNodeId nId')
    returnA -< node^.node_id
    ......
    src/Gargantext/Database/Action/Search.hs
    View file @ 7647ad93
    ......@@ -14,18 +14,13 @@ module Gargantext.Database.Action.Search where
    import Control.Arrow (returnA)
    import Control.Lens ((^.))
    import Data.Aeson
    import Data.List (intersperse)
    import Data.Maybe
    import Data.String (IsString(..))
    import Data.Text (Text, words, unpack, intercalate)
    import Data.Text (Text, unpack, intercalate)
    import Data.Time (UTCTime)
    import Database.PostgreSQL.Simple (Query)
    import Database.PostgreSQL.Simple.ToField
    import Gargantext.Core
    import Gargantext.Core.Types
    import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..), HyperdataContact(..))
    import Gargantext.Database.Prelude (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery)
    import Gargantext.Database.Prelude (Cmd, runOpaQuery, runCountOpaQuery)
    import Gargantext.Database.Query.Facet
    import Gargantext.Database.Query.Filter
    import Gargantext.Database.Query.Join (leftJoin5)
    ......@@ -43,14 +38,14 @@ searchDocInDatabase :: HasDBid NodeType
    => ParentId
    -> Text
    -> Cmd err [(NodeId, HyperdataDocument)]
    searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
    searchDocInDatabase _p t = runOpaQuery (queryDocInDatabase t)
    where
    -- | Global search query where ParentId is Master Node Corpus Id
    queryDocInDatabase :: ParentId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
    queryDocInDatabase _ q = proc () -> do
    queryDocInDatabase :: Text -> O.Query (Column PGInt4, Column PGJsonb)
    queryDocInDatabase q = proc () -> do
    row <- queryNodeSearchTable -< ()
    restrict -< (_ns_search row) @@ (pgTSQuery (unpack q))
    restrict -< (_ns_typename row) .== (pgInt4 $ toDBid NodeDocument)
    restrict -< (_ns_typename row) .== (sqlInt4 $ toDBid NodeDocument)
    returnA -< (_ns_id row, _ns_hyperdata row)
    ------------------------------------------------------------------------
    ......@@ -88,17 +83,18 @@ queryInCorpus cId t q = proc () -> do
    (n, nn) <- joinInCorpus -< ()
    restrict -< (nn^.nn_node1_id) .== (toNullable $ pgNodeId cId)
    restrict -< if t
    then (nn^.nn_category) .== (toNullable $ pgInt4 0)
    else (nn^.nn_category) .>= (toNullable $ pgInt4 1)
    then (nn^.nn_category) .== (toNullable $ sqlInt4 0)
    else (nn^.nn_category) .>= (toNullable $ sqlInt4 1)
    restrict -< (n ^. ns_search) @@ (pgTSQuery (unpack q))
    restrict -< (n ^. ns_typename ) .== (pgInt4 $ toDBid NodeDocument)
    returnA -< FacetDoc { facetDoc_id = n^.ns_id
    restrict -< (n ^. ns_typename ) .== (sqlInt4 $ toDBid NodeDocument)
    returnA -< FacetDoc { facetDoc_id = n^.ns_id
    , facetDoc_created = n^.ns_date
    , facetDoc_title = n^.ns_name
    , facetDoc_hyperdata = n^.ns_hyperdata
    , facetDoc_category = nn^.nn_category
    , facetDoc_ngramCount = nn^.nn_score
    , facetDoc_score = nn^.nn_score }
    , facetDoc_score = nn^.nn_score
    }
    joinInCorpus :: O.Query (NodeSearchRead, NodeNodeReadNull)
    joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
    ......@@ -138,14 +134,14 @@ selectContactViaDoc
    selectContactViaDoc cId aId q = proc () -> do
    (doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
    restrict -< (doc^.ns_search) @@ (pgTSQuery $ unpack q )
    restrict -< (doc^.ns_typename) .== (pgInt4 $ toDBid NodeDocument)
    restrict -< (doc^.ns_typename) .== (sqlInt4 $ toDBid NodeDocument)
    restrict -< (corpus_doc^.nn_node1_id) .== (toNullable $ pgNodeId cId)
    restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId)
    restrict -< (contact^.node_typename) .== (toNullable $ pgInt4 $ toDBid NodeContact)
    restrict -< (contact^.node_typename) .== (toNullable $ sqlInt4 $ toDBid NodeContact)
    returnA -< ( contact^.node_id
    , contact^.node_date
    , contact^.node_hyperdata
    , toNullable $ pgInt4 1
    , toNullable $ sqlInt4 1
    )
    selectGroup :: HasDBid NodeType
    ......@@ -156,10 +152,7 @@ selectGroup :: HasDBid NodeType
    selectGroup cId aId q = proc () -> do
    (a, b, c, d) <- aggregate (p4 (groupBy, groupBy, groupBy, O.sum))
    (selectContactViaDoc cId aId q) -< ()
    returnA -< FacetPaired { _fp_id = a
    , _fp_date = b
    , _fp_hyperdata = c
    , _fp_score = d }
    returnA -< FacetPaired a b c d
    queryContactViaDoc :: O.Query ( NodeSearchRead
    ......@@ -216,66 +209,3 @@ queryContactViaDoc =
    ------------------------------------------------------------------------
    newtype TSQuery = UnsafeTSQuery [Text]
    -- | TODO [""] -> panic "error"
    toTSQuery :: [Text] -> TSQuery
    toTSQuery txt = UnsafeTSQuery $ map stemIt txt
    instance IsString TSQuery
    where
    fromString = UnsafeTSQuery . words . cs
    instance ToField TSQuery
    where
    toField (UnsafeTSQuery xs)
    = Many $ intersperse (Plain " && ")
    $ map (\q -> Many [ Plain "plainto_tsquery("
    , Escape (cs q)
    , Plain ")"
    ]
    ) xs
    data Order = Asc | Desc
    instance ToField Order
    where
    toField Asc = Plain "ASC"
    toField Desc = Plain "DESC"
    -- TODO
    -- FIX fav
    -- ADD ngrams count
    -- TESTS
    textSearchQuery :: Query
    textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
    \ , n.hyperdata->'title' \
    \ , n.hyperdata->'source' \
    \ , n.hyperdata->'authors' \
    \ , COALESCE(nn.score,null) \
    \ FROM nodes n \
    \ LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id \
    \ WHERE \
    \ n.search @@ (?::tsquery) \
    \ AND (n.parent_id = ? OR nn.node1_id = ?) \
    \ AND n.typename = ? \
    \ ORDER BY n.hyperdata -> 'publication_date' ? \
    \ offset ? limit ?;"
    -- | Text Search Function for Master Corpus
    -- TODO : text search for user corpus
    -- Example:
    -- textSearchTest :: ParentId -> TSQuery -> Cmd err [(Int, Value, Value, Value, Value, Maybe Int)]
    -- textSearchTest pId q = textSearch q pId 5 0 Asc
    textSearch :: HasDBid NodeType
    => TSQuery -> ParentId
    -> Limit -> Offset -> Order
    -> Cmd err [(Int, Value, Value, Value, Value, Maybe Int)]
    textSearch q p l o ord = runPGSQuery textSearchQuery (q,p,p,typeId,ord,o,l)
    where
    typeId = toDBid NodeDocument
    src/Gargantext/Database/Action/TSQuery.hs 0 → 100644
    View file @ 7647ad93
    module Gargantext.Database.Action.TSQuery where
    import Data.Aeson
    import Data.List (intersperse)
    import Data.Maybe
    import Data.String (IsString(..))
    import Data.Text (Text, words)
    import Database.PostgreSQL.Simple (Query)
    import Database.PostgreSQL.Simple.ToField
    import Gargantext.Core
    import Gargantext.Core.Types
    import Gargantext.Database.Prelude (Cmd, runPGSQuery)
    import Gargantext.Prelude
    import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
    newtype TSQuery = UnsafeTSQuery [Text]
    -- | TODO [""] -> panic "error"
    toTSQuery :: [Text] -> TSQuery
    toTSQuery txt = UnsafeTSQuery $ map stemIt txt
    instance IsString TSQuery
    where
    fromString = UnsafeTSQuery . words . cs
    instance ToField TSQuery
    where
    toField (UnsafeTSQuery xs)
    = Many $ intersperse (Plain " && ")
    $ map (\q -> Many [ Plain "plainto_tsquery("
    , Escape (cs q)
    , Plain ")"
    ]
    ) xs
    data Order = Asc | Desc
    instance ToField Order
    where
    toField Asc = Plain "ASC"
    toField Desc = Plain "DESC"
    -- TODO
    -- FIX fav
    -- ADD ngrams count
    -- TESTS
    textSearchQuery :: Query
    textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
    \ , n.hyperdata->'title' \
    \ , n.hyperdata->'source' \
    \ , n.hyperdata->'authors' \
    \ , COALESCE(nn.score,null) \
    \ FROM nodes n \
    \ LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id \
    \ WHERE \
    \ n.search @@ (?::tsquery) \
    \ AND (n.parent_id = ? OR nn.node1_id = ?) \
    \ AND n.typename = ? \
    \ ORDER BY n.hyperdata -> 'publication_date' ? \
    \ offset ? limit ?;"
    -- | Text Search Function for Master Corpus
    -- TODO : text search for user corpus
    -- Example:
    -- textSearchTest :: ParentId -> TSQuery -> Cmd err [(Int, Value, Value, Value, Value, Maybe Int)]
    -- textSearchTest pId q = textSearch q pId 5 0 Asc
    textSearch :: HasDBid NodeType
    => TSQuery -> ParentId
    -> Limit -> Offset -> Order
    -> Cmd err [(Int,Value,Value,Value, Value, Maybe Int)]
    textSearch q p l o ord = runPGSQuery textSearchQuery (q,p,p,typeId,ord,o,l)
    where
    typeId = toDBid NodeDocument
    src/Gargantext/Database/Admin/Types/Hyperdata/Any.hs
    View file @ 7647ad93
    ......@@ -45,7 +45,7 @@ instance ToSchema HyperdataAny where
    instance FromField HyperdataAny where
    fromField = fromField'
    instance QueryRunnerColumnDefault PGJsonb HyperdataAny
    instance DefaultFromField PGJsonb HyperdataAny
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
    View file @ 7647ad93
    ......@@ -166,12 +166,12 @@ instance FromField HyperdataContact where
    fromField = fromField'
    -- | Database (Opaleye instance)
    instance QueryRunnerColumnDefault PGJsonb HyperdataContact where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField PGJsonb HyperdataContact where
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault (Nullable PGJsonb) HyperdataContact where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField (Nullable PGJsonb) HyperdataContact where
    defaultFromField = fieldQueryRunnerColumn
    ......
    src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs
    View file @ 7647ad93
    ......@@ -90,10 +90,10 @@ instance FromField HyperdataAnnuaire
    where
    fromField = fromField'
    ------------------------------------------------------------------------
    instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus
    instance DefaultFromField PGJsonb HyperdataCorpus
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire
    instance DefaultFromField PGJsonb HyperdataAnnuaire
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    src/Gargantext/Database/Admin/Types/Hyperdata/Dashboard.hs
    View file @ 7647ad93
    ......@@ -71,7 +71,7 @@ instance ToSchema HyperdataDashboard where
    instance FromField HyperdataDashboard where
    fromField = fromField'
    instance QueryRunnerColumnDefault PGJsonb HyperdataDashboard
    instance DefaultFromField PGJsonb HyperdataDashboard
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
    View file @ 7647ad93
    ......@@ -202,11 +202,11 @@ instance ToField HyperdataDocumentV3 where
    toField = toJSONField
    ------------------------------------------------------------------------
    instance QueryRunnerColumnDefault PGJsonb HyperdataDocument
    instance DefaultFromField PGJsonb HyperdataDocument
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault PGJsonb HyperdataDocumentV3
    instance DefaultFromField PGJsonb HyperdataDocumentV3
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    ------------------------------------------------------------------------
    src/Gargantext/Database/Admin/Types/Hyperdata/File.hs
    View file @ 7647ad93
    ......@@ -54,9 +54,9 @@ instance FromField HyperdataFile
    where
    fromField = fromField'
    instance QueryRunnerColumnDefault PGJsonb HyperdataFile
    instance DefaultFromField PGJsonb HyperdataFile
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    instance ToSchema HyperdataFile where
    declareNamedSchema proxy =
    ......
    src/Gargantext/Database/Admin/Types/Hyperdata/Frame.hs
    View file @ 7647ad93
    ......@@ -58,9 +58,9 @@ instance FromField HyperdataFrame
    where
    fromField = fromField'
    instance QueryRunnerColumnDefault PGJsonb HyperdataFrame
    instance DefaultFromField PGJsonb HyperdataFrame
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    instance ToSchema HyperdataFrame where
    declareNamedSchema proxy =
    ......
    src/Gargantext/Database/Admin/Types/Hyperdata/List.hs
    View file @ 7647ad93
    ......@@ -98,12 +98,12 @@ instance FromField HyperdataListCooc
    where
    fromField = fromField'
    instance QueryRunnerColumnDefault PGJsonb HyperdataList
    instance DefaultFromField PGJsonb HyperdataList
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault PGJsonb HyperdataListCooc
    defaultFromField = fieldQueryRunnerColumn
    instance DefaultFromField PGJsonb HyperdataListCooc
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    instance ToSchema HyperdataList where
    ......
    src/Gargantext/Database/Admin/Types/Hyperdata/Model.hs
    View file @ 7647ad93
    ......@@ -48,9 +48,9 @@ instance FromField HyperdataModel
    where
    fromField = fromField'
    instance QueryRunnerColumnDefault PGJsonb HyperdataModel
    instance DefaultFromField PGJsonb HyperdataModel
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    instance ToSchema HyperdataModel where
    declareNamedSchema proxy =
    ......
    src/Gargantext/Database/Admin/Types/Hyperdata/Phylo.hs
    View file @ 7647ad93
    ......@@ -56,6 +56,6 @@ instance ToSchema HyperdataPhylo where
    instance FromField HyperdataPhylo where
    fromField = fromField'
    instance QueryRunnerColumnDefault PGJsonb HyperdataPhylo
    instance DefaultFromField PGJsonb HyperdataPhylo
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs
    View file @ 7647ad93
    ......@@ -48,7 +48,7 @@ import GHC.Generics (Generic)
    import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
    import Gargantext.Database.Prelude (fromField')
    import Gargantext.Prelude
    import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn, Nullable)
    import Opaleye (DefaultFromField(..), PGJsonb, defaultFromField, fieldQueryRunnerColumn, Nullable)
    import Test.QuickCheck (elements)
    import Test.QuickCheck.Arbitrary hiding (vector)
    ......
    src/Gargantext/Database/Admin/Types/Hyperdata/Texts.hs
    View file @ 7647ad93
    ......@@ -54,7 +54,7 @@ instance ToSchema HyperdataTexts where
    instance FromField HyperdataTexts where
    fromField = fromField'
    instance QueryRunnerColumnDefault PGJsonb HyperdataTexts
    instance DefaultFromField PGJsonb HyperdataTexts
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    src/Gargantext/Database/Admin/Types/Hyperdata/User.hs
    View file @ 7647ad93
    ......@@ -120,12 +120,12 @@ instance FromField HyperdataPublic where
    fromField = fromField'
    -- | Database (Opaleye instance)
    instance QueryRunnerColumnDefault PGJsonb HyperdataUser where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField PGJsonb HyperdataUser where
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault PGJsonb HyperdataPrivate where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField PGJsonb HyperdataPrivate where
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault PGJsonb HyperdataPublic where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField PGJsonb HyperdataPublic where
    defaultFromField = fieldQueryRunnerColumn
    src/Gargantext/Database/Admin/Types/Node.hs
    View file @ 7647ad93
    ......@@ -33,7 +33,7 @@ import Database.PostgreSQL.Simple.ToField (ToField, toField)
    import GHC.Generics (Generic)
    import Servant
    import qualified Opaleye as O
    import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGInt4, PGText, PGTSVector, Nullable, fieldQueryRunnerColumn)
    import Opaleye (DefaultFromField, defaultFromField, PGInt4, PGText, PGTSVector, Nullable, fieldQueryRunnerColumn)
    import Test.QuickCheck (elements)
    import Gargantext.Prelude.Crypto.Hash (Hash)
    import Test.QuickCheck.Arbitrary
    ......@@ -82,18 +82,26 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
    declareNamedSchema = wellNamedSchema "_node_"
    instance (Typeable hyperdata, ToSchema hyperdata) =>
    ToSchema (NodePolySearch NodeId NodeTypeId
    (Maybe UserId)
    ParentId NodeName
    UTCTime hyperdata (Maybe TSVector)
    ToSchema (NodePolySearch NodeId
    NodeTypeId
    (Maybe UserId)
    ParentId
    NodeName
    UTCTime
    hyperdata
    (Maybe TSVector)
    ) where
    declareNamedSchema = wellNamedSchema "_ns_"
    instance (Typeable hyperdata, ToSchema hyperdata) =>
    ToSchema (NodePolySearch NodeId NodeTypeId
    UserId
    (Maybe ParentId) NodeName
    UTCTime hyperdata (Maybe TSVector)
    ToSchema (NodePolySearch NodeId
    NodeTypeId
    UserId
    (Maybe ParentId)
    NodeName
    UTCTime
    hyperdata
    (Maybe TSVector)
    ) where
    declareNamedSchema = wellNamedSchema "_ns_"
    ......@@ -115,16 +123,29 @@ instance (Arbitrary hyperdata
    ,Arbitrary toDBid
    ,Arbitrary userId
    ,Arbitrary nodeParentId
    ) => Arbitrary (NodePolySearch nodeId toDBid userId nodeParentId
    NodeName UTCTime hyperdata (Maybe TSVector)) where
    ) => Arbitrary (NodePolySearch nodeId
    toDBid
    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
    <*> arbitrary <*> arbitrary <*> arbitrary
    <*> arbitrary <*> arbitrary
    arbitrary = NodeSearch <$> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    <*> arbitrary
    ------------------------------------------------------------------------
    pgNodeId :: NodeId -> O.Column O.PGInt4
    pgNodeId = O.pgInt4 . id2int
    pgNodeId = O.sqlInt4 . id2int
    where
    id2int :: NodeId -> Int
    id2int (NodeId n) = n
    ......@@ -333,28 +354,28 @@ instance FromField (NodeId, Text)
    fromField = fromField'
    -}
    ------------------------------------------------------------------------
    instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector)
    instance DefaultFromField PGTSVector (Maybe TSVector)
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault PGInt4 (Maybe NodeId)
    instance DefaultFromField PGInt4 (Maybe NodeId)
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault PGInt4 NodeId
    instance DefaultFromField PGInt4 NodeId
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault (Nullable PGInt4) NodeId
    instance DefaultFromField (Nullable PGInt4) NodeId
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    instance (QueryRunnerColumnDefault (Nullable O.PGTimestamptz) UTCTime)
    instance (DefaultFromField (Nullable O.PGTimestamptz) UTCTime)
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault PGText (Maybe Hash)
    instance DefaultFromField PGText (Maybe Hash)
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    src/Gargantext/Database/Prelude.hs
    View file @ 7647ad93
    ......@@ -31,7 +31,7 @@ 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, FromFields, Select, runQuery, PGJsonb, QueryRunnerColumnDefault)
    import Opaleye (Query, Unpackspec, showSql, FromFields, Select, runSelect, PGJsonb, DefaultFromField)
    import Opaleye.Aggregate (countRows)
    import System.IO (FilePath)
    import System.IO (stderr)
    ......@@ -56,7 +56,7 @@ instance HasConfig GargConfig where
    hasConfig = identity
    -------------------------------------------------------
    type JSONB = QueryRunnerColumnDefault PGJsonb
    type JSONB = DefaultFromField PGJsonb
    -------------------------------------------------------
    type CmdM'' env err m =
    ......@@ -111,11 +111,11 @@ runCmd env m = runExceptT $ runReaderT m env
    runOpaQuery :: Default FromFields fields haskells
    => Select fields
    -> Cmd err [haskells]
    runOpaQuery q = mkCmd $ \c -> runQuery c q
    runOpaQuery q = mkCmd $ \c -> runSelect c q
    runCountOpaQuery :: Select a -> Cmd err Int
    runCountOpaQuery q = do
    counts <- mkCmd $ \c -> runQuery c $ countRows q
    counts <- mkCmd $ \c -> runSelect c $ countRows q
    -- countRows is guaranteed to return a list with exactly one row so DL.head is safe here
    pure $ fromInt64ToInt $ DL.head counts
    ......@@ -189,5 +189,5 @@ fromField' field mb = do
    ]
    printSqlOpa :: Default Unpackspec a a => Query a -> IO ()
    printSqlOpa = putStrLn . maybe "Empty query" identity . showSqlForPostgres
    printSqlOpa = putStrLn . maybe "Empty query" identity . showSql
    src/Gargantext/Database/Query/Facet.hs
    View file @ 7647ad93
    ......@@ -44,6 +44,8 @@ import Control.Arrow (returnA)
    import Control.Lens ((^.))
    import Data.Aeson (FromJSON, ToJSON)
    import Data.Aeson.TH (deriveJSON)
    --import qualified Database.PostgreSQL.Simple as DPS
    --import Database.PostgreSQL.Simple.SqlQQ (sql)
    import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
    import Data.Swagger
    import qualified Data.Text as T
    ......@@ -59,14 +61,17 @@ import qualified Opaleye.Internal.Unpackspec()
    import Gargantext.Core
    import Gargantext.Core.Types
    import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
    -- import Gargantext.Database.Action.TSQuery (toTSQuery)
    import Gargantext.Database.Admin.Types.Hyperdata
    import Gargantext.Database.Query.Filter
    import Gargantext.Database.Query.Join (leftJoin5)
    import Gargantext.Database.Query.Table.Ngrams
    import Gargantext.Database.Query.Table.Node (queryNodeSearchTable)
    import Gargantext.Database.Query.Table.NodeNode
    import Gargantext.Database.Query.Table.NodeNodeNgrams
    import Gargantext.Database.Prelude
    import Gargantext.Database.Schema.Node
    import Gargantext.Prelude (printDebug)
    ------------------------------------------------------------------------
    -- | DocFacet
    ......@@ -263,13 +268,13 @@ viewAuthorsDoc cId _ nt = proc () -> do
    -}
    restrict -< _node_id contact' .== (toNullable $ pgNodeId cId)
    restrict -< _node_typename doc .== (pgInt4 $ toDBid nt)
    restrict -< _node_typename doc .== (sqlInt4 $ toDBid nt)
    returnA -< FacetDoc (_node_id doc)
    (_node_date doc)
    (_node_name doc)
    (_node_hyperdata doc)
    (toNullable $ pgInt4 1)
    (toNullable $ sqlInt4 1)
    (toNullable $ pgDouble 1)
    (toNullable $ pgDouble 1)
    ......@@ -303,10 +308,29 @@ runViewDocuments :: HasDBid NodeType
    -> Maybe Text
    -> Cmd err [FacetDoc]
    runViewDocuments cId t o l order query = do
    -- docs <- runPGSQuery viewDocuments'
    -- ( cId
    -- , ntId
    -- , (if t then 0 else 1) :: Int
    -- , fromMaybe "" query
    -- , fromMaybe "" query)
    -- pure $ (\(id, date, name', hyperdata, category, score) -> FacetDoc id date name' hyperdata category score score) <$> docs
    printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery
    runOpaQuery $ filterWith o l order sqlQuery
    where
    ntId = toDBid NodeDocument
    sqlQuery = viewDocuments cId t ntId query
    -- viewDocuments' :: DPS.Query
    -- viewDocuments' = [sql|
    -- SELECT n.id, n.date, n.name, n.hyperdata, nn.category, nn.score
    -- FROM nodes AS n
    -- JOIN nodes_nodes AS nn
    -- ON n.id = nn.node2_id
    -- WHERE nn.node1_id = ? -- corpusId
    -- AND n.typename = ? -- NodeTypeId
    -- AND nn.category = ? -- isTrash or not
    -- AND (n.search_title @@ to_tsquery(?) OR ? = '') -- query with an OR hack for empty to_tsquery('') results
    -- |]
    runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Cmd err Int
    runCountDocuments cId t mQuery = do
    ......@@ -321,28 +345,33 @@ viewDocuments :: CorpusId
    -> Maybe Text
    -> Query FacetDocRead
    viewDocuments cId t ntId mQuery = proc () -> do
    n <- queryNodeTable -< ()
    --n <- queryNodeTable -< ()
    n <- queryNodeSearchTable -< ()
    nn <- queryNodeNodeTable -< ()
    restrict -< n^.node_id .== nn^.nn_node2_id
    restrict -< n^.ns_id .== nn^.nn_node2_id
    restrict -< nn^.nn_node1_id .== (pgNodeId cId)
    restrict -< n^.node_typename .== (pgInt4 ntId)
    restrict -< if t then nn^.nn_category .== (pgInt4 0)
    else nn^.nn_category .>= (pgInt4 1)
    restrict -< n^.ns_typename .== (sqlInt4 ntId)
    restrict -< if t then nn^.nn_category .== (sqlInt4 0)
    else nn^.nn_category .>= (sqlInt4 1)
    let query = (fromMaybe "" mQuery)
    iLikeQuery = T.intercalate "" ["%", query, "%"]
    restrict -< (n^.node_name) `ilike` (pgStrictText iLikeQuery)
    -- iLikeQuery = T.intercalate "" ["%", query, "%"]
    -- restrict -< (n^.node_name) `ilike` (sqlStrictText iLikeQuery)
    restrict -< if query == ""
    then pgBool True
    --else (n^.ns_search_title) @@ (pgTSQuery (T.unpack query))
    else (n^.ns_search_title) @@ (toTSQuery $ T.unpack query)
    returnA -< FacetDoc (_node_id n)
    (_node_date n)
    (_node_name n)
    (_node_hyperdata n)
    returnA -< FacetDoc (_ns_id n)
    (_ns_date n)
    (_ns_name n)
    (_ns_hyperdata n)
    (toNullable $ nn^.nn_category)
    (toNullable $ nn^.nn_score)
    (toNullable $ nn^.nn_score)
    ------------------------------------------------------------------------
    filterWith :: (PGOrd date, PGOrd title, PGOrd category, PGOrd score, hyperdata ~ Column SqlJsonb) =>
    filterWith :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ Column SqlJsonb) =>
    Maybe Gargantext.Core.Types.Offset
    -> Maybe Gargantext.Core.Types.Limit
    -> Maybe OrderBy
    ......@@ -351,7 +380,7 @@ filterWith :: (PGOrd date, PGOrd title, PGOrd category, PGOrd score, hyperdata ~
    filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
    orderWith :: (PGOrd b1, PGOrd b2, PGOrd b3, PGOrd b4)
    orderWith :: (SqlOrd b1, SqlOrd b2, SqlOrd b3, SqlOrd b4)
    => Maybe OrderBy
    -> Order (Facet id (Column b1) (Column b2) (Column SqlJsonb) (Column b3) ngramCount (Column b4))
    orderWith (Just DateAsc) = asc facetDoc_created
    ......@@ -368,7 +397,7 @@ orderWith (Just SourceDesc) = desc facetDoc_source
    orderWith _ = asc facetDoc_created
    facetDoc_source :: PGIsJson a
    facetDoc_source :: SqlIsJson a
    => Facet id created title (Column a) favorite ngramCount score
    -> Column (Nullable PGText)
    facetDoc_source x = toNullable (facetDoc_hyperdata x) .->> pgString "source"
    src/Gargantext/Database/Query/Table/Ngrams.hs
    View file @ 7647ad93
    ......@@ -39,7 +39,7 @@ import Gargantext.Database.Types
    import Gargantext.Prelude
    queryNgramsTable :: Query NgramsRead
    queryNgramsTable = queryTable ngramsTable
    queryNgramsTable = selectTable ngramsTable
    selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> Cmd err [Text]
    selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
    ......
    src/Gargantext/Database/Query/Table/Node.hs
    View file @ 7647ad93
    ......@@ -44,7 +44,7 @@ import Gargantext.Prelude hiding (sum, head)
    queryNodeSearchTable :: Query NodeSearchRead
    queryNodeSearchTable = queryTable nodeTableSearch
    queryNodeSearchTable = selectTable nodeTableSearch
    selectNode :: Column PGInt4 -> Query NodeRead
    selectNode id' = proc () -> do
    ......@@ -78,20 +78,26 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
    let typeId' = maybe 0 toDBid maybeNodeType
    restrict -< if typeId' > 0
    then typeId .== (pgInt4 (typeId' :: Int))
    then typeId .== (sqlInt4 (typeId' :: Int))
    else (pgBool True)
    returnA -< row ) -< ()
    returnA -< node'
    deleteNode :: NodeId -> Cmd err Int
    deleteNode n = mkCmd $ \conn ->
    fromIntegral <$> runDelete conn nodeTable
    (\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgNodeId n)
    fromIntegral <$> runDelete_ conn
    (Delete nodeTable
    (\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgNodeId n)
    rCount
    )
    deleteNodes :: [NodeId] -> Cmd err Int
    deleteNodes ns = mkCmd $ \conn ->
    fromIntegral <$> runDelete conn nodeTable
    (\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
    fromIntegral <$> runDelete_ conn
    (Delete nodeTable
    (\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
    rCount
    )
    -- TODO: NodeType should match with `a'
    getNodesWith :: (JSONB a, HasDBid NodeType) => NodeId -> proxy a -> Maybe NodeType
    ......@@ -186,7 +192,7 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
    => NodeType -> Query NodeRead
    selectNodesWithType nt' = proc () -> do
    row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
    restrict -< tn .== (pgInt4 $ toDBid nt')
    restrict -< tn .== (sqlInt4 $ toDBid nt')
    returnA -< row
    getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [NodeId]
    ......@@ -198,7 +204,7 @@ selectNodesIdWithType :: HasDBid NodeType
    => NodeType -> Query (Column PGInt4)
    selectNodesIdWithType nt = proc () -> do
    row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
    restrict -< tn .== (pgInt4 $ toDBid nt)
    restrict -< tn .== (sqlInt4 $ toDBid nt)
    returnA -< _node_id row
    ------------------------------------------------------------------------
    ......@@ -247,10 +253,10 @@ node :: (ToJSON a, Hyperdata a, HasDBid NodeType)
    -> NodeWrite
    node nodeType name hyperData parentId userId =
    Node Nothing Nothing
    (pgInt4 typeId)
    (pgInt4 userId)
    (sqlInt4 typeId)
    (sqlInt4 userId)
    (pgNodeId <$> parentId)
    (pgStrictText name)
    (sqlStrictText name)
    Nothing
    (pgJSONB $ cs $ encode hyperData)
    where
    ......@@ -268,10 +274,10 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
    ns' :: [NodeWrite]
    ns' = map (\(Node i t u p n d h)
    -> Node (pgNodeId <$> i)
    (pgInt4 $ toDBid t)
    (pgInt4 u)
    (sqlInt4 $ toDBid t)
    (sqlInt4 u)
    (pgNodeId <$> p)
    (pgStrictText n)
    (sqlStrictText n)
    (pgUTCTime <$> d)
    (pgJSONB $ cs $ encode h)
    ) ns
    ......@@ -293,7 +299,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> p
    node2table :: HasDBid NodeType
    => UserId -> Maybe ParentId -> Node' -> NodeWrite
    node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (pgInt4 $ toDBid nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
    node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (sqlInt4 $ toDBid nt) (sqlInt4 uid) (fmap pgNodeId pid) (sqlStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
    node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
    ......
    src/Gargantext/Database/Query/Table/Node/Children.hs
    View file @ 7647ad93
    ......@@ -75,7 +75,7 @@ selectChildren parentId maybeNodeType = proc () -> do
    (NodeNode n1id n2id _ _) <- queryNodeNodeTable -< ()
    let nodeType = maybe 0 toDBid maybeNodeType
    restrict -< typeName .== pgInt4 nodeType
    restrict -< typeName .== sqlInt4 nodeType
    restrict -< (.||) (parent_id .== (pgNodeId parentId))
    ( (.&&) (n1id .== pgNodeId parentId)
    ......
    src/Gargantext/Database/Query/Table/Node/Select.hs
    View file @ 7647ad93
    ......@@ -31,8 +31,8 @@ selectNodesWithUsername nt u = runOpaQuery (q u)
    where
    q u' = proc () -> do
    (n,usrs) <- join' -< ()
    restrict -< user_username usrs .== (toNullable $ pgStrictText u')
    restrict -< _node_typename n .== (pgInt4 $ toDBid nt)
    restrict -< user_username usrs .== (toNullable $ sqlStrictText u')
    restrict -< _node_typename n .== (sqlInt4 $ toDBid nt)
    returnA -< _node_id n
    join' :: Query (NodeRead, UserReadNull)
    ......
    src/Gargantext/Database/Query/Table/NodeNode.hs
    View file @ 7647ad93
    ......@@ -54,7 +54,7 @@ import Gargantext.Prelude
    queryNodeNodeTable :: Query NodeNodeRead
    queryNodeNodeTable = queryTable nodeNodeTable
    queryNodeNodeTable = selectTable nodeNodeTable
    -- | not optimized (get all ngrams without filters)
    _nodesNodes :: Cmd err [NodeNode]
    ......@@ -87,7 +87,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
    (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
    let nodeType = maybe 0 toDBid maybeNodeType
    restrict -< typeName .== pgInt4 nodeType
    restrict -< typeName .== sqlInt4 nodeType
    restrict -< (.||) (parent_id .== (pgNodeId parentId))
    ( (.&&) (n1id .== pgNodeId parentId)
    ......@@ -105,7 +105,7 @@ insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
    -> NodeNode (pgNodeId n1)
    (pgNodeId n2)
    (pgDouble <$> x)
    (pgInt4 <$> y)
    (sqlInt4 <$> y)
    ) ns
    ......@@ -116,9 +116,13 @@ type Node2_Id = NodeId
    deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
    deleteNodeNode n1 n2 = mkCmd $ \conn ->
    fromIntegral <$> runDelete conn nodeNodeTable
    (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
    .&& n2_id .== pgNodeId n2 )
    fromIntegral <$> runDelete_ conn
    (Delete nodeNodeTable
    (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
    .&& n2_id .== pgNodeId n2
    )
    rCount
    )
    ------------------------------------------------------------------------
    -- | Favorite management
    ......@@ -177,8 +181,8 @@ selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
    queryCountDocs cId' = proc () -> do
    (n, nn) <- joinInCorpus -< ()
    restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId')
    restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1)
    restrict -< n^.node_typename .== (pgInt4 $ toDBid NodeDocument)
    restrict -< nn^.nn_category .>= (toNullable $ sqlInt4 1)
    restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
    returnA -< n
    ......@@ -198,8 +202,8 @@ queryDocs :: HasDBid NodeType => CorpusId -> O.Query (Column PGJsonb)
    queryDocs cId = proc () -> do
    (n, nn) <- joinInCorpus -< ()
    restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId)
    restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1)
    restrict -< n^.node_typename .== (pgInt4 $ toDBid NodeDocument)
    restrict -< nn^.nn_category .>= (toNullable $ sqlInt4 1)
    restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
    returnA -< view (node_hyperdata) n
    selectDocNodes :: HasDBid NodeType =>CorpusId -> Cmd err [Node HyperdataDocument]
    ......@@ -209,8 +213,8 @@ queryDocNodes :: HasDBid NodeType =>CorpusId -> O.Query NodeRead
    queryDocNodes cId = proc () -> do
    (n, nn) <- joinInCorpus -< ()
    restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId)
    restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1)
    restrict -< n^.node_typename .== (pgInt4 $ toDBid NodeDocument)
    restrict -< nn^.nn_category .>= (toNullable $ sqlInt4 1)
    restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
    returnA -< n
    joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
    ......@@ -227,13 +231,13 @@ joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
    ------------------------------------------------------------------------
    selectPublicNodes :: HasDBid NodeType => (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
    selectPublicNodes :: HasDBid NodeType => (Hyperdata a, DefaultFromField PGJsonb a)
    => Cmd err [(Node a, Maybe Int)]
    selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
    queryWithType :: HasDBid NodeType =>NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
    queryWithType nt = proc () -> do
    (n, nn) <- joinOn1 -< ()
    restrict -< n^.node_typename .== (pgInt4 $ toDBid nt)
    restrict -< n^.node_typename .== (sqlInt4 $ toDBid nt)
    returnA -< (n, nn^.nn_node2_id)
    src/Gargantext/Database/Query/Table/NodeNodeNgrams.hs
    View file @ 7647ad93
    ......@@ -31,7 +31,7 @@ import Prelude
    queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
    queryNodeNodeNgramsTable = queryTable nodeNodeNgramsTable
    queryNodeNodeNgramsTable = selectTable nodeNodeNgramsTable
    -- | Insert utils
    insertNodeNodeNgrams :: [NodeNodeNgrams] -> Cmd err Int
    ......@@ -39,7 +39,7 @@ insertNodeNodeNgrams = insertNodeNodeNgramsW
    . map (\(NodeNodeNgrams n1 n2 ng nt w) ->
    NodeNodeNgrams (pgNodeId n1)
    (pgNodeId n2)
    (pgInt4 ng)
    (sqlInt4 ng)
    (pgNgramsTypeId nt)
    (pgDouble w)
    )
    ......
    src/Gargantext/Database/Query/Table/NodeNodeNgrams2.hs
    View file @ 7647ad93
    ......@@ -29,14 +29,14 @@ import Prelude
    _queryNodeNodeNgrams2Table :: Query NodeNodeNgrams2Read
    _queryNodeNodeNgrams2Table = queryTable nodeNodeNgrams2Table
    _queryNodeNodeNgrams2Table = selectTable nodeNodeNgrams2Table
    -- | Insert utils
    insertNodeNodeNgrams2 :: [NodeNodeNgrams2] -> Cmd err Int
    insertNodeNodeNgrams2 = insertNodeNodeNgrams2W
    . map (\(NodeNodeNgrams2 n1 n2 w) ->
    NodeNodeNgrams2 (pgNodeId n1)
    (pgInt4 n2)
    (sqlInt4 n2)
    (pgDouble w)
    )
    ......
    src/Gargantext/Database/Query/Table/Node_NodeNgramsNodeNgrams.hs
    View file @ 7647ad93
    ......@@ -43,7 +43,7 @@ import Gargantext.Prelude
    queryNode_NodeNgrams_NodeNgrams_Table :: Query Node_NodeNgrams_NodeNgrams_Read
    queryNode_NodeNgrams_NodeNgrams_Table = queryTable node_NodeNgrams_NodeNgrams_Table
    queryNode_NodeNgrams_NodeNgrams_Table = selectTable node_NodeNgrams_NodeNgrams_Table
    -- | Select NodeNgramsNgrams
    -- TODO not optimized (get all ngrams without filters)
    ......@@ -56,8 +56,8 @@ insert_Node_NodeNgrams_NodeNgrams :: [Node_NodeNgrams_NodeNgrams] -> Cmd err Int
    insert_Node_NodeNgrams_NodeNgrams = insert_Node_NodeNgrams_NodeNgrams_W
    . map (\(Node_NodeNgrams_NodeNgrams n ng1 ng2 maybeWeight) ->
    Node_NodeNgrams_NodeNgrams (pgNodeId n )
    (pgInt4 <$> ng1)
    (pgInt4 ng2)
    (sqlInt4 <$> ng1)
    (sqlInt4 ng2)
    (pgDouble <$> maybeWeight)
    )
    ......
    src/Gargantext/Database/Query/Table/NodesNgramsRepo.hs
    View file @ 7647ad93
    ......@@ -30,7 +30,7 @@ import Gargantext.Prelude
    selectPatches :: Query RepoDbRead
    selectPatches = proc () -> do
    repos <- queryTable repoTable -< ()
    repos <- selectTable repoTable -< ()
    returnA -< repos
    _selectRepo :: Cmd err [RepoDbNgrams]
    ......@@ -41,5 +41,5 @@ _insertRepos ns = mkCmd $ \conn -> runInsert_ conn $ Insert repoTable (toWrite n
    where
    toWrite :: [NgramsStatePatch] -> [RepoDbWrite]
    toWrite = undefined
    --ns' = map (\(RepoDbNgrams v ps) -> RepoDbWrite (pgInt4 v) (pgJSONB ps)) ns
    --ns' = map (\(RepoDbNgrams v ps) -> RepoDbWrite (sqlInt4 v) (pgJSONB ps)) ns
    src/Gargantext/Database/Query/Table/User.hs
    View file @ 7647ad93
    ......@@ -54,8 +54,10 @@ insertUsers us = mkCmd $ \c -> runInsert_ c insert
    insert = Insert userTable us rCount Nothing
    deleteUsers :: [Username] -> Cmd err Int64
    deleteUsers us = mkCmd $ \c -> runDelete c userTable
    (\user -> in_ (map pgStrictText us) (user_username user))
    deleteUsers us = mkCmd $ \c -> runDelete_ c
    $ Delete userTable
    (\user -> in_ (map sqlStrictText us) (user_username user))
    rCount
    -- Updates email or password only (for now)
    updateUserDB :: UserWrite -> Cmd err Int64
    ......@@ -76,11 +78,11 @@ updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us)
    -----------------------------------------------------------------------
    toUserWrite :: NewUser HashPassword -> UserWrite
    toUserWrite (NewUser u m (Auth.PasswordHash p)) =
    UserDB (Nothing) (pgStrictText p)
    (Nothing) (pgBool True) (pgStrictText u)
    (pgStrictText "first_name")
    (pgStrictText "last_name")
    (pgStrictText m)
    UserDB (Nothing) (sqlStrictText p)
    (Nothing) (pgBool True) (sqlStrictText u)
    (sqlStrictText "first_name")
    (sqlStrictText "last_name")
    (sqlStrictText m)
    (pgBool True)
    (pgBool True) Nothing
    ......@@ -91,25 +93,23 @@ getUsersWith u = map toUserLight <$> runOpaQuery (selectUsersLightWith u)
    selectUsersLightWith :: Username -> Query UserRead
    selectUsersLightWith u = proc () -> do
    row <- queryUserTable -< ()
    restrict -< user_username row .== pgStrictText u
    restrict -< user_username row .== sqlStrictText u
    returnA -< row
    ----------------------------------------------------------
    getUsersWithId :: Int -> Cmd err [UserLight]
    getUsersWithId i = map toUserLight <$> runOpaQuery (selectUsersLightWithId i)
    where
    selectUsersLightWithId :: Int -> Query UserRead
    selectUsersLightWithId i' = proc () -> do
    row <- queryUserTable -< ()
    restrict -< user_id row .== pgInt4 i'
    restrict -< user_id row .== sqlInt4 i'
    returnA -< row
    queryUserTable :: Query UserRead
    queryUserTable = queryTable userTable
    queryUserTable = selectTable userTable
    ------------------------------------------------------------------
    -- | Select User with some parameters
    ......@@ -147,5 +147,5 @@ insertNewUsers newUsers = do
    insertUsers $ map toUserWrite users'
    ----------------------------------------------------------------------
    instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField PGTimestamptz (Maybe UTCTime) where
    defaultFromField = fieldQueryRunnerColumn
    src/Gargantext/Database/Query/Tree/Root.hs
    View file @ 7647ad93
    ......@@ -31,7 +31,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead)
    import Gargantext.Database.Schema.Node (queryNodeTable)
    import Gargantext.Prelude
    import Opaleye (restrict, (.==), Query)
    import Opaleye.PGTypes (pgStrictText, pgInt4)
    import Opaleye.SqlTypes (sqlStrictText, sqlInt4)
    getRootId :: (HasNodeError err) => User -> Cmd err NodeId
    ......@@ -119,21 +119,21 @@ selectRoot :: User -> Query NodeRead
    selectRoot (UserName username) = proc () -> do
    row <- queryNodeTable -< ()
    users <- queryUserTable -< ()
    restrict -< _node_typename row .== (pgInt4 $ toDBid NodeUser)
    restrict -< user_username users .== (pgStrictText username)
    restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser)
    restrict -< user_username users .== (sqlStrictText username)
    restrict -< _node_user_id row .== (user_id users)
    returnA -< row
    selectRoot (UserDBId uid) = proc () -> do
    row <- queryNodeTable -< ()
    restrict -< _node_typename row .== (pgInt4 $ toDBid NodeUser)
    restrict -< _node_user_id row .== (pgInt4 uid)
    restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser)
    restrict -< _node_user_id row .== (sqlInt4 uid)
    returnA -< row
    selectRoot (RootId nid) =
    proc () -> do
    row <- queryNodeTable -< ()
    restrict -< _node_typename row .== (pgInt4 $ toDBid NodeUser)
    restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser)
    restrict -< _node_id row .== (pgNodeId nid)
    returnA -< row
    selectRoot UserPublic = panic {-nodeError $ NodeError-} "[G.D.Q.T.Root.selectRoot] No root for Public"
    src/Gargantext/Database/Schema/Ngrams.hs
    View file @ 7647ad93
    ......@@ -65,9 +65,9 @@ makeLenses ''NgramsPoly
    ngramsTable :: Table NgramsWrite NgramsRead
    ngramsTable = Table "ngrams" (pNgramsDb NgramsDB { _ngrams_id = optional "id"
    , _ngrams_terms = required "terms"
    , _ngrams_n = required "n"
    ngramsTable = Table "ngrams" (pNgramsDb NgramsDB { _ngrams_id = optionalTableField "id"
    , _ngrams_terms = requiredTableField "terms"
    , _ngrams_n = requiredTableField "n"
    }
    )
    ......@@ -117,15 +117,15 @@ instance ToParamSchema NgramsType where
    toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
    instance QueryRunnerColumnDefault (Nullable PGInt4) NgramsTypeId
    instance DefaultFromField (Nullable PGInt4) NgramsTypeId
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    pgNgramsType :: NgramsType -> Column PGInt4
    pgNgramsType = pgNgramsTypeId . ngramsTypeId
    pgNgramsTypeId :: NgramsTypeId -> Column PGInt4
    pgNgramsTypeId (NgramsTypeId n) = pgInt4 n
    pgNgramsTypeId (NgramsTypeId n) = sqlInt4 n
    ngramsTypeId :: NgramsType -> NgramsTypeId
    ngramsTypeId Authors = 1
    ......
    src/Gargantext/Database/Schema/Node.hs
    View file @ 7647ad93
    ......@@ -55,22 +55,22 @@ $(makeAdaptorAndInstance "pNode" ''NodePoly)
    $(makeLensesWith abbreviatedFields ''NodePoly)
    nodeTable :: Table NodeWrite NodeRead
    nodeTable = Table "nodes" (pNode Node { _node_id = optional "id"
    , _node_hash_id = optional "hash_id"
    , _node_typename = required "typename"
    , _node_user_id = required "user_id"
    nodeTable = Table "nodes" (pNode Node { _node_id = optionalTableField "id"
    , _node_hash_id = optionalTableField "hash_id"
    , _node_typename = requiredTableField "typename"
    , _node_user_id = requiredTableField "user_id"
    , _node_parent_id = optional "parent_id"
    , _node_name = required "name"
    , _node_date = optional "date"
    , _node_parent_id = optionalTableField "parent_id"
    , _node_name = requiredTableField "name"
    , _node_date = optionalTableField "date"
    , _node_hyperdata = required "hyperdata"
    , _node_hyperdata = requiredTableField "hyperdata"
    -- ignoring ts_vector field here
    }
    )
    queryNodeTable :: Query NodeRead
    queryNodeTable = queryTable nodeTable
    queryNodeTable = selectTable nodeTable
    ------------------------------------------------------------------------
    type NodeWrite = NodePoly (Maybe (Column PGInt4) )
    (Maybe (Column PGText) )
    ......@@ -144,16 +144,17 @@ data NodePolySearch id
    date
    hyperdata
    search =
    NodeSearch { _ns_id :: id
    , _ns_typename :: typename
    , _ns_user_id :: user_id
    -- , nodeUniqId :: shaId
    , _ns_parent_id :: parent_id
    , _ns_name :: name
    , _ns_date :: date
    , _ns_hyperdata :: hyperdata
    , _ns_search :: search
    NodeSearch { _ns_id :: id
    , _ns_typename :: typename
    , _ns_user_id :: user_id
    -- , nodeUniqId :: shaId
    , _ns_parent_id :: parent_id
    , _ns_name :: name
    , _ns_date :: date
    , _ns_hyperdata :: hyperdata
    , _ns_search :: search
    , _ns_search_title :: search
    } deriving (Show, Generic)
    $(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
    ......@@ -163,16 +164,17 @@ $(makeLenses ''NodePolySearch)
    nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
    nodeTableSearch = Table "nodes" ( pNodeSearch
    NodeSearch { _ns_id = optional "id"
    , _ns_typename = required "typename"
    , _ns_user_id = required "user_id"
    NodeSearch { _ns_id = optionalTableField "id"
    , _ns_typename = requiredTableField "typename"
    , _ns_user_id = requiredTableField "user_id"
    , _ns_parent_id = required "parent_id"
    , _ns_name = required "name"
    , _ns_date = optional "date"
    , _ns_parent_id = requiredTableField "parent_id"
    , _ns_name = requiredTableField "name"
    , _ns_date = optionalTableField "date"
    , _ns_hyperdata = required "hyperdata"
    , _ns_search = optional "search"
    , _ns_hyperdata = requiredTableField "hyperdata"
    , _ns_search = optionalTableField "search"
    , _ns_search_title = optionalTableField "search_title"
    }
    )
    ------------------------------------------------------------------------
    src/Gargantext/Database/Schema/NodeNode.hs
    View file @ 7647ad93
    ......@@ -56,25 +56,25 @@ nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
    nodeNodeTable =
    Table "nodes_nodes"
    ( pNodeNode
    NodeNode { _nn_node1_id = required "node1_id"
    , _nn_node2_id = required "node2_id"
    , _nn_score = optional "score"
    , _nn_category = optional "category"
    NodeNode { _nn_node1_id = requiredTableField "node1_id"
    , _nn_node2_id = requiredTableField "node2_id"
    , _nn_score = optionalTableField "score"
    , _nn_category = optionalTableField "category"
    }
    )
    instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField (Nullable PGInt4) Int where
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault (Nullable PGFloat8) Int where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField (Nullable PGFloat8) Int where
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault (Nullable PGFloat8) Double where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField (Nullable PGFloat8) Double where
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField PGFloat8 (Maybe Double) where
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField PGInt4 (Maybe Int) where
    defaultFromField = fieldQueryRunnerColumn
    src/Gargantext/Database/Schema/NodeNodeNgrams.hs
    View file @ 7647ad93
    ......@@ -62,11 +62,11 @@ makeLenses ''NodeNodeNgramsPoly
    nodeNodeNgramsTable :: Table NodeNodeNgramsWrite NodeNodeNgramsRead
    nodeNodeNgramsTable = Table "node_node_ngrams"
    ( pNodeNodeNgrams NodeNodeNgrams
    { _nnng_node1_id = required "node1_id"
    , _nnng_node2_id = required "node2_id"
    , _nnng_ngrams_id = required "ngrams_id"
    , _nnng_ngramsType = required "ngrams_type"
    , _nnng_weight = required "weight"
    { _nnng_node1_id = requiredTableField "node1_id"
    , _nnng_node2_id = requiredTableField "node2_id"
    , _nnng_ngrams_id = requiredTableField "ngrams_id"
    , _nnng_ngramsType = requiredTableField "ngrams_type"
    , _nnng_weight = requiredTableField "weight"
    }
    )
    src/Gargantext/Database/Schema/NodeNodeNgrams2.hs
    View file @ 7647ad93
    ......@@ -53,9 +53,9 @@ makeLenses ''NodeNodeNgrams2Poly
    nodeNodeNgrams2Table :: Table NodeNodeNgrams2Write NodeNodeNgrams2Read
    nodeNodeNgrams2Table = Table "node_node_ngrams2"
    ( pNodeNodeNgrams2 NodeNodeNgrams2
    { _nnng2_node_id = required "node_id"
    , _nnng2_nodengrams_id = required "nodengrams_id"
    , _nnng2_weight = required "weight"
    { _nnng2_node_id = requiredTableField "node_id"
    , _nnng2_nodengrams_id = requiredTableField "nodengrams_id"
    , _nnng2_weight = requiredTableField "weight"
    }
    )
    src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs
    View file @ 7647ad93
    ......@@ -72,16 +72,16 @@ node_NodeNgrams_NodeNgrams_Table :: Table Node_NodeNgrams_NodeNgrams_Write Node_
    node_NodeNgrams_NodeNgrams_Table =
    Table "node_nodengrams_nodengrams"
    ( pNode_NodeNgrams_NodeNgrams Node_NodeNgrams_NodeNgrams
    { _nnn_node_id = required "node_id"
    , _nnn_nng1_id = optional "node_ngrams1_id"
    , _nnn_nng2_id = required "node_ngrams2_id"
    , _nnn_weight = optional "weight"
    { _nnn_node_id = requiredTableField "node_id"
    , _nnn_nng1_id = optionalTableField "node_ngrams1_id"
    , _nnn_nng2_id = requiredTableField "node_ngrams2_id"
    , _nnn_weight = optionalTableField "weight"
    }
    )
    instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField PGInt4 (Maybe Int) where
    defaultFromField = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance DefaultFromField PGFloat8 (Maybe Double) where
    defaultFromField = fieldQueryRunnerColumn
    src/Gargantext/Database/Schema/NodesNgramsRepo.hs
    View file @ 7647ad93
    ......@@ -46,17 +46,17 @@ type RepoDbNgrams = RepoDbPoly Int NgramsStatePatch
    $(makeAdaptorAndInstance "pRepoDbNgrams" ''RepoDbPoly)
    makeLenses ''RepoDbPoly
    instance QueryRunnerColumnDefault PGJsonb
    instance DefaultFromField PGJsonb
    (PatchMap NgramsType
    (PatchMap NodeId NgramsTablePatch))
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    defaultFromField = fieldQueryRunnerColumn
    repoTable :: Table RepoDbWrite RepoDbRead
    repoTable = Table "nodes_ngrams_repo"
    (pRepoDbNgrams RepoDbNgrams
    { _rdp_version = required "version"
    , _rdp_patches = required "patches"
    { _rdp_version = requiredTableField "version"
    , _rdp_patches = requiredTableField "patches"
    }
    )
    src/Gargantext/Database/Schema/User.hs
    View file @ 7647ad93
    ......@@ -94,17 +94,17 @@ $(makeLensesWith abbreviatedFields ''UserPoly)
    userTable :: Table UserWrite UserRead
    userTable = Table "auth_user"
    (pUserDB UserDB { user_id = optional "id"
    , user_password = required "password"
    , user_lastLogin = optional "last_login"
    , user_isSuperUser = required "is_superuser"
    , user_username = required "username"
    , user_firstName = required "first_name"
    , user_lastName = required "last_name"
    , user_email = required "email"
    , user_isStaff = required "is_staff"
    , user_isActive = required "is_active"
    , user_dateJoined = optional "date_joined"
    (pUserDB UserDB { user_id = optionalTableField "id"
    , user_password = requiredTableField "password"
    , user_lastLogin = optionalTableField "last_login"
    , user_isSuperUser = requiredTableField "is_superuser"
    , user_username = requiredTableField "username"
    , user_firstName = requiredTableField "first_name"
    , user_lastName = requiredTableField "last_name"
    , user_email = requiredTableField "email"
    , user_isStaff = requiredTableField "is_staff"
    , user_isActive = requiredTableField "is_active"
    , user_dateJoined = optionalTableField "date_joined"
    }
    )
    ......
    stack.yaml
    View file @ 7647ad93
    ......@@ -43,8 +43,8 @@ extra-deps:
    commit: 8cb8aaf2962ad44d319fcea48442e4397b3c49e8
    # Databases libs
    - git: https://github.com/delanoe/haskell-opaleye.git #- opaleye-0.6.7002.0
    commit: 63ee65d974e9d20eaaf17a2e83652175988cbb79
    - git: https://github.com/delanoe/haskell-opaleye.git
    commit: 9089fa71006d99d01916375818620d78a565b743
    - git: https://github.com/delanoe/hsparql.git
    commit: 308c74b71a1abb0a91546fa57d353131248e3a7f
    - git: https://github.com/robstewart57/rdf4h.git
    ......
    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