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