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