src/Gargantext/Database/Node.hs

   1 {-|
   2 Module      : Gargantext.Database.Node
   3 Description : Main requests of Node to the database
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9 -}
  10
  11 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  12 {-# LANGUAGE TemplateHaskell #-}
  13 {-# LANGUAGE FlexibleInstances #-}
  14 {-# LANGUAGE DeriveGeneric #-}
  15 {-# LANGUAGE MultiParamTypeClasses #-}
  16 {-# LANGUAGE FunctionalDependencies #-}
  17 {-# LANGUAGE Arrows #-}
  18 {-# OPTIONS_GHC -fno-warn-orphans #-}
  19
  20 module Gargantext.Database.Node where
  21
  22 import Database.PostgreSQL.Simple.FromField ( Conversion
  23                                             , ResultError(ConversionFailed)
  24                                             , FromField
  25                                             , fromField
  26                                             , returnError
  27                                             )
  28 import Prelude hiding (null, id, map)
  29 import Gargantext.Types.Main (NodeType)
  30 import Database.PostgreSQL.Simple.Internal  (Field)
  31 import Control.Arrow (returnA)
  32 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  33 import Data.Aeson
  34 import Gargantext.Types
  35 import Gargantext.Prelude
  36 import Data.Maybe (Maybe, fromMaybe)
  37 import Data.Text (Text)
  38 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  39 import Data.Typeable (Typeable)
  40 import qualified Data.ByteString.Internal as DBI
  41 import Database.PostgreSQL.Simple (Connection)
  42 import Opaleye
  43
  44 -- | Types for Node Database Management
  45 data PGTSVector
  46
  47 type NodeWrite = NodePoly  (Maybe (Column PGInt4))  (Column PGInt4)
  48                                   (Column PGInt4)   (Column (Nullable PGInt4))
  49                                   (Column (PGText)) (Maybe (Column PGTimestamptz))
  50                                   (Column PGJsonb) -- (Maybe (Column PGTSVector))
  51
  52 type NodeRead = NodePoly  (Column PGInt4)   (Column PGInt4)
  53                           (Column PGInt4)   (Column (Nullable PGInt4))
  54                           (Column (PGText)) (Column PGTimestamptz)
  55                           (Column PGJsonb) -- (Column PGTSVector)
  56
  57 instance FromField HyperdataCorpus where
  58     fromField = fromField'
  59
  60 instance FromField HyperdataDocument where
  61     fromField = fromField'
  62
  63 instance FromField HyperdataProject where
  64     fromField = fromField'
  65
  66 instance FromField HyperdataUser where
  67     fromField = fromField'
  68
  69
  70 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
  71 fromField' field mb = do
  72     v <- fromField field mb
  73     valueToHyperdata v
  74       where
  75           valueToHyperdata v = case fromJSON v of
  76              Success a  -> pure a
  77              Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
  78
  79
  80 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
  81   queryRunnerColumnDefault = fieldQueryRunnerColumn
  82
  83 instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus   where
  84   queryRunnerColumnDefault = fieldQueryRunnerColumn
  85
  86 instance QueryRunnerColumnDefault PGJsonb HyperdataProject  where
  87   queryRunnerColumnDefault = fieldQueryRunnerColumn
  88
  89 instance QueryRunnerColumnDefault PGJsonb HyperdataUser     where
  90   queryRunnerColumnDefault = fieldQueryRunnerColumn
  91
  92 instance QueryRunnerColumnDefault (Nullable PGInt4) Int     where
  93   queryRunnerColumnDefault = fieldQueryRunnerColumn
  94
  95 instance QueryRunnerColumnDefault (Nullable PGText) Text    where
  96   queryRunnerColumnDefault = fieldQueryRunnerColumn
  97
  98 instance QueryRunnerColumnDefault PGInt4 Integer            where
  99     queryRunnerColumnDefault = fieldQueryRunnerColumn
 100
 101
 102
 103 $(makeAdaptorAndInstance "pNode" ''NodePoly)
 104 $(makeLensesWith abbreviatedFields   ''NodePoly)
 105
 106
 107 nodeTable :: Table NodeWrite NodeRead
 108 nodeTable = Table "nodes" (pNode Node { node_id                = optional "id"
 109                                         , node_typename        = required "typename"
 110                                         , node_userId          = required "user_id"
 111                                         , node_parentId        = required "parent_id"
 112                                         , node_name            = required "name"
 113                                         , node_date            = optional "date"
 114                                         , node_hyperdata       = required "hyperdata"
 115                      --                   , node_titleAbstract   = optional "title_abstract"
 116                                         }
 117                             )
 118
 119
 120 queryNodeTable :: Query NodeRead
 121 queryNodeTable = queryTable nodeTable
 122
 123
 124 selectNodes :: Column PGInt4 -> Query NodeRead
 125 selectNodes id = proc () -> do
 126     row <- queryNodeTable -< ()
 127     restrict -< node_id row .== id
 128     returnA -< row
 129
 130 runGetNodes :: Connection -> Query NodeRead -> IO [Node Value]
 131 runGetNodes = runQuery
 132
 133
 134 type ParentId = NodeId
 135 type Limit    = Int
 136 type Offset    = Int
 137
 138 -- | order by publication date
 139 -- Favorites (Bool), node_ngrams
 140 selectNodesWith :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query NodeRead
 141 selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
 142         --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
 143         offset' maybeOffset $ limit' maybeLimit $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
 144
 145
 146 limit' ::  Maybe Limit -> Query NodeRead -> Query NodeRead
 147 limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
 148
 149
 150 offset' :: Maybe Offset -> Query NodeRead  -> Query NodeRead
 151 offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
 152
 153
 154 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
 155 selectNodesWith' parentId maybeNodeType = proc () -> do
 156     node <- (proc () -> do
 157             row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
 158             restrict -< parentId' .== (toNullable $ pgInt4 parentId)
 159
 160             let typeId' = maybe 0 nodeTypeId maybeNodeType
 161
 162             restrict -< if typeId' > 0
 163                            then typeId   .== (pgInt4 (typeId' :: Int))
 164                            else (pgBool True)
 165             returnA  -< row ) -< ()
 166     returnA -< node
 167
 168
 169
 170 deleteNode :: Connection -> Int -> IO Int
 171 deleteNode conn n = fromIntegral
 172                  <$> runDelete conn nodeTable
 173                  (\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
 174
 175 deleteNodes :: Connection -> [Int] -> IO Int
 176 deleteNodes conn ns = fromIntegral
 177                    <$> runDelete conn nodeTable
 178                    (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
 179
 180
 181 getNodesWith :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node Value]
 182 getNodesWith conn parentId nodeType maybeOffset maybeLimit =
 183     runQuery conn $ selectNodesWith
 184                   parentId nodeType maybeOffset maybeLimit
 185
 186
 187 -- NP check type
 188 getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
 189 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
 190
 191 selectNodesWithParentID :: Int -> Query NodeRead
 192 selectNodesWithParentID n = proc () -> do
 193     row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
 194     restrict -< if n > 0
 195                    then
 196                         parent_id .== (toNullable $ pgInt4 n)
 197                    else
 198                         isNull parent_id
 199     returnA -< row
 200
 201
 202
 203
 204 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 205 selectNodesWithType type_id = proc () -> do
 206     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
 207     restrict -< tn .== type_id
 208     returnA -< row
 209
 210 getNode :: Connection -> Int -> IO (Node Value)
 211 getNode conn id = do
 212     fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
 213
 214 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
 215 getNodesWithType conn type_id = do
 216     runQuery conn $ selectNodesWithType type_id
 217
 218