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)
29 import Gargantext.Types.Main (NodeType)
30 import Database.PostgreSQL.Simple.Internal (Field)
31 import Control.Arrow (returnA)
32 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
34 import Gargantext.Types
35 import Gargantext.Prelude
36 import Data.Maybe (Maybe, fromMaybe)
37 import Data.Text (Text)
38 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
39 import Data.Typeable (Typeable)
40 import qualified Data.ByteString.Internal as DBI
41 import Database.PostgreSQL.Simple (Connection)
44 -- | Types for Node Database Management
47 type NodeWrite = NodePoly (Maybe (Column PGInt4)) (Column PGInt4)
48 (Column PGInt4) (Column (Nullable PGInt4))
49 (Column (PGText)) (Maybe (Column PGTimestamptz))
50 (Column PGJsonb) -- (Maybe (Column PGTSVector))
52 type NodeRead = NodePoly (Column PGInt4) (Column PGInt4)
53 (Column PGInt4) (Column (Nullable PGInt4))
54 (Column (PGText)) (Column PGTimestamptz)
55 (Column PGJsonb) -- (Column PGTSVector)
57 instance FromField HyperdataCorpus where
58 fromField = fromField'
60 instance FromField HyperdataDocument where
61 fromField = fromField'
63 instance FromField HyperdataProject where
64 fromField = fromField'
66 instance FromField HyperdataUser where
67 fromField = fromField'
70 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
71 fromField' field mb = do
72 v <- fromField field mb
75 valueToHyperdata v = case fromJSON v of
77 Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
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
92 instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
93 queryRunnerColumnDefault = fieldQueryRunnerColumn
95 instance QueryRunnerColumnDefault (Nullable PGText) Text where
96 queryRunnerColumnDefault = fieldQueryRunnerColumn
98 instance QueryRunnerColumnDefault PGInt4 Integer where
99 queryRunnerColumnDefault = fieldQueryRunnerColumn
103 $(makeAdaptorAndInstance "pNode" ''NodePoly)
104 $(makeLensesWith abbreviatedFields ''NodePoly)
107 nodeTable :: Table NodeWrite NodeRead
108 nodeTable = Table "nodes" (pNode Node { node_id = optional "id"
109 , node_typename = required "typename"
110 , node_userId = required "user_id"
111 , node_parentId = required "parent_id"
112 , node_name = required "name"
113 , node_date = optional "date"
114 , node_hyperdata = required "hyperdata"
115 -- , node_titleAbstract = optional "title_abstract"
120 queryNodeTable :: Query NodeRead
121 queryNodeTable = queryTable nodeTable
124 selectNodes :: Column PGInt4 -> Query NodeRead
125 selectNodes id = proc () -> do
126 row <- queryNodeTable -< ()
127 restrict -< node_id row .== id
130 runGetNodes :: Connection -> Query NodeRead -> IO [Node Value]
131 runGetNodes = runQuery
134 type ParentId = NodeId
138 -- | order by publication date
139 -- Favorites (Bool), node_ngrams
140 selectNodesWith :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query NodeRead
141 selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
142 --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
143 offset' maybeOffset $ limit' maybeLimit $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
146 limit' :: Maybe Limit -> Query NodeRead -> Query NodeRead
147 limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
150 offset' :: Maybe Offset -> Query NodeRead -> Query NodeRead
151 offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
155 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
156 selectNodesWith' parentId maybeNodeType = proc () -> do
157 node <- (proc () -> do
158 row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
159 restrict -< parentId' .== (toNullable $ pgInt4 parentId)
161 let typeId' = maybe 0 nodeTypeId maybeNodeType
163 restrict -< if typeId' > 0
164 then typeId .== (pgInt4 (typeId' :: Int))
166 returnA -< row ) -< ()
170 --getNodesWith' :: Connection -> Int -> Maybe NodeType -> Maybe Offset' -> Maybe Limit' -> IO [Node Value]
171 --getNodesWith' conn parentId maybeNodeType maybeOffset maybeLimit = runQuery conn $ selectNodesWith parentId xxx maybeOffset maybeLimit
174 getNodesWith :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node Value]
175 getNodesWith conn parentId nodeType maybeOffset maybeLimit = runQuery conn $ selectNodesWith parentId nodeType maybeOffset maybeLimit
179 getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
180 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
182 selectNodesWithParentID :: Int -> Query NodeRead
183 selectNodesWithParentID n = proc () -> do
184 row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
187 parent_id .== (toNullable $ pgInt4 n)
195 selectNodesWithType :: Column PGInt4 -> Query NodeRead
196 selectNodesWithType type_id = proc () -> do
197 row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
198 restrict -< tn .== type_id
201 getNode :: Connection -> Int -> IO (Node Value)
203 fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
205 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
206 getNodesWithType conn type_id = do
207 runQuery conn $ selectNodesWithType type_id