]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Node.hs
[MOCK] all routes completed, builds but need to be adapted to fite the practices.
[gargantext.git] / src / Gargantext / Database / Node.hs
1 {-|
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
8 Portability : POSIX
9 -}
10
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 #-}
19
20 module Gargantext.Database.Node where
21
22 import Database.PostgreSQL.Simple.FromField ( Conversion
23 , ResultError(ConversionFailed)
24 , FromField
25 , fromField
26 , returnError
27 )
28 import Prelude hiding (null, id, map, sum)
29
30 import Gargantext.Types
31 import Gargantext.Types.Node (NodeType)
32 import Gargantext.Database.Queries
33 import Gargantext.Prelude hiding (sum)
34
35
36 import Database.PostgreSQL.Simple.Internal (Field)
37 import Control.Arrow (returnA)
38 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
39 import Data.Aeson
40 import Data.Maybe (Maybe, fromMaybe)
41 import Data.Text (Text)
42 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
43 import Data.Typeable (Typeable)
44 import qualified Data.ByteString.Internal as DBI
45 import Database.PostgreSQL.Simple (Connection)
46 import Opaleye
47
48 -- | Types for Node Database Management
49 data PGTSVector
50
51
52 instance FromField HyperdataCorpus where
53 fromField = fromField'
54
55 instance FromField HyperdataDocument where
56 fromField = fromField'
57
58 instance FromField HyperdataProject where
59 fromField = fromField'
60
61 instance FromField HyperdataUser where
62 fromField = fromField'
63
64
65 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
66 queryRunnerColumnDefault = fieldQueryRunnerColumn
67
68 instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus where
69 queryRunnerColumnDefault = fieldQueryRunnerColumn
70
71 instance QueryRunnerColumnDefault PGJsonb HyperdataProject where
72 queryRunnerColumnDefault = fieldQueryRunnerColumn
73
74 instance QueryRunnerColumnDefault PGJsonb HyperdataUser where
75 queryRunnerColumnDefault = fieldQueryRunnerColumn
76
77
78
79 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
80 fromField' field mb = do
81 v <- fromField field mb
82 valueToHyperdata v
83 where
84 valueToHyperdata v = case fromJSON v of
85 Success a -> pure a
86 Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
87
88
89 $(makeAdaptorAndInstance "pNode" ''NodePoly)
90 $(makeLensesWith abbreviatedFields ''NodePoly)
91
92
93 nodeTable :: Table NodeWrite NodeRead
94 nodeTable = Table "nodes" (pNode Node { node_id = optional "id"
95 , node_typename = required "typename"
96 , node_userId = required "user_id"
97 , node_parentId = required "parent_id"
98 , node_name = required "name"
99 , node_date = optional "date"
100 , node_hyperdata = required "hyperdata"
101 -- , node_titleAbstract = optional "title_abstract"
102 }
103 )
104
105
106 queryNodeTable :: Query NodeRead
107 queryNodeTable = queryTable nodeTable
108
109
110 selectNodes :: Column PGInt4 -> Query NodeRead
111 selectNodes id = proc () -> do
112 row <- queryNodeTable -< ()
113 restrict -< node_id row .== id
114 returnA -< row
115
116 runGetNodes :: Connection -> Query NodeRead -> IO [Node Value]
117 runGetNodes = runQuery
118
119 -- | order by publication date
120 -- Favorites (Bool), node_ngrams
121 selectNodesWith :: ParentId -> Maybe NodeType
122 -> Maybe Offset -> Maybe Limit -> Query NodeRead
123 selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
124 --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
125 limit' maybeLimit $ offset' maybeOffset $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
126
127 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
128 selectNodesWith' parentId maybeNodeType = proc () -> do
129 node <- (proc () -> do
130 row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
131 restrict -< parentId' .== (toNullable $ pgInt4 parentId)
132
133 let typeId' = maybe 0 nodeTypeId maybeNodeType
134
135 restrict -< if typeId' > 0
136 then typeId .== (pgInt4 (typeId' :: Int))
137 else (pgBool True)
138 returnA -< row ) -< ()
139 returnA -< node
140
141
142 deleteNode :: Connection -> Int -> IO Int
143 deleteNode conn n = fromIntegral
144 <$> runDelete conn nodeTable
145 (\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
146
147 deleteNodes :: Connection -> [Int] -> IO Int
148 deleteNodes conn ns = fromIntegral
149 <$> runDelete conn nodeTable
150 (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
151
152
153 getNodesWith :: Connection -> Int -> Maybe NodeType
154 -> Maybe Offset -> Maybe Limit -> IO [Node Value]
155 getNodesWith conn parentId nodeType maybeOffset maybeLimit =
156 runQuery conn $ selectNodesWith
157 parentId nodeType maybeOffset maybeLimit
158
159
160 -- NP check type
161 getNodesWithParentId :: Connection -> Int
162 -> Maybe Text -> IO [Node Value]
163 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
164
165 selectNodesWithParentID :: Int -> Query NodeRead
166 selectNodesWithParentID n = proc () -> do
167 row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
168 restrict -< if n > 0
169 then
170 parent_id .== (toNullable $ pgInt4 n)
171 else
172 isNull parent_id
173 returnA -< row
174
175
176 selectNodesWithType :: Column PGInt4 -> Query NodeRead
177 selectNodesWithType type_id = proc () -> do
178 row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
179 restrict -< tn .== type_id
180 returnA -< row
181
182 getNode :: Connection -> Int -> IO (Node Value)
183 getNode conn id = do
184 fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
185
186 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
187 getNodesWithType conn type_id = do
188 runQuery conn $ selectNodesWithType type_id
189
190