2 Module : Gargantext.Database.Facet
3 Description : Main requests of Node to the database
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
11 {-# OPTIONS_GHC -fno-warn-orphans #-}
12 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
14 {-# LANGUAGE Arrows #-}
15 {-# LANGUAGE DeriveGeneric #-}
16 {-# LANGUAGE TemplateHaskell #-}
17 {-# LANGUAGE FlexibleContexts #-}
18 {-# LANGUAGE FlexibleInstances #-}
19 {-# LANGUAGE MultiParamTypeClasses #-}
20 {-# LANGUAGE FunctionalDependencies #-}
21 {-# LANGUAGE NoMonomorphismRestriction #-}
23 module Gargantext.Database.Facet where
25 import Prelude hiding (null, id, map, sum, not)
27 import Gargantext.Types
28 import Gargantext.Types.Node (NodeType)
29 import Gargantext.Database.NodeNode
30 import Gargantext.Database.NodeNodeNgram
31 import Gargantext.Database.Node
32 import Gargantext.Database.Queries
33 import Gargantext.Utils.Prefix (unPrefix)
34 -- import Gargantext.Database.NodeNgram
36 -- import Data.Aeson (Value)
37 import Data.Aeson.TH (deriveJSON)
38 import Control.Arrow (returnA)
39 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
40 import Data.Maybe (Maybe)
41 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
42 import Data.Time (UTCTime)
43 import Database.PostgreSQL.Simple (Connection)
45 import Opaleye.Internal.Join (NullMaker)
47 import qualified Opaleye.Internal.Unpackspec()
48 import Data.Profunctor.Product.Default (Default)
50 import Data.Time.Segment (jour)
52 import Test.QuickCheck.Arbitrary
53 import Test.QuickCheck (elements)
58 type FacetDoc = Facet NodeId UTCTime HyperdataDocument Bool -- Double
60 data Facet id created hyperdata favorite = FacetDoc { facetDoc_id :: id
61 , facetDoc_created :: created
62 , facetDoc_hyperdata :: hyperdata
63 , facetDoc_favorite :: favorite
64 -- To be added: Double
65 -- , facetDoc_ngramCount :: ngramCount
67 $(deriveJSON (unPrefix "facetDoc_") ''Facet)
69 instance Arbitrary FacetDoc where
70 arbitrary = elements [ FacetDoc id' (jour year 01 01) hp fav
72 , year <- [1990..2000]
73 , fav <- [True, False]
74 , hp <- hyperdataDocuments
77 -- Facets / Views for the Front End
78 type FacetDocRead = Facet (Column PGInt4) (Column PGTimestamptz) (Column PGJsonb) (Column PGBool) -- (Column PGFloat8)
80 $(makeAdaptorAndInstance "pFacetDoc" ''Facet)
81 $(makeLensesWith abbreviatedFields ''Facet)
83 getDocFacet :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [FacetDoc]
84 getDocFacet conn parentId nodeType maybeOffset maybeLimit =
85 runQuery conn $ selectDocFacet parentId nodeType maybeOffset maybeLimit
87 selectDocFacet :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query FacetDocRead
88 selectDocFacet parentId maybeNodeType maybeOffset maybeLimit =
89 limit' maybeLimit $ offset' maybeOffset $ orderBy (asc facetDoc_created) $ selectDocFacet' parentId maybeNodeType
92 -- | Left join to the favorites
93 nodeNodeLeftJoin :: Query (NodeRead, NodeNodeReadNull)
94 nodeNodeLeftJoin = leftJoin queryNodeTable queryNodeNodeTable (eqNode)
96 eqNode (Node n1 _ _ _ _ _ _, NodeNode _ n2 _) = ((.==) n1 n2)
99 nodeNodeLeftJoin' :: (Column (Nullable PGInt4))
100 -> Query (NodeRead, NodeNodeReadNull)
101 nodeNodeLeftJoin' nId = leftJoin queryNodeTable queryNodeNodeTable (eqNode nId)
103 eqNode n (Node n1 _ _ _ _ _ _, NodeNode n1' n2 _)
104 = foldl (.&&) (pgBool True) [ ((.==) n1 n2)
108 nodeNodeLeftJoin'' :: Query (NodeRead, NodeRead, NodeNodeRead)
109 nodeNodeLeftJoin'' = join3 queryNodeTable queryNodeTable queryNodeNodeTable eqNode
111 eqNode (Node n1 _ _ _ _ _ _, Node n2 _ _ _ _ _ _, NodeNode n1' n2' _)
112 = foldl (.&&) (pgBool True) [ ((.==) n2 n2')
113 , ((.==) (toNullable n1) n1')
116 -- | Left join to the ngram count per document
117 nodeNodeNgramLeftJoin :: Query (NodeRead, NodeNodeNgramReadNull)
118 nodeNodeNgramLeftJoin = leftJoin queryNodeTable queryNodeNodeNgramTable (eqNode)
120 eqNode (Node n1 _ _ _ _ _ _, NodeNodeNgram n1' _ _ _) = ((.==) n1 n1')
123 nodeNodeNgramLeftJoin' :: Column (Nullable PGInt4)
124 -> Query (NodeRead, NodeNodeNgramReadNull)
125 nodeNodeNgramLeftJoin' nId = leftJoin queryNodeTable queryNodeNodeNgramTable (eqNode nId)
127 eqNode nId' (Node n1 _ _ _ _ _ _, NodeNodeNgram n1' n2 _ _)
128 = (.&&) ((.==) n1 n1')
129 ((.==) nId' (toNullable n2))
133 leftJoin3 :: (Default NullMaker (columnsL1, nullableColumnsR) nullableColumnsR1,
134 Default NullMaker columnsR nullableColumnsR,
135 Default Unpackspec columnsR columnsR,
136 Default Unpackspec nullableColumnsR nullableColumnsR,
137 Default Unpackspec columnsL1 columnsL1,
138 Default Unpackspec columnsL columnsL) =>
139 Query columnsL1 -> Query columnsR -> Query columnsL
140 -> ((columnsL1, columnsR) -> Column PGBool)
141 -> ((columnsL, (columnsL1, nullableColumnsR)) -> Column PGBool)
142 -> Query (columnsL, nullableColumnsR1)
143 leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
146 leftJoin3' :: Query (NodeRead, (NodeReadNull, NodeNodeNgramReadNull))
147 leftJoin3' = leftJoin3 queryNodeTable queryNodeNodeNgramTable queryNodeTable cond12 cond23
149 cond12 (Node favId _ _ _ _ _ _, NodeNodeNgram favId' _ _ _)
152 cond23 :: (NodeRead, (NodeRead, NodeNodeNgramReadNull)) -> Column PGBool
153 cond23 (Node docId _ _ _ _ _ _, (Node _ _ _ _ _ _ _, NodeNodeNgram _ docId' _ _))
154 = (.||) ((.==) (toNullable docId) docId') (isNull docId')
157 -- | Building the facet
158 selectDocFacet' :: ParentId -> Maybe NodeType -> Query FacetDocRead
159 selectDocFacet' parentId _ = proc () -> do
160 node <- (proc () -> do
163 (Node _ favTypeId _ favParentId _ _ _) <- queryNodeTable -< ()
164 restrict -< favTypeId .== 15 .&& favParentId .== (toNullable $ pgInt4 parentId)
166 -- select nn.score from nodes n left join nodes_nodes nn on n.id = nn.node2_id where n.typename =4;
167 -- Selecting the documents and joining Favorite Node
168 (Node docId docTypeId _ docParentId _ created docHyperdata, NodeNode _ docTypeId' _) <- nodeNodeLeftJoin' (toNullable $ pgInt4 347537) -< ()
169 restrict -< docParentId .== (toNullable $ pgInt4 parentId)
170 let docTypeId'' = maybe 0 nodeTypeId (Just Document)
171 restrict -< if docTypeId'' > 0
172 then docTypeId .== (pgInt4 (docTypeId'' :: Int))
175 -- Getting favorite data
176 let isFav = ifThenElse (isNull docTypeId') (pgBool False) (pgBool True)
177 -- Ngram count by document
178 -- Counting the ngram
179 -- (Node occId occTypeId _ _ _ _ _, NodeNode _ _ _ count) <- nodeNodeNgramLeftJoin -< ()
180 -- restrict -< occId .== 347540
182 --returnA -< (FacetDoc n_id hyperdata isFav ngramCount)) -< ()
183 returnA -< (FacetDoc docId created docHyperdata isFav)) -< ()