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.Text (Text, splitOn)
  34 import Gargantext.Core.Types
  35 import Gargantext.Database.Admin.Types.Node (pgNodeId)
  36 import Gargantext.Database.Admin.Config (nodeTypeId)
  37 import Gargantext.Database.Admin.Types.Node (CorpusId, DocId)
  38 import Gargantext.Database.Admin.Utils
  39 import Gargantext.Database.Schema.Node
  40 import Gargantext.Database.Schema.Prelude
  41 import Gargantext.Prelude
  42 import Opaleye
  43 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
  44 import qualified Opaleye as O
  45
  46
  47 data NodeNodePoly node1_id node2_id score cat
  48                    = NodeNode { _nn_node1_id   :: !node1_id
  49                               , _nn_node2_id   :: !node2_id
  50                               , _nn_score      :: !score
  51                               , _nn_category   :: !cat
  52                               } deriving (Show)
  53
  54 type NodeNodeWrite     = NodeNodePoly (Column (PGInt4))
  55                                       (Column (PGInt4))
  56                                       (Maybe  (Column (PGFloat8)))
  57                                       (Maybe  (Column (PGInt4)))
  58
  59 type NodeNodeRead      = NodeNodePoly (Column (PGInt4))
  60                                       (Column (PGInt4))
  61                                       (Column (PGFloat8))
  62                                       (Column (PGInt4))
  63
  64 type NodeNodeReadNull  = NodeNodePoly (Column (Nullable PGInt4))
  65                                       (Column (Nullable PGInt4))
  66                                       (Column (Nullable PGFloat8))
  67                                       (Column (Nullable PGInt4))
  68
  69 type NodeNode = NodeNodePoly NodeId NodeId (Maybe Double) (Maybe Int)
  70
  71 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
  72 makeLenses ''NodeNodePoly
  73
  74 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
  75 nodeNodeTable  = Table "nodes_nodes" (pNodeNode
  76                                 NodeNode { _nn_node1_id = required "node1_id"
  77                                          , _nn_node2_id = required "node2_id"
  78                                          , _nn_score    = optional "score"
  79                                          , _nn_category = optional "category"
  80                                      }
  81                                      )
  82
  83 queryNodeNodeTable :: Query NodeNodeRead
  84 queryNodeNodeTable = queryTable nodeNodeTable
  85
  86
  87 -- | not optimized (get all ngrams without filters)
  88 nodesNodes :: Cmd err [NodeNode]
  89 nodesNodes = runOpaQuery queryNodeNodeTable
  90
  91 instance QueryRunnerColumnDefault (Nullable PGInt4)   Int            where
  92     queryRunnerColumnDefault = fieldQueryRunnerColumn
  93
  94 instance QueryRunnerColumnDefault (Nullable PGFloat8) Int            where
  95     queryRunnerColumnDefault = fieldQueryRunnerColumn
  96
  97 instance QueryRunnerColumnDefault (Nullable PGFloat8) Double         where
  98     queryRunnerColumnDefault = fieldQueryRunnerColumn
  99
 100 instance QueryRunnerColumnDefault PGFloat8            (Maybe Double) where
 101     queryRunnerColumnDefault = fieldQueryRunnerColumn
 102
 103 instance QueryRunnerColumnDefault PGInt4              (Maybe Int)    where
 104     queryRunnerColumnDefault = fieldQueryRunnerColumn
 105