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

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