src/Gargantext/Database/Schema/NodeNode.hs

   1 {-|
   2 Module      : Gargantext.Database.Schema.NodeNode
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Here is a longer description of this module, containing some
  11 commentary with @some markup@.
  12 -}
  13
  14 {-# OPTIONS_GHC -fno-warn-orphans #-}
  15
  16 {-# LANGUAGE Arrows                 #-}
  17 {-# LANGUAGE FlexibleContexts       #-}
  18 {-# LANGUAGE FlexibleInstances      #-}
  19 {-# LANGUAGE FunctionalDependencies #-}
  20 {-# LANGUAGE QuasiQuotes            #-}
  21 {-# LANGUAGE MultiParamTypeClasses  #-}
  22 {-# LANGUAGE NoImplicitPrelude      #-}
  23 {-# LANGUAGE OverloadedStrings      #-}
  24 {-# LANGUAGE RankNTypes             #-}
  25 {-# LANGUAGE TemplateHaskell        #-}
  26
  27 module Gargantext.Database.Schema.NodeNode where
  28
  29 import Control.Arrow (returnA)
  30 import Control.Lens (view, (^.))
  31 import Control.Lens.TH (makeLenses)
  32 import Data.Maybe (Maybe, catMaybes)
  33 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  34 import Data.Text (Text, splitOn)
  35 import Database.PostgreSQL.Simple.SqlQQ (sql)
  36 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  37 import Gargantext.Core.Types
  38 import Gargantext.Database.Admin.Types.Node (pgNodeId)
  39 import Gargantext.Database.Admin.Config (nodeTypeId)
  40 import Gargantext.Database.Admin.Types.Node (CorpusId, DocId)
  41 import Gargantext.Database.Admin.Utils
  42 import Gargantext.Database.Schema.Node
  43 import Gargantext.Prelude
  44 import Opaleye
  45 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
  46 import qualified Opaleye as O
  47
  48
  49 data NodeNodePoly node1_id node2_id score cat
  50                    = NodeNode { _nn_node1_id   :: !node1_id
  51                               , _nn_node2_id   :: !node2_id
  52                               , _nn_score      :: !score
  53                               , _nn_category   :: !cat
  54                               } deriving (Show)
  55
  56 type NodeNodeWrite     = NodeNodePoly (Column (PGInt4))
  57                                       (Column (PGInt4))
  58                                       (Maybe  (Column (PGFloat8)))
  59                                       (Maybe  (Column (PGInt4)))
  60
  61 type NodeNodeRead      = NodeNodePoly (Column (PGInt4))
  62                                       (Column (PGInt4))
  63                                       (Column (PGFloat8))
  64                                       (Column (PGInt4))
  65
  66 type NodeNodeReadNull  = NodeNodePoly (Column (Nullable PGInt4))
  67                                       (Column (Nullable PGInt4))
  68                                       (Column (Nullable PGFloat8))
  69                                       (Column (Nullable PGInt4))
  70
  71 type NodeNode = NodeNodePoly NodeId NodeId (Maybe Double) (Maybe Int)
  72
  73 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
  74 makeLenses ''NodeNodePoly
  75
  76 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
  77 nodeNodeTable  = Table "nodes_nodes" (pNodeNode
  78                                 NodeNode { _nn_node1_id = required "node1_id"
  79                                          , _nn_node2_id = required "node2_id"
  80                                          , _nn_score    = optional "score"
  81                                          , _nn_category = optional "category"
  82                                      }
  83                                      )
  84
  85 queryNodeNodeTable :: Query NodeNodeRead
  86 queryNodeNodeTable = queryTable nodeNodeTable
  87
  88
  89 -- | not optimized (get all ngrams without filters)
  90 nodesNodes :: Cmd err [NodeNode]
  91 nodesNodes = runOpaQuery queryNodeNodeTable
  92
  93 instance QueryRunnerColumnDefault (Nullable PGInt4)   Int            where
  94     queryRunnerColumnDefault = fieldQueryRunnerColumn
  95
  96 instance QueryRunnerColumnDefault (Nullable PGFloat8) Int            where
  97     queryRunnerColumnDefault = fieldQueryRunnerColumn
  98
  99 instance QueryRunnerColumnDefault (Nullable PGFloat8) Double         where
 100     queryRunnerColumnDefault = fieldQueryRunnerColumn
 101
 102 instance QueryRunnerColumnDefault PGFloat8            (Maybe Double) where
 103     queryRunnerColumnDefault = fieldQueryRunnerColumn
 104
 105 instance QueryRunnerColumnDefault PGInt4              (Maybe Int)    where
 106     queryRunnerColumnDefault = fieldQueryRunnerColumn
 107