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)
  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 -- Add order by
 155 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
 156 selectNodesWith' parentId maybeNodeType = proc () -> do
 157     node <- (proc () -> do
 158             row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
 159             restrict -< parentId' .== (toNullable $ pgInt4 parentId)
 160
 161             let typeId' = maybe 0 nodeTypeId maybeNodeType
 162
 163             restrict -< if typeId' > 0
 164                            then typeId   .== (pgInt4 (typeId' :: Int))
 165                            else (pgBool True)
 166             returnA  -< row ) -< ()
 167     returnA -< node
 168
 169
 170 --getNodesWith' :: Connection -> Int -> Maybe NodeType -> Maybe Offset' -> Maybe Limit' -> IO [Node Value]
 171 --getNodesWith' conn parentId maybeNodeType maybeOffset maybeLimit = runQuery conn $ selectNodesWith parentId xxx maybeOffset maybeLimit
 172
 173
 174 getNodesWith :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node Value]
 175 getNodesWith conn parentId nodeType maybeOffset maybeLimit = runQuery conn $ selectNodesWith parentId nodeType maybeOffset maybeLimit
 176
 177
 178 -- NP check type
 179 getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
 180 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
 181
 182 selectNodesWithParentID :: Int -> Query NodeRead
 183 selectNodesWithParentID n = proc () -> do
 184     row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
 185     restrict -< if n > 0
 186                    then
 187                         parent_id .== (toNullable $ pgInt4 n)
 188                    else
 189                         isNull parent_id
 190     returnA -< row
 191
 192
 193
 194
 195 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 196 selectNodesWithType type_id = proc () -> do
 197     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
 198     restrict -< tn .== type_id
 199     returnA -< row
 200
 201 getNode :: Connection -> Int -> IO (Node Value)
 202 getNode conn id = do
 203     fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
 204
 205 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
 206 getNodesWithType conn type_id = do
 207     runQuery conn $ selectNodesWithType type_id
 208
 209