2 Module : Gargantext.Database.Node
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-name-shadowing #-}
12 {-# LANGUAGE TemplateHaskell #-}
13 {-# LANGUAGE FlexibleInstances #-}
14 {-# LANGUAGE DeriveGeneric #-}
15 {-# LANGUAGE MultiParamTypeClasses #-}
16 {-# LANGUAGE FunctionalDependencies #-}
17 {-# LANGUAGE Arrows #-}
18 {-# OPTIONS_GHC -fno-warn-orphans #-}
20 module Gargantext.Database.Node where
22 import Database.PostgreSQL.Simple.FromField ( Conversion
23 , ResultError(ConversionFailed)
28 import Prelude hiding (null, id, map, sum)
30 import Gargantext.Types
31 import Gargantext.Types.Main (NodeType)
32 import Gargantext.Database.NodeNode
33 -- import Gargantext.Database.NodeNgram
34 import Gargantext.Prelude hiding (sum)
37 import Database.PostgreSQL.Simple.Internal (Field)
38 import Control.Arrow (returnA)
39 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
41 import Data.Maybe (Maybe, fromMaybe)
42 import Data.Text (Text)
43 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
44 import Data.Typeable (Typeable)
45 import qualified Data.ByteString.Internal as DBI
46 import Database.PostgreSQL.Simple (Connection)
49 -- | Types for Node Database Management
52 type NodeWrite = NodePoly (Maybe (Column PGInt4)) (Column PGInt4)
53 (Column PGInt4) (Column (Nullable PGInt4))
54 (Column (PGText)) (Maybe (Column PGTimestamptz))
55 (Column PGJsonb) -- (Maybe (Column PGTSVector))
57 type NodeRead = NodePoly (Column PGInt4) (Column PGInt4)
58 (Column PGInt4) (Column (Nullable PGInt4))
59 (Column (PGText)) (Column PGTimestamptz)
60 (Column PGJsonb) -- (Column PGTSVector)
62 -- Facets / Views for the Front End
63 type FacetDocRead = Facet (Column PGInt4) (Column PGJsonb) (Column PGBool) (Column PGFloat8)
64 -- type FacetDocWrite = Facet (Column PGInt4) (Column PGJsonb) (Column PGBool) (Column PGFloat8)
67 instance FromField HyperdataCorpus where
68 fromField = fromField'
70 instance FromField HyperdataDocument where
71 fromField = fromField'
73 instance FromField HyperdataProject where
74 fromField = fromField'
76 instance FromField HyperdataUser where
77 fromField = fromField'
80 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
81 queryRunnerColumnDefault = fieldQueryRunnerColumn
83 instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus where
84 queryRunnerColumnDefault = fieldQueryRunnerColumn
86 instance QueryRunnerColumnDefault PGJsonb HyperdataProject where
87 queryRunnerColumnDefault = fieldQueryRunnerColumn
89 instance QueryRunnerColumnDefault PGJsonb HyperdataUser where
90 queryRunnerColumnDefault = fieldQueryRunnerColumn
94 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
95 fromField' field mb = do
96 v <- fromField field mb
99 valueToHyperdata v = case fromJSON v of
101 Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
105 $(makeAdaptorAndInstance "pNode" ''NodePoly)
106 $(makeLensesWith abbreviatedFields ''NodePoly)
108 $(makeAdaptorAndInstance "pFacetDoc" ''Facet)
109 $(makeLensesWith abbreviatedFields ''Facet)
113 nodeTable :: Table NodeWrite NodeRead
114 nodeTable = Table "nodes" (pNode Node { node_id = optional "id"
115 , node_typename = required "typename"
116 , node_userId = required "user_id"
117 , node_parentId = required "parent_id"
118 , node_name = required "name"
119 , node_date = optional "date"
120 , node_hyperdata = required "hyperdata"
121 -- , node_titleAbstract = optional "title_abstract"
126 queryNodeTable :: Query NodeRead
127 queryNodeTable = queryTable nodeTable
130 selectNodes :: Column PGInt4 -> Query NodeRead
131 selectNodes id = proc () -> do
132 row <- queryNodeTable -< ()
133 restrict -< node_id row .== id
136 runGetNodes :: Connection -> Query NodeRead -> IO [Node Value]
137 runGetNodes = runQuery
140 type ParentId = NodeId
144 -- | order by publication date
145 -- Favorites (Bool), node_ngrams
146 selectNodesWith :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query NodeRead
147 selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
148 --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
149 limit' maybeLimit $ offset' maybeOffset $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
152 limit' :: Maybe Limit -> Query a -> Query a
153 limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
156 offset' :: Maybe Offset -> Query a -> Query a
157 offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
160 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
161 selectNodesWith' parentId maybeNodeType = proc () -> do
162 node <- (proc () -> do
163 row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
164 restrict -< parentId' .== (toNullable $ pgInt4 parentId)
166 let typeId' = maybe 0 nodeTypeId maybeNodeType
168 restrict -< if typeId' > 0
169 then typeId .== (pgInt4 (typeId' :: Int))
171 returnA -< row ) -< ()
176 getDocFacet :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [FacetDoc Value]
177 getDocFacet conn parentId nodeType maybeOffset maybeLimit =
178 runQuery conn $ selectDocFacet parentId nodeType maybeOffset maybeLimit
180 selectDocFacet :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query FacetDocRead
181 selectDocFacet parentId maybeNodeType maybeOffset maybeLimit =
182 -- limit' maybeLimit $ offset' maybeOffset $ orderBy (asc docFacet_id) $ selectDocFacet' parentId maybeNodeType
183 limit' maybeLimit $ offset' maybeOffset $ selectDocFacet' parentId maybeNodeType
186 selectDocFacet' :: ParentId -> Maybe NodeType -> Query FacetDocRead
187 selectDocFacet' parentId maybeNodeType = proc () -> do
188 node <- (proc () -> do
189 -- Selecting the documents
190 (Node n_id typeId _ parentId' _ _ hyperdata) <- queryNodeTable -< ()
191 restrict -< parentId' .== (toNullable $ pgInt4 parentId)
193 let typeId' = maybe 0 nodeTypeId maybeNodeType
194 restrict -< if typeId' > 0
195 then typeId .== (pgInt4 (typeId' :: Int))
198 -- Ngram count by document
199 -- nodeNgramNgram@(NodeNgram _ n_id_nn _ weight) <- queryNodeNgramTable -< ()
200 -- restrict -< n_id_nn .== n_id
201 let ngramCount = (pgDouble 10) -- groupBy n_id
204 (Node n_id_fav typeId_fav _ parentId_fav _ _ _) <- queryNodeTable -< ()
205 (NodeNode n1_id n2_id count) <- queryNodeNodeTable -< ()
207 restrict -< typeId_fav .== 15 .&& parentId_fav .== (toNullable $ pgInt4 parentId)
208 restrict -< n1_id .== n_id_fav .&& n_id .== n2_id
210 let isFav = ifThenElse (isNull count) (pgBool False) (pgBool True)
212 returnA -< (FacetDoc n_id hyperdata isFav ngramCount)) -< ()
218 deleteNode :: Connection -> Int -> IO Int
219 deleteNode conn n = fromIntegral
220 <$> runDelete conn nodeTable
221 (\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
223 deleteNodes :: Connection -> [Int] -> IO Int
224 deleteNodes conn ns = fromIntegral
225 <$> runDelete conn nodeTable
226 (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
229 getNodesWith :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node Value]
230 getNodesWith conn parentId nodeType maybeOffset maybeLimit =
231 runQuery conn $ selectNodesWith
232 parentId nodeType maybeOffset maybeLimit
236 getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
237 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
239 selectNodesWithParentID :: Int -> Query NodeRead
240 selectNodesWithParentID n = proc () -> do
241 row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
244 parent_id .== (toNullable $ pgInt4 n)
251 selectNodesWithType :: Column PGInt4 -> Query NodeRead
252 selectNodesWithType type_id = proc () -> do
253 row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
254 restrict -< tn .== type_id
257 getNode :: Connection -> Int -> IO (Node Value)
259 fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
261 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
262 getNodesWithType conn type_id = do
263 runQuery conn $ selectNodesWithType type_id