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
 122                 -> Maybe Offset -> Maybe Limit   -> Query NodeRead
 123 selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
 124         --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
 125         limit' maybeLimit $ offset' maybeOffset $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
 126
 127 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
 128 selectNodesWith' parentId maybeNodeType = proc () -> do
 129     node <- (proc () -> do
 130             row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
 131             restrict -< parentId' .== (toNullable $ pgInt4 parentId)
 132
 133             let typeId' = maybe 0 nodeTypeId maybeNodeType
 134
 135             restrict -< if typeId' > 0
 136                            then typeId   .== (pgInt4 (typeId' :: Int))
 137                            else (pgBool True)
 138             returnA  -< row ) -< ()
 139     returnA -< node
 140
 141
 142 deleteNode :: Connection -> Int -> IO Int
 143 deleteNode conn n = fromIntegral
 144                  <$> runDelete conn nodeTable
 145                  (\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
 146
 147 deleteNodes :: Connection -> [Int] -> IO Int
 148 deleteNodes conn ns = fromIntegral
 149                    <$> runDelete conn nodeTable
 150                    (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
 151
 152
 153 getNodesWith :: Connection   -> Int         -> Maybe NodeType
 154              -> Maybe Offset -> Maybe Limit -> IO [Node Value]
 155 getNodesWith conn parentId nodeType maybeOffset maybeLimit =
 156     runQuery conn $ selectNodesWith
 157                   parentId nodeType maybeOffset maybeLimit
 158
 159
 160 -- NP check type
 161 getNodesWithParentId :: Connection -> Int
 162                      -> Maybe Text -> IO [Node Value]
 163 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
 164
 165 selectNodesWithParentID :: Int -> Query NodeRead
 166 selectNodesWithParentID n = proc () -> do
 167     row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
 168     restrict -< if n > 0
 169                    then
 170                         parent_id .== (toNullable $ pgInt4 n)
 171                    else
 172                         isNull parent_id
 173     returnA -< row
 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