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 <$> runDelete conn nodeTable (\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
 172
 173 deleteNodes :: Connection -> [Int] -> IO Int
 174 deleteNodes conn ns = fromIntegral <$> runDelete conn nodeTable (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
 175
 176
 177
 178 getNodesWith :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node Value]
 179 getNodesWith conn parentId nodeType maybeOffset maybeLimit = runQuery conn $ selectNodesWith parentId nodeType maybeOffset maybeLimit
 180
 181
 182 -- NP check type
 183 getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
 184 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
 185
 186 selectNodesWithParentID :: Int -> Query NodeRead
 187 selectNodesWithParentID n = proc () -> do
 188     row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
 189     restrict -< if n > 0
 190                    then
 191                         parent_id .== (toNullable $ pgInt4 n)
 192                    else
 193                         isNull parent_id
 194     returnA -< row
 195
 196
 197
 198
 199 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 200 selectNodesWithType type_id = proc () -> do
 201     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
 202     restrict -< tn .== type_id
 203     returnA -< row
 204
 205 getNode :: Connection -> Int -> IO (Node Value)
 206 getNode conn id = do
 207     fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
 208
 209 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
 210 getNodesWithType conn type_id = do
 211     runQuery conn $ selectNodesWithType type_id
 212
 213