src/Gargantext/Database/NodeNode.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE MultiParamTypeClasses #-}
   4 {-# LANGUAGE FunctionalDependencies #-}
   5 {-# LANGUAGE Arrows #-}
   6 {-# OPTIONS_GHC -fno-warn-orphans #-}
   7
   8 module Gargantext.Database.NodeNode where
   9
  10 import Prelude
  11 import Data.Maybe (Maybe)
  12 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  13 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  14 import qualified Database.PostgreSQL.Simple as PGS
  15
  16 import Opaleye
  17
  18
  19 data NodeNodePoly node1_id node2_id score
  20                    = NodeNode { nodeNode_node1_id   :: node1_id
  21                               , nodeNode_node2_id   :: node2_id
  22                               , nodeNode_score :: score
  23                               } deriving (Show)
  24
  25 type NodeNodeWrite     = NodeNodePoly (Column (Nullable PGInt4))
  26                                       (Column (PGInt4))
  27                                       (Column (Nullable PGFloat8))
  28
  29 type NodeNodeRead      = NodeNodePoly (Column (Nullable PGInt4))
  30                                       (Column (PGInt4))
  31                                       (Column (Nullable PGFloat8))
  32
  33 type NodeNodeReadNull  = NodeNodePoly (Column (Nullable PGInt4))
  34                                       (Column (Nullable PGInt4))
  35                                       (Column (Nullable PGFloat8))
  36
  37 type NodeNode = NodeNodePoly Int Int (Maybe Double)
  38
  39 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
  40 $(makeLensesWith abbreviatedFields   ''NodeNodePoly)
  41
  42 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
  43 nodeNodeTable  = Table "nodes_nodes" (pNodeNode NodeNode
  44                                          { nodeNode_node1_id = required "node1_id"
  45                                          , nodeNode_node2_id = required "node2_id"
  46                                          , nodeNode_score    = required "score"
  47                                      }
  48                                      )
  49
  50 queryNodeNodeTable :: Query NodeNodeRead
  51 queryNodeNodeTable = queryTable nodeNodeTable
  52
  53
  54 -- | not optimized (get all ngrams without filters)
  55 nodeNodes :: PGS.Connection -> IO [NodeNode]
  56 nodeNodes conn = runQuery conn queryNodeNodeTable
  57
  58 instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
  59     queryRunnerColumnDefault = fieldQueryRunnerColumn
  60
  61 instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
  62     queryRunnerColumnDefault = fieldQueryRunnerColumn
  63
  64