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 import Gargantext.Database.Private (infoGargandb)
  19
  20 data NodeNodePoly node1_id node2_id score
  21                    = NodeNode { nodeNode_node1_id   :: node1_id
  22                               , nodeNode_node2_id   :: node2_id
  23                               , nodeNode_score :: score
  24                               } deriving (Show)
  25
  26 type NodeNodeWrite = NodeNodePoly (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8))
  27 type NodeNodeRead  = NodeNodePoly (Column PGInt4) (Column PGInt4) (Column PGFloat8)
  28
  29
  30 type NodeNode = NodeNodePoly Int Int (Maybe Double)
  31
  32 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
  33 $(makeLensesWith abbreviatedFields   ''NodeNodePoly)
  34
  35
  36 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
  37 nodeNodeTable  = Table "nodes_nodes" (pNodeNode NodeNode { nodeNode_node1_id = required "node1_id"
  38                                                            , nodeNode_node2_id = required "node2_id"
  39                                                            , nodeNode_score    = optional "score"
  40                                                            }
  41                                        )
  42
  43
  44 queryNodeNodeTable :: Query NodeNodeRead
  45 queryNodeNodeTable = queryTable nodeNodeTable
  46
  47
  48 -- | not optimized (get all ngrams without filters)
  49 nodeNodes :: IO [NodeNode]
  50 nodeNodes = do
  51     conn <- PGS.connect infoGargandb
  52     runQuery conn queryNodeNodeTable
  53
  54 instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
  55     queryRunnerColumnDefault = fieldQueryRunnerColumn