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