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