]> Git — Sourcephile - gargantext.git/blob - src/Data/Gargantext/Database/Node.hs
[READING]
[gargantext.git] / src / Data / Gargantext / Database / Node.hs
1 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
2 {-# LANGUAGE TemplateHaskell #-}
3 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE DeriveGeneric #-}
5 {-# LANGUAGE MultiParamTypeClasses #-}
6 {-# LANGUAGE FunctionalDependencies #-}
7 {-# LANGUAGE Arrows #-}
8 {-# OPTIONS_GHC -fno-warn-orphans #-}
9
10 module Data.Gargantext.Database.Node where
11
12 import Database.PostgreSQL.Simple.FromField (Conversion, ResultError(ConversionFailed), FromField, fromField, returnError)
13 import Database.PostgreSQL.Simple.Internal (Field)
14 import Control.Arrow (returnA)
15 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
16 import Data.Aeson
17 import Data.Gargantext.Database.Private (infoGargandb)
18 import Data.Gargantext.Types
19 import Data.Maybe (Maybe)
20 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
21 import Data.Typeable (Typeable)
22 import qualified Data.ByteString.Internal as DBI
23 import qualified Database.PostgreSQL.Simple as PGS
24 import Opaleye
25
26
27 -- | Types for Node Database Management
28
29 type NodeWrite = NodePoly (Maybe (Column PGInt4)) (Column PGInt4)
30 (Column PGInt4) (Column PGInt4)
31 (Column PGText) (Maybe (Column PGTimestamptz))
32 (Column PGJsonb)
33
34 type NodeRead = NodePoly (Column PGInt4) (Column PGInt4)
35 (Column PGInt4) (Column PGInt4)
36 (Column PGText) (Column PGTimestamptz)
37 (Column PGJsonb)
38
39 instance FromField HyperdataCorpus where
40 fromField = fromField'
41
42 instance FromField HyperdataDocument where
43 fromField = fromField'
44
45 --instance FromField HyperdataProject where
46 -- fromField = fromField'
47
48 --instance FromField HyperdataUser where
49 -- fromField = fromField'
50
51
52 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
53 fromField' field mb = do
54 v <- fromField field mb
55 valueToHyperdata v
56 where
57 valueToHyperdata v = case fromJSON v of
58 Success a -> pure a
59 Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
60
61
62 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
63 queryRunnerColumnDefault = fieldQueryRunnerColumn
64
65 instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus where
66 queryRunnerColumnDefault = fieldQueryRunnerColumn
67
68
69
70
71 $(makeAdaptorAndInstance "pNode" ''NodePoly)
72 $(makeLensesWith abbreviatedFields ''NodePoly)
73
74
75 nodeTable :: Table NodeWrite NodeRead
76 nodeTable = Table "nodes" (pNode Node { node_id = optional "id"
77 , node_typename = required "typename"
78 , node_userId = required "user_id"
79 , node_parentId = required "parent_id"
80 , node_name = required "name"
81 , node_date = optional "date"
82 , node_hyperdata = required "hyperdata"
83 }
84 )
85
86
87 selectNodes :: Column PGInt4 -> Query (Column PGText)
88 selectNodes node_id = proc () -> do
89 (Node n_id _tn _u _p n _d _h) <- queryNodeTable -< ()
90 restrict -< n_id .== node_id
91 returnA -< n
92
93 instance QueryRunnerColumnDefault PGInt4 Integer where
94 queryRunnerColumnDefault = fieldQueryRunnerColumn
95
96
97 runGetNodes :: PGS.Connection -> Query NodeRead -> IO [Document]
98 runGetNodes = runQuery
99
100
101 queryNodeTable :: Query NodeRead
102 queryNodeTable = queryTable nodeTable
103
104
105 selectNode :: Column PGInt4 -> Query NodeRead
106 selectNode node_id = proc () -> do
107 row@(Node _id _tn _u p_id _n _d _h) <- queryNodeTable -< ()
108 restrict -< p_id .== node_id
109 returnA -< row
110
111
112 getNodes :: Column PGInt4 -> IO [Document]
113 getNodes node_id = do
114 conn <- PGS.connect infoGargandb
115 runQuery conn $ selectNode node_id
116
117 getCorpusDocument :: Column PGInt4 -> IO [Document]
118 getCorpusDocument node_id = PGS.connect infoGargandb >>=
119 \conn -> runQuery conn (selectNode node_id)
120
121 getProjectCorpora :: Column PGInt4 -> IO [Corpus]
122 getProjectCorpora node_id = do
123 conn <- PGS.connect infoGargandb
124 runQuery conn $ selectNode node_id