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 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  13
  14 {-# LANGUAGE Arrows                 #-}
  15 {-# LANGUAGE DeriveGeneric          #-}
  16 {-# LANGUAGE FlexibleInstances      #-}
  17 {-# LANGUAGE FunctionalDependencies #-}
  18 {-# LANGUAGE MultiParamTypeClasses  #-}
  19 {-# LANGUAGE NoImplicitPrelude      #-}
  20 {-# LANGUAGE TemplateHaskell        #-}
  21
  22 module Gargantext.Database.Node where
  23
  24 import Data.ByteString (ByteString)
  25 import GHC.Int (Int64)
  26 import Data.Maybe
  27 import Data.Time (UTCTime)
  28 import Database.PostgreSQL.Simple.FromField ( Conversion
  29                                             , ResultError(ConversionFailed)
  30                                             , FromField
  31                                             , fromField
  32                                             , returnError
  33                                             )
  34 import Prelude hiding (null, id, map, sum)
  35 import           Data.Time.Segment (jour, timesAfter, Granularity(D))
  36
  37 import Gargantext.Core.Types
  38 import Gargantext.Core.Types.Node (NodeType)
  39 import Gargantext.Database.Queries
  40 import Gargantext.Prelude hiding (sum)
  41
  42
  43 import Database.PostgreSQL.Simple.Internal  (Field)
  44 import Control.Arrow (returnA)
  45 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  46 import Data.Aeson
  47 import Data.Maybe (Maybe, fromMaybe)
  48 import Data.Text (Text)
  49 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  50 import Data.Typeable (Typeable)
  51 import qualified Data.ByteString.Internal as DBI
  52 import Database.PostgreSQL.Simple (Connection)
  53 import Opaleye hiding (FromField)
  54 import Opaleye.Internal.QueryArr (Query(..))
  55 import qualified Data.Profunctor.Product as PP
  56 -- | Types for Node Database Management
  57 data PGTSVector
  58
  59
  60 instance FromField HyperdataCorpus where
  61     fromField = fromField'
  62
  63 instance FromField HyperdataDocument where
  64     fromField = fromField'
  65
  66 instance FromField HyperdataProject where
  67     fromField = fromField'
  68
  69 instance FromField HyperdataUser where
  70     fromField = fromField'
  71
  72
  73 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
  74   queryRunnerColumnDefault = fieldQueryRunnerColumn
  75
  76 instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus   where
  77   queryRunnerColumnDefault = fieldQueryRunnerColumn
  78
  79 instance QueryRunnerColumnDefault PGJsonb HyperdataProject  where
  80   queryRunnerColumnDefault = fieldQueryRunnerColumn
  81
  82 instance QueryRunnerColumnDefault PGJsonb HyperdataUser     where
  83   queryRunnerColumnDefault = fieldQueryRunnerColumn
  84
  85
  86
  87 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
  88 fromField' field mb = do
  89     v <- fromField field mb
  90     valueToHyperdata v
  91       where
  92           valueToHyperdata v = case fromJSON v of
  93              Success a  -> pure a
  94              Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
  95
  96
  97 $(makeAdaptorAndInstance "pNode" ''NodePoly)
  98 $(makeLensesWith abbreviatedFields ''NodePoly)
  99
 100
 101 nodeTable :: Table NodeWrite NodeRead
 102 nodeTable = Table "nodes" (pNode Node { node_id                = optional "id"
 103                                         , node_typename        = required "typename"
 104                                         , node_userId          = required "user_id"
 105                                         , node_parentId        = required "parent_id"
 106                                         , node_name            = required "name"
 107                                         , node_date            = optional "date"
 108                                         , node_hyperdata       = required "hyperdata"
 109                      --                   , node_titleAbstract   = optional "title_abstract"
 110                                         }
 111                             )
 112
 113
 114 nodeTable' :: Table (Maybe (Column PGInt4)
 115                     ,       Column PGInt4
 116                     ,       Column PGInt4
 117                     ,       Column PGInt4
 118                     ,       Column PGText
 119                     ,Maybe (Column PGTimestamptz)
 120                     ,       Column PGJsonb
 121                     )
 122                     ((Column PGInt4)
 123                     ,       Column PGInt4
 124                     ,       Column PGInt4
 125                     ,       Column PGInt4
 126                     ,       Column PGText
 127                     ,(Column PGTimestamptz)
 128                     ,       Column PGJsonb
 129                     )
 130
 131 nodeTable' = Table "nodes" (PP.p7 ( optional "id"
 132                                , required "typename"
 133                                , required "user_id"
 134                                , required "parent_id"
 135                                , required "name"
 136                                , optional "date"
 137                                , required "hyperdata"
 138                                )
 139                             )
 140
 141
 142 queryNodeTable :: Query NodeRead
 143 queryNodeTable = queryTable nodeTable
 144
 145
 146 selectNode :: Column PGInt4 -> Query NodeRead
 147 selectNode id = proc () -> do
 148     row <- queryNodeTable -< ()
 149     restrict -< node_id row .== id
 150     returnA -< row
 151
 152 runGetNodes :: Connection -> Query NodeRead -> IO [Node Value]
 153 runGetNodes = runQuery
 154
 155 -- | order by publication date
 156 -- Favorites (Bool), node_ngrams
 157 selectNodesWith :: ParentId     -> Maybe NodeType
 158                 -> Maybe Offset -> Maybe Limit   -> Query NodeRead
 159 selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
 160         --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
 161         limit' maybeLimit $ offset' maybeOffset $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
 162
 163 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
 164 selectNodesWith' parentId maybeNodeType = proc () -> do
 165     node <- (proc () -> do
 166             row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
 167             restrict -< parentId' .== (toNullable $ pgInt4 parentId)
 168
 169             let typeId' = maybe 0 nodeTypeId maybeNodeType
 170
 171             restrict -< if typeId' > 0
 172                            then typeId   .== (pgInt4 (typeId' :: Int))
 173                            else (pgBool True)
 174             returnA  -< row ) -< ()
 175     returnA -< node
 176
 177
 178 deleteNode :: Connection -> Int -> IO Int
 179 deleteNode conn n = fromIntegral <$> runDelete conn nodeTable
 180                  (\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
 181
 182 deleteNodes :: Connection -> [Int] -> IO Int
 183 deleteNodes conn ns = fromIntegral <$> runDelete conn nodeTable
 184                    (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
 185
 186
 187 getNodesWith :: Connection   -> Int         -> Maybe NodeType
 188              -> Maybe Offset -> Maybe Limit -> IO [Node HyperdataDocument]
 189 getNodesWith conn parentId nodeType maybeOffset maybeLimit =
 190     runQuery conn $ selectNodesWith
 191                   parentId nodeType maybeOffset maybeLimit
 192
 193
 194 -- NP check type
 195 getNodesWithParentId :: Connection -> Int
 196                      -> Maybe Text -> IO [Node HyperdataDocument]
 197 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
 198
 199 getNodesWithParentId' :: Connection -> Int
 200                      -> Maybe Text -> IO [Node Value]
 201 getNodesWithParentId' conn n _ = runQuery conn $ selectNodesWithParentID n
 202
 203
 204 selectNodesWithParentID :: Int -> Query NodeRead
 205 selectNodesWithParentID n = proc () -> do
 206     row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
 207     restrict -< if n > 0
 208                    then
 209                         parent_id .== (toNullable $ pgInt4 n)
 210                    else
 211                         isNull parent_id
 212     returnA -< row
 213
 214
 215 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 216 selectNodesWithType type_id = proc () -> do
 217     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
 218     restrict -< tn .== type_id
 219     returnA -< row
 220
 221 getNode' :: Connection -> Int -> IO (Node Value)
 222 getNode' c id = do
 223   fromMaybe (error "TODO: 404") . headMay <$> runQuery c (limit 1 $ selectNode (pgInt4 id))
 224
 225
 226 getNode :: Connection -> Int -> IO (Node HyperdataDocument)
 227 getNode conn id = do
 228     fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNode (pgInt4 id))
 229
 230 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node HyperdataDocument]
 231 getNodesWithType conn type_id = do
 232     runQuery conn $ selectNodesWithType type_id
 233
 234 type UserId = NodeId
 235 type NodeWrite' = NodePoly (Maybe Int) Int Int (ParentId) Text (Maybe UTCTime) ByteString
 236 type TypeId = Int
 237
 238 --node :: UserId -> ParentId -> NodeType -> Text -> Value -> NodeWrite'
 239 node :: UserId -> ParentId -> NodeType -> Text -> ByteString -> NodeWrite'
 240 node userId parentId nodeType name nodeData = Node Nothing typeId userId parentId name Nothing byteData
 241   where
 242     typeId = nodeTypeId nodeType
 243     byteData = nodeData
 244     --byteData = encode nodeData
 245
 246 node2write pid (Node id tn ud _ nm dt hp) = ((pgInt4    <$> id)
 247                                          ,(pgInt4        tn)
 248                                          ,(pgInt4        ud)
 249                                          ,(pgInt4        pid)
 250                                          ,(pgStrictText  nm)
 251                                          ,(pgUTCTime <$> dt)
 252                                          ,(pgStrictJSONB hp)
 253                                          )
 254
 255
 256 mkNode :: Connection -> ParentId -> [NodeWrite'] -> IO Int64
 257 mkNode conn pid ns = runInsertMany conn nodeTable' $ map (node2write pid) ns