src/Gargantext/Database/Query/Table/Context.hs

   1 {-|
   2 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
   3 Module      : Gargantext.Database.Query.Table.Node
   4 Description : Main Tools of Node to the database
   5 Copyright   : (c) CNRS, 2017-Present
   6 License     : AGPL + CECILL v3
   7 Maintainer  : team@gargantext.org
   8 Stability   : experimental
   9 Portability : POSIX
  10 -}
  11
  12
  13 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  14
  15 {-# LANGUAGE Arrows                 #-}
  16 {-# LANGUAGE ConstraintKinds        #-}
  17 {-# LANGUAGE FunctionalDependencies #-}
  18 {-# LANGUAGE QuasiQuotes       #-}
  19 {-# LANGUAGE TemplateHaskell        #-}
  20 {-# LANGUAGE TypeFamilies           #-}
  21
  22 module Gargantext.Database.Query.Table.Context
  23   where
  24
  25 import Control.Arrow (returnA)
  26 import Gargantext.Core
  27 import Gargantext.Core.Types
  28 import Gargantext.Database.Admin.Types.Hyperdata
  29 import Gargantext.Database.Prelude
  30 import Gargantext.Database.Query.Filter (limit', offset')
  31 import Gargantext.Database.Query.Table.Node.Error
  32 import Gargantext.Database.Schema.Context
  33 import Gargantext.Prelude hiding (sum, head)
  34 import Opaleye hiding (FromField)
  35 import Prelude hiding (null, id, map, sum)
  36
  37
  38 getContextWith :: (HasNodeError err, JSONB a)
  39             => ContextId -> proxy a -> Cmd err (Node a)
  40 getContextWith nId _ = do
  41   maybeContext <- headMay <$> runOpaQuery (selectContext (pgNodeId nId))
  42   case maybeContext of
  43     Nothing -> nodeError (DoesNotExist nId)
  44     Just  r -> pure $ context2node r
  45
  46 queryContextSearchTable :: Select ContextSearchRead
  47 queryContextSearchTable = selectTable contextTableSearch
  48
  49 selectContext :: Column SqlInt4 -> Select ContextRead
  50 selectContext id' = proc () -> do
  51     row      <- queryContextTable -< ()
  52     restrict -< _context_id row .== id'
  53     returnA  -< row
  54
  55 runGetContexts :: Select ContextRead -> Cmd err [Context HyperdataAny]
  56 runGetContexts = runOpaQuery
  57
  58 ------------------------------------------------------------------------
  59 ------------------------------------------------------------------------
  60 -- | order by publication date
  61 -- Favorites (Bool), node_ngrams
  62 selectContextsWith :: HasDBid NodeType
  63                 => ParentId     -> Maybe NodeType
  64                 -> Maybe Offset -> Maybe Limit   -> Select ContextRead
  65 selectContextsWith parentId maybeContextType maybeOffset maybeLimit =
  66         --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
  67   limit' maybeLimit $ offset' maybeOffset
  68                     $ orderBy (asc _context_id)
  69                     $ selectContextsWith' parentId maybeContextType
  70
  71 selectContextsWith' :: HasDBid NodeType
  72                  => ParentId -> Maybe NodeType -> Select ContextRead
  73 selectContextsWith' parentId maybeContextType = proc () -> do
  74     context' <- (proc () -> do
  75       row@(Context _ _ typeId _ parentId' _ _ _) <- queryContextTable -< ()
  76       restrict -< parentId' .== (pgNodeId parentId)
  77
  78       let typeId' = maybe 0 toDBid maybeContextType
  79
  80       restrict -< if typeId' > 0
  81                      then typeId   .== (sqlInt4 (typeId' :: Int))
  82                      else (sqlBool True)
  83       returnA  -< row ) -< ()
  84     returnA -< context'
  85
  86
  87 ------------------------------------------------------------------------
  88 getDocumentsV3WithParentId :: HasDBid NodeType => NodeId -> Cmd err [Context HyperdataDocumentV3]
  89 getDocumentsV3WithParentId n = runOpaQuery $ selectContextsWith' n (Just NodeDocument)
  90
  91 -- TODO: merge with getDocumentsWithParentId by having a class IsHyperdataDocument
  92 getDocumentsWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Context HyperdataDocument]
  93 getDocumentsWithParentId n = runOpaQuery $ selectContextsWith' n (Just NodeDocument)
  94
  95 ------------------------------------------------------------------------
  96 selectContextsWithParentID :: NodeId -> Select ContextRead
  97 selectContextsWithParentID n = proc () -> do
  98     row@(Context _ _ _ _ parent_id _ _ _) <- queryContextTable -< ()
  99     restrict -< parent_id .== (pgNodeId n)
 100     returnA -< row
 101
 102
 103 ------------------------------------------------------------------------
 104 -- | Example of use:
 105 -- runCmdReplEasy  (getNodesWithType NodeList (Proxy :: Proxy HyperdataList))
 106 getContextsWithType :: (HasNodeError err, JSONB a, HasDBid NodeType) => NodeType -> proxy a -> Cmd err [Context a]
 107 getContextsWithType nt _ = runOpaQuery $ selectContextsWithType nt
 108   where
 109     selectContextsWithType ::  HasDBid NodeType
 110                          => NodeType -> Select ContextRead
 111     selectContextsWithType nt' = proc () -> do
 112         row@(Context _ _ tn _ _ _ _ _) <- queryContextTable -< ()
 113         restrict -< tn .== (sqlInt4 $ toDBid nt')
 114         returnA -< row
 115
 116 getContextsIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [ContextId]
 117 getContextsIdWithType nt = do
 118   ns <- runOpaQuery $ selectContextsIdWithType nt
 119   pure (map NodeId ns)
 120
 121 selectContextsIdWithType :: HasDBid NodeType
 122                       => NodeType -> Select (Column SqlInt4)
 123 selectContextsIdWithType nt = proc () -> do
 124     row@(Context _ _ tn _ _ _ _ _) <- queryContextTable -< ()
 125     restrict -< tn .== (sqlInt4 $ toDBid nt)
 126     returnA -< _context_id row
 127
 128 ------------------------------------------------------------------------