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
  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 Data.Gargantext.Types
  24 import Data.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 $ selectNodeWithParentID n
 124
 125 selectNodeWithParentID :: Int -> Query NodeRead
 126 selectNodeWithParentID 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
 142 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 143 selectNodesWithType type_id = proc () -> do
 144     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
 145     restrict -< tn .== type_id
 146     returnA -< row
 147
 148 getNode :: Connection -> Column PGInt4 -> IO (Node Value)
 149 getNode conn id = do
 150     fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes id)
 151
 152 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
 153 getNodesWithType conn type_id = do
 154     runQuery conn $ selectNodesWithType type_id
 155
 156
 157 -- NP check type
 158 getCorpusDocument :: Connection -> Int -> IO [Document]
 159 getCorpusDocument conn n = runQuery conn (selectNodeWithParentID n)
 160
 161 -- NP check type
 162 getProjectCorpora :: Connection -> Int -> IO [Corpus]
 163 getProjectCorpora conn node_id = do
 164     runQuery conn $ selectNodeWithParentID node_id