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, sum)
  29
  30 import Gargantext.Types
  31 import Gargantext.Types.Main (NodeType)
  32 import Gargantext.Database.NodeNode
  33 -- import Gargantext.Database.NodeNgram
  34 import Gargantext.Prelude hiding (sum)
  35
  36
  37 import Database.PostgreSQL.Simple.Internal  (Field)
  38 import Control.Arrow (returnA)
  39 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  40 import Data.Aeson
  41 import Data.Maybe (Maybe, fromMaybe)
  42 import Data.Text (Text)
  43 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  44 import Data.Typeable (Typeable)
  45 import qualified Data.ByteString.Internal as DBI
  46 import Database.PostgreSQL.Simple (Connection)
  47 import Opaleye
  48
  49 -- | Types for Node Database Management
  50 data PGTSVector
  51
  52 type NodeWrite = NodePoly  (Maybe (Column PGInt4))  (Column PGInt4)
  53                                   (Column PGInt4)   (Column (Nullable PGInt4))
  54                                   (Column (PGText)) (Maybe (Column PGTimestamptz))
  55                                   (Column PGJsonb) -- (Maybe (Column PGTSVector))
  56
  57 type NodeRead = NodePoly  (Column PGInt4)   (Column PGInt4)
  58                           (Column PGInt4)   (Column (Nullable PGInt4))
  59                           (Column (PGText)) (Column PGTimestamptz)
  60                           (Column PGJsonb) -- (Column PGTSVector)
  61
  62 -- Facets / Views for the Front End
  63 type FacetDocRead  = Facet (Column PGInt4) (Column PGJsonb) (Column PGBool) (Column PGFloat8)
  64 -- type FacetDocWrite = Facet (Column PGInt4) (Column PGJsonb) (Column PGBool) (Column PGFloat8)
  65
  66
  67 instance FromField HyperdataCorpus where
  68     fromField = fromField'
  69
  70 instance FromField HyperdataDocument where
  71     fromField = fromField'
  72
  73 instance FromField HyperdataProject where
  74     fromField = fromField'
  75
  76 instance FromField HyperdataUser where
  77     fromField = fromField'
  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
  93
  94 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
  95 fromField' field mb = do
  96     v <- fromField field mb
  97     valueToHyperdata v
  98       where
  99           valueToHyperdata v = case fromJSON v of
 100              Success a  -> pure a
 101              Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
 102
 103
 104
 105 $(makeAdaptorAndInstance "pNode" ''NodePoly)
 106 $(makeLensesWith abbreviatedFields   ''NodePoly)
 107
 108 $(makeAdaptorAndInstance "pFacetDoc" ''Facet)
 109 $(makeLensesWith abbreviatedFields   ''Facet)
 110
 111
 112
 113 nodeTable :: Table NodeWrite NodeRead
 114 nodeTable = Table "nodes" (pNode Node { node_id                = optional "id"
 115                                         , node_typename        = required "typename"
 116                                         , node_userId          = required "user_id"
 117                                         , node_parentId        = required "parent_id"
 118                                         , node_name            = required "name"
 119                                         , node_date            = optional "date"
 120                                         , node_hyperdata       = required "hyperdata"
 121                      --                   , node_titleAbstract   = optional "title_abstract"
 122                                         }
 123                             )
 124
 125
 126 queryNodeTable :: Query NodeRead
 127 queryNodeTable = queryTable nodeTable
 128
 129
 130 selectNodes :: Column PGInt4 -> Query NodeRead
 131 selectNodes id = proc () -> do
 132     row <- queryNodeTable -< ()
 133     restrict -< node_id row .== id
 134     returnA -< row
 135
 136 runGetNodes :: Connection -> Query NodeRead -> IO [Node Value]
 137 runGetNodes = runQuery
 138
 139
 140 type ParentId = NodeId
 141 type Limit    = Int
 142 type Offset    = Int
 143
 144 -- | order by publication date
 145 -- Favorites (Bool), node_ngrams
 146 selectNodesWith :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query NodeRead
 147 selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
 148         --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
 149         limit' maybeLimit $ offset' maybeOffset $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
 150
 151
 152 limit' ::  Maybe Limit -> Query a -> Query a
 153 limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
 154
 155
 156 offset' :: Maybe Offset -> Query a  -> Query a
 157 offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
 158
 159
 160 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
 161 selectNodesWith' parentId maybeNodeType = proc () -> do
 162     node <- (proc () -> do
 163             row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
 164             restrict -< parentId' .== (toNullable $ pgInt4 parentId)
 165
 166             let typeId' = maybe 0 nodeTypeId maybeNodeType
 167
 168             restrict -< if typeId' > 0
 169                            then typeId   .== (pgInt4 (typeId' :: Int))
 170                            else (pgBool True)
 171             returnA  -< row ) -< ()
 172     returnA -< node
 173
 174
 175
 176 getDocFacet :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [FacetDoc Value]
 177 getDocFacet conn parentId nodeType maybeOffset maybeLimit =
 178     runQuery conn $ selectDocFacet parentId nodeType maybeOffset maybeLimit
 179
 180 selectDocFacet :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query FacetDocRead
 181 selectDocFacet parentId maybeNodeType maybeOffset maybeLimit =
 182         -- limit' maybeLimit $ offset' maybeOffset $ orderBy (asc docFacet_id) $ selectDocFacet' parentId maybeNodeType
 183         limit' maybeLimit $ offset' maybeOffset $ selectDocFacet' parentId maybeNodeType
 184 --
 185
 186 selectDocFacet' :: ParentId -> Maybe NodeType -> Query FacetDocRead
 187 selectDocFacet' parentId maybeNodeType = proc () -> do
 188     node <- (proc () -> do
 189             -- Selecting the documents
 190             (Node n_id typeId _ parentId' _ _ hyperdata)      <- queryNodeTable -< ()
 191             restrict -< parentId' .== (toNullable $ pgInt4 parentId)
 192
 193             let typeId' = maybe 0 nodeTypeId maybeNodeType
 194             restrict -< if typeId' > 0
 195                            then typeId   .== (pgInt4 (typeId' :: Int))
 196                            else (pgBool True)
 197
 198             -- Ngram count by document
 199             -- nodeNgramNgram@(NodeNgram _ n_id_nn _ weight) <- queryNodeNgramTable -< ()
 200             -- restrict -< n_id_nn .== n_id
 201             let ngramCount = (pgDouble 10) -- groupBy n_id
 202
 203             -- Favorite Column
 204             (Node n_id_fav typeId_fav _ parentId_fav  _ _ _) <- queryNodeTable -< ()
 205             (NodeNode n1_id n2_id count)                     <- queryNodeNodeTable  -< ()
 206
 207             restrict -< typeId_fav .== 15 .&& parentId_fav .== (toNullable $ pgInt4 parentId)
 208             restrict -< n1_id .== n_id_fav .&& n_id .== n2_id
 209
 210             let isFav = ifThenElse (isNull count) (pgBool False) (pgBool True)
 211
 212             returnA  -< (FacetDoc n_id hyperdata isFav ngramCount)) -< ()
 213     returnA -< node
 214
 215
 216
 217
 218 deleteNode :: Connection -> Int -> IO Int
 219 deleteNode conn n = fromIntegral
 220                  <$> runDelete conn nodeTable
 221                  (\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
 222
 223 deleteNodes :: Connection -> [Int] -> IO Int
 224 deleteNodes conn ns = fromIntegral
 225                    <$> runDelete conn nodeTable
 226                    (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
 227
 228
 229 getNodesWith :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node Value]
 230 getNodesWith conn parentId nodeType maybeOffset maybeLimit =
 231     runQuery conn $ selectNodesWith
 232                   parentId nodeType maybeOffset maybeLimit
 233
 234
 235 -- NP check type
 236 getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
 237 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
 238
 239 selectNodesWithParentID :: Int -> Query NodeRead
 240 selectNodesWithParentID n = proc () -> do
 241     row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
 242     restrict -< if n > 0
 243                    then
 244                         parent_id .== (toNullable $ pgInt4 n)
 245                    else
 246                         isNull parent_id
 247     returnA -< row
 248
 249
 250
 251 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 252 selectNodesWithType type_id = proc () -> do
 253     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
 254     restrict -< tn .== type_id
 255     returnA -< row
 256
 257 getNode :: Connection -> Int -> IO (Node Value)
 258 getNode conn id = do
 259     fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
 260
 261 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
 262 getNodesWithType conn type_id = do
 263     runQuery conn $ selectNodesWithType type_id
 264
 265