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
  88
  89 selectNodes :: Column PGInt4 -> Query (Column PGText)
  90 selectNodes node_id = proc () -> do
  91     (Node n_id _tn _u _p n _d _h) <- queryNodeTable -< ()
  92     restrict -< n_id .== node_id
  93     returnA -< n
  94
  95 instance QueryRunnerColumnDefault PGInt4 Integer where
  96     queryRunnerColumnDefault = fieldQueryRunnerColumn
  97
  98
  99 runGetNodes :: PGS.Connection -> Query NodeRead -> IO [Document]
 100 runGetNodes = runQuery
 101
 102
 103 queryNodeTable :: Query NodeRead
 104 queryNodeTable = queryTable nodeTable
 105
 106
 107 selectNode :: Column PGInt4 -> Query NodeRead
 108 selectNode node_id = proc () -> do
 109     row@(Node _id _tn _u p_id _n _d _h) <- queryNodeTable -< ()
 110     restrict -< p_id .== node_id
 111     returnA -< row
 112
 113
 114 getNodes :: Column PGInt4 -> IO [Document]
 115 getNodes node_id = do
 116     conn <- PGS.connect infoGargandb
 117     runQuery conn $ selectNode node_id
 118
 119 getCorpusDocument :: Column PGInt4 -> IO [Document]
 120 getCorpusDocument node_id = PGS.connect infoGargandb >>=
 121                           \conn -> runQuery conn (selectNode node_id)
 122
 123 getProjectCorpora :: Column PGInt4 -> IO [Corpus]
 124 getProjectCorpora node_id = do
 125     conn <- PGS.connect infoGargandb
 126     runQuery conn $ selectNode node_id