src/Gargantext/Database/Facet.hs

   1 {-|
   2 Module      : Gargantext.Database.Facet
   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 FlexibleContexts #-}
  15 {-# LANGUAGE DeriveGeneric #-}
  16 {-# LANGUAGE MultiParamTypeClasses #-}
  17 {-# LANGUAGE FunctionalDependencies #-}
  18 {-# LANGUAGE Arrows #-}
  19 {-# OPTIONS_GHC -fno-warn-orphans #-}
  20
  21 module Gargantext.Database.Facet where
  22
  23 import Prelude hiding (null, id, map, sum, not)
  24
  25 import Gargantext.Types
  26 import Gargantext.Types.Main (NodeType)
  27 import Gargantext.Database.NodeNode
  28 import Gargantext.Database.NodeNodeNgram
  29 import Gargantext.Database.Node
  30 import Gargantext.Database.Queries
  31 import Gargantext.Utils.Prefix (unPrefix)
  32 -- import Gargantext.Database.NodeNgram
  33
  34 -- import Data.Aeson (Value)
  35 import Data.Aeson.TH (deriveJSON)
  36 import Control.Arrow (returnA)
  37 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  38 import Data.Maybe (Maybe)
  39 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  40 import Data.Time (UTCTime)
  41 import Database.PostgreSQL.Simple (Connection)
  42 import Opaleye
  43 import Opaleye.Internal.Join (NullMaker)
  44
  45 import qualified Opaleye.Internal.Unpackspec()
  46 import Data.Profunctor.Product.Default (Default)
  47
  48 -- DocFacet
  49
  50 type FacetDoc = Facet NodeId UTCTime HyperdataDocument Bool -- Double
  51
  52 data Facet id created hyperdata favorite  = FacetDoc { facetDoc_id :: id
  53                                                        , facetDoc_created   :: created
  54                                                        , facetDoc_hyperdata :: hyperdata
  55                                                        , facetDoc_favorite  :: favorite
  56                                           -- To be added: Double
  57                                           --             , facetDoc_ngramCount :: ngramCount
  58                                                        } deriving (Show)
  59 $(deriveJSON (unPrefix "facetDoc_") ''Facet)
  60
  61
  62
  63 -- Facets / Views for the Front End
  64 type FacetDocRead  = Facet (Column PGInt4) (Column PGTimestamptz) (Column PGJsonb) (Column PGBool) -- (Column PGFloat8)
  65
  66 $(makeAdaptorAndInstance "pFacetDoc" ''Facet)
  67 $(makeLensesWith abbreviatedFields   ''Facet)
  68
  69 getDocFacet :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [FacetDoc]
  70 getDocFacet conn parentId nodeType maybeOffset maybeLimit =
  71     runQuery conn $ selectDocFacet parentId nodeType maybeOffset maybeLimit
  72
  73 selectDocFacet :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query FacetDocRead
  74 selectDocFacet parentId maybeNodeType maybeOffset maybeLimit =
  75         limit' maybeLimit $ offset' maybeOffset $ orderBy (asc facetDoc_created) $ selectDocFacet' parentId maybeNodeType
  76
  77
  78 -- | Left join to the favorites
  79 nodeNodeLeftJoin :: Query (NodeRead, NodeNodeReadNull)
  80 nodeNodeLeftJoin = leftJoin queryNodeTable queryNodeNodeTable (eqNode)
  81     where
  82         eqNode (Node n1 _ _ _ _ _ _, NodeNode _ n2 _) = ((.==) n1 n2)
  83
  84
  85 nodeNodeLeftJoin' :: (Column (Nullable PGInt4))
  86                   -> Query (NodeRead, NodeNodeReadNull)
  87 nodeNodeLeftJoin' nId = leftJoin queryNodeTable queryNodeNodeTable (eqNode nId)
  88         where
  89             eqNode n (Node n1 _ _ _ _ _ _, NodeNode n1' n2 _)
  90                    = foldl (.&&) (pgBool True) [ ((.==) n1 n2)
  91                                                , ((.==) n1' n)
  92                                                ]
  93
  94 nodeNodeLeftJoin'' :: Query (NodeRead, NodeRead, NodeNodeRead)
  95 nodeNodeLeftJoin'' = join3 queryNodeTable queryNodeTable queryNodeNodeTable eqNode
  96         where
  97             eqNode (Node n1 _ _ _ _ _ _, Node n2 _ _ _ _ _ _, NodeNode n1' n2' _)
  98                    = foldl (.&&) (pgBool True) [ ((.==) n2 n2')
  99                                                , ((.==) (toNullable n1) n1')
 100                                                ]
 101
 102 -- | Left join to the ngram count per document
 103 nodeNodeNgramLeftJoin :: Query (NodeRead, NodeNodeNgramReadNull)
 104 nodeNodeNgramLeftJoin = leftJoin queryNodeTable queryNodeNodeNgramTable (eqNode)
 105      where
 106         eqNode (Node n1 _ _ _ _ _ _, NodeNodeNgram n1' _ _ _) = ((.==) n1 n1')
 107
 108
 109 nodeNodeNgramLeftJoin' :: Column (Nullable PGInt4)
 110                        -> Query (NodeRead, NodeNodeNgramReadNull)
 111 nodeNodeNgramLeftJoin' nId = leftJoin queryNodeTable queryNodeNodeNgramTable (eqNode nId)
 112      where
 113         eqNode nId' (Node n1 _ _ _ _ _ _, NodeNodeNgram n1' n2 _ _)
 114                  = (.&&) ((.==) n1 n1')
 115                          ((.==) nId' (toNullable n2))
 116
 117
 118 leftJoin3 :: (Default NullMaker (columnsL1, nullableColumnsR) nullableColumnsR1,
 119                     Default NullMaker columnsR nullableColumnsR,
 120                     Default Unpackspec columnsR columnsR,
 121                     Default Unpackspec nullableColumnsR nullableColumnsR,
 122                     Default Unpackspec columnsL1 columnsL1,
 123                     Default Unpackspec columnsL columnsL) =>
 124                    Query columnsL1
 125                    -> Query columnsR
 126                    -> Query columnsL
 127                    -> ((columnsL1, columnsR) -> Column PGBool)
 128                    -> ((columnsL, (columnsL1, nullableColumnsR)) -> Column PGBool)
 129                    -> Query (columnsL, nullableColumnsR1)
 130 leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
 131
 132 -- | Building the facet
 133 selectDocFacet' :: ParentId -> Maybe NodeType -> Query FacetDocRead
 134 selectDocFacet' parentId _ = proc () -> do
 135     node <- (proc () -> do
 136
 137             -- Favorite Column
 138             (Node _ favTypeId _ favParentId _ _ _)      <- queryNodeTable -< ()
 139             restrict -< favTypeId .== 15 .&& favParentId .== (toNullable $ pgInt4 parentId)
 140
 141             -- select nn.score from nodes n left join nodes_nodes nn on n.id = nn.node2_id where n.typename =4;
 142             -- Selecting the documents and joining Favorite Node
 143             (Node docId docTypeId _ docParentId _ created docHyperdata, NodeNode _ docTypeId' _) <- nodeNodeLeftJoin' (toNullable $ pgInt4 347537) -< ()
 144             restrict -< docParentId .== (toNullable $ pgInt4 parentId)
 145             let docTypeId'' = maybe 0 nodeTypeId (Just Document)
 146             restrict -< if docTypeId'' > 0
 147                            then docTypeId   .== (pgInt4 (docTypeId'' :: Int))
 148                            else (pgBool True)
 149
 150             -- Getting favorite data
 151             let isFav = ifThenElse (isNull docTypeId') (pgBool False) (pgBool True)
 152
 153             -- Ngram count by document
 154             -- Counting the ngram
 155             -- (Node occId occTypeId _ _ _ _ _, NodeNode _ _ _ count) <- nodeNodeNgramLeftJoin -< ()
 156             -- restrict -< occId .== 347540
 157
 158             --returnA  -< (FacetDoc n_id hyperdata isFav ngramCount)) -< ()
 159             returnA  -< (FacetDoc docId created docHyperdata isFav)) -< ()
 160     returnA -< node
 161
 162