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)
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
154 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
155 selectNodesWith' parentId maybeNodeType = proc () -> do
156 node <- (proc () -> do
157 row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
158 restrict -< parentId' .== (toNullable $ pgInt4 parentId)
160 let typeId' = maybe 0 nodeTypeId maybeNodeType
162 restrict -< if typeId' > 0
163 then typeId .== (pgInt4 (typeId' :: Int))
165 returnA -< row ) -< ()
170 deleteNode :: Connection -> Int -> IO Int
171 deleteNode conn n = fromIntegral
172 <$> runDelete conn nodeTable
173 (\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
175 deleteNodes :: Connection -> [Int] -> IO Int
176 deleteNodes conn ns = fromIntegral
177 <$> runDelete conn nodeTable
178 (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
181 getNodesWith :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node Value]
182 getNodesWith conn parentId nodeType maybeOffset maybeLimit =
183 runQuery conn $ selectNodesWith
184 parentId nodeType maybeOffset maybeLimit
188 getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
189 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
191 selectNodesWithParentID :: Int -> Query NodeRead
192 selectNodesWithParentID n = proc () -> do
193 row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
196 parent_id .== (toNullable $ pgInt4 n)
204 selectNodesWithType :: Column PGInt4 -> Query NodeRead
205 selectNodesWithType type_id = proc () -> do
206 row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
207 restrict -< tn .== type_id
210 getNode :: Connection -> Int -> IO (Node Value)
212 fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
214 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
215 getNodesWithType conn type_id = do
216 runQuery conn $ selectNodesWithType type_id