src/Data/Gargantext/Database/Node.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE DeriveGeneric #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE FunctionalDependencies #-}
   6 {-# LANGUAGE Arrows #-}
   7
   8 module Data.Gargantext.Database.Node where
   9
  10
  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.Aeson.TH
  18 import Data.Aeson.Types
  19 import Data.Gargantext.Database.Instances
  20 import Data.Gargantext.Database.Private (infoGargandb)
  21 import Data.Gargantext.Prelude
  22 import Data.Gargantext.Types
  23 import Data.Gargantext.Utils.Prefix
  24 import Data.Maybe (Maybe)
  25 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  26 import Data.Text (Text)
  27 import Data.Time (UTCTime)
  28 import Data.Typeable.Internal (Typeable)
  29 import GHC.Generics (Generic)
  30 import qualified Data.ByteString.Internal as DBI
  31 import qualified Database.PostgreSQL.Simple as PGS
  32 import qualified Opaleye as O
  33 import Opaleye (Column, PGBool, PGInt4, PGText, PGTimestamptz, PGFloat8
  34                , Table(Table), PGJsonb, Query
  35                , QueryRunnerColumnDefault, queryRunnerColumnDefault
  36                , fieldQueryRunnerColumn
  37                , (.==), (.>)
  38                )
  39
  40
  41 -- | Types for Node Database Management
  42
  43 type NodeWrite = NodePoly  (Maybe (Column PGInt4))        (Column PGInt4)
  44                                   (Column PGInt4)         (Column PGInt4)
  45                                   (Column PGText)  (Maybe (Column PGTimestamptz))
  46                                   (Column PGJsonb)
  47
  48 type NodeRead = NodePoly  (Column PGInt4) (Column PGInt4)
  49                           (Column PGInt4) (Column PGInt4)
  50                           (Column PGText) (Column PGTimestamptz)
  51                           (Column PGJsonb)
  52
  53 instance FromField HyperdataCorpus where
  54     fromField = fromField'
  55
  56 instance FromField HyperdataDocument where
  57     fromField = fromField'
  58
  59 --instance FromField HyperdataProject where
  60 --    fromField = fromField'
  61
  62 --instance FromField HyperdataUser where
  63 --    fromField = fromField'
  64
  65
  66 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
  67 fromField' field mb = do
  68     v <- fromField field mb
  69     valueToHyperdata v
  70       where
  71           valueToHyperdata v = case fromJSON v of
  72              Success a -> pure a
  73              Error err -> returnError ConversionFailed field "cannot parse hyperdata"
  74
  75
  76 instance O.QueryRunnerColumnDefault PGJsonb HyperdataDocument where
  77   queryRunnerColumnDefault = fieldQueryRunnerColumn
  78
  79 instance O.QueryRunnerColumnDefault PGJsonb HyperdataCorpus where
  80   queryRunnerColumnDefault = fieldQueryRunnerColumn
  81
  82
  83
  84
  85 $(makeAdaptorAndInstance "pNode" ''NodePoly)
  86 $(makeLensesWith abbreviatedFields   ''NodePoly)
  87
  88
  89 nodeTable :: O.Table NodeWrite NodeRead
  90 nodeTable = O.Table "nodes" (pNode Node { node_id         = O.optional "id"
  91                                         , node_typename   = O.required "typename"
  92                                         , node_userId     = O.required "user_id"
  93                                         , node_parentId   = O.required "parent_id"
  94                                         , node_name       = O.required "name"
  95                                         , node_date       = O.optional "date"
  96                                         , node_hyperdata  = O.required "hyperdata"
  97                                         }
  98                             )
  99
 100
 101
 102
 103 selectNodes :: Column PGInt4 -> Query (Column O.PGText)
 104 selectNodes node_id = proc () -> do
 105     row@(Node n_id tn u p n d h) <- queryNodeTable -< ()
 106     O.restrict -< n_id .== node_id
 107     returnA -< n
 108
 109
 110 runGetNodes :: PGS.Connection -> Query NodeRead -> IO [Document]
 111 runGetNodes = O.runQuery
 112
 113
 114 queryNodeTable :: Query NodeRead
 115 queryNodeTable = O.queryTable nodeTable
 116
 117
 118 selectNode :: Column PGInt4 -> Query NodeRead
 119 selectNode node_id = proc () -> do
 120     row@(Node id tn u p_id n d h) <- queryNodeTable -< ()
 121     O.restrict -< p_id .== node_id
 122     returnA -< row
 123
 124
 125 getNodes :: Column PGInt4 -> IO [Document]
 126 getNodes node_id = do
 127     conn <- PGS.connect infoGargandb
 128     O.runQuery conn $ selectNode node_id
 129
 130 getCorpusDocument :: Column PGInt4 -> IO [Document]
 131 getCorpusDocument node_id = PGS.connect infoGargandb >>=
 132                           \conn -> O.runQuery conn (selectNode node_id)
 133
 134 getProjectCorpora :: Column PGInt4 -> IO [Corpus]
 135 getProjectCorpora node_id = do
 136     conn <- PGS.connect infoGargandb
 137     O.runQuery conn $ selectNode node_id
 138
 139
 140