src/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 Gargantext.Database.Node where
  11
  12 import Database.PostgreSQL.Simple.FromField ( Conversion
  13                                             , ResultError(ConversionFailed)
  14                                             , FromField
  15                                             , fromField
  16                                             , returnError
  17                                             )
  18 import Prelude hiding (null, id)
  19 import Database.PostgreSQL.Simple.Internal  (Field)
  20 import Control.Arrow (returnA)
  21 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  22 import Data.Aeson
  23 import Gargantext.Types
  24 import Gargantext.Prelude
  25 import Data.Maybe (Maybe, fromMaybe)
  26 import Data.Text (Text)
  27 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  28 import Data.Typeable (Typeable)
  29 import qualified Data.ByteString.Internal as DBI
  30 import Database.PostgreSQL.Simple (Connection)
  31 import Opaleye
  32
  33 -- | Types for Node Database Management
  34 data PGTSVector
  35
  36 type NodeWrite = NodePoly  (Maybe (Column PGInt4))  (Column PGInt4)
  37                                   (Column PGInt4)   (Column (Nullable PGInt4))
  38                                   (Column (PGText)) (Maybe (Column PGTimestamptz))
  39                                   (Column PGJsonb) -- (Maybe (Column PGTSVector))
  40
  41 type NodeRead = NodePoly  (Column PGInt4)   (Column PGInt4)
  42                           (Column PGInt4)   (Column (Nullable PGInt4))
  43                           (Column (PGText)) (Column PGTimestamptz)
  44                           (Column PGJsonb) -- (Column PGTSVector)
  45
  46 instance FromField HyperdataCorpus where
  47     fromField = fromField'
  48
  49 instance FromField HyperdataDocument where
  50     fromField = fromField'
  51
  52 instance FromField HyperdataProject where
  53     fromField = fromField'
  54
  55 instance FromField HyperdataUser where
  56     fromField = fromField'
  57
  58
  59 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
  60 fromField' field mb = do
  61     v <- fromField field mb
  62     valueToHyperdata v
  63       where
  64           valueToHyperdata v = case fromJSON v of
  65              Success a  -> pure a
  66              Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
  67
  68
  69 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
  70   queryRunnerColumnDefault = fieldQueryRunnerColumn
  71
  72 instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus   where
  73   queryRunnerColumnDefault = fieldQueryRunnerColumn
  74
  75 instance QueryRunnerColumnDefault PGJsonb HyperdataProject  where
  76   queryRunnerColumnDefault = fieldQueryRunnerColumn
  77
  78 instance QueryRunnerColumnDefault PGJsonb HyperdataUser     where
  79   queryRunnerColumnDefault = fieldQueryRunnerColumn
  80
  81 instance QueryRunnerColumnDefault (Nullable PGInt4) Int     where
  82   queryRunnerColumnDefault = fieldQueryRunnerColumn
  83
  84 instance QueryRunnerColumnDefault (Nullable PGText) Text    where
  85   queryRunnerColumnDefault = fieldQueryRunnerColumn
  86
  87 instance QueryRunnerColumnDefault PGInt4 Integer            where
  88     queryRunnerColumnDefault = fieldQueryRunnerColumn
  89
  90
  91
  92 $(makeAdaptorAndInstance "pNode" ''NodePoly)
  93 $(makeLensesWith abbreviatedFields   ''NodePoly)
  94
  95
  96 nodeTable :: Table NodeWrite NodeRead
  97 nodeTable = Table "nodes" (pNode Node { node_id                = optional "id"
  98                                         , node_typename        = required "typename"
  99                                         , node_userId          = required "user_id"
 100                                         , node_parentId        = required "parent_id"
 101                                         , node_name            = required "name"
 102                                         , node_date            = optional "date"
 103                                         , node_hyperdata       = required "hyperdata"
 104                      --                   , node_titleAbstract   = optional "title_abstract"
 105                                         }
 106                             )
 107
 108
 109 selectNodes :: Column PGInt4 -> Query NodeRead
 110 selectNodes id = proc () -> do
 111     row <- queryNodeTable -< ()
 112     restrict -< node_id row .== id
 113     returnA -< row
 114
 115 runGetNodes :: Connection -> Query NodeRead -> IO [Document]
 116 runGetNodes = runQuery
 117
 118
 119
 120
 121 -- NP check type
 122 getNodesWithParentId :: Connection -> Int -> IO [Node Value]
 123 getNodesWithParentId conn n = runQuery conn $ selectNodesWithParentID n
 124
 125 selectNodesWithParentID :: Int -> Query NodeRead
 126 selectNodesWithParentID n = proc () -> do
 127     row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
 128     restrict -< if n > 0
 129                    then
 130                         parent_id .== (toNullable $ pgInt4 n)
 131                    else
 132                         isNull parent_id
 133     returnA -< row
 134
 135 queryNodeTable :: Query NodeRead
 136 queryNodeTable = queryTable nodeTable
 137
 138
 139
 140
 141 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 142 selectNodesWithType type_id = proc () -> do
 143     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
 144     restrict -< tn .== type_id
 145     returnA -< row
 146
 147 getNode :: Connection -> Column PGInt4 -> IO (Node Value)
 148 getNode conn id = do
 149     fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes id)
 150
 151 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
 152 getNodesWithType conn type_id = do
 153     runQuery conn $ selectNodesWithType type_id
 154
 155
 156 -- NP check type
 157 getCorpusDocument :: Connection -> Int -> IO [Document]
 158 getCorpusDocument conn n = runQuery conn (selectNodesWithParentID n)
 159
 160 -- NP check type
 161 getProjectCorpora :: Connection -> Int -> IO [Corpus]
 162 getProjectCorpora conn node_id = do
 163     runQuery conn $ selectNodesWithParentID node_id