[CLEAN] renaming unexplicit fun
[gargantext.git] / src / Gargantext / Database / Schema / NodeNode.hs
index eaae8249eb0d0130ad5e34159c052ff7e6a37c27..f2c0b15173da16c52b492efcd2442e5f130fac0c 100644 (file)
@@ -14,149 +14,67 @@ commentary with @some markup@.
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-# LANGUAGE Arrows                 #-}
-{-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE QuasiQuotes            #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE NoImplicitPrelude      #-}
-{-# LANGUAGE OverloadedStrings      #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
 module Gargantext.Database.Schema.NodeNode where
 
-import qualified Database.PostgreSQL.Simple as PGS (Connection, Query, query, Only(..))
-import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
-import Database.PostgreSQL.Simple.SqlQQ (sql)
-import Control.Lens.TH (makeLensesWith, abbreviatedFields)
-import Data.Maybe (Maybe)
-import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
-import Gargantext.Database.Schema.Node (Cmd(..), mkCmd)
-import Gargantext.Core.Types.Main (CorpusId, DocId)
+import Gargantext.Core.Types
+import Gargantext.Database.Schema.Prelude
 import Gargantext.Prelude
-import Opaleye
 
 
-data NodeNodePoly node1_id node2_id score fav del
-                   = NodeNode { nodeNode_node1_id   :: node1_id
-                              , nodeNode_node2_id   :: node2_id
-                              , nodeNode_score :: score
-                              , nodeNode_favorite :: fav
-                              , nodeNode_delete   :: del
+data NodeNodePoly node1_id node2_id score cat
+                   = NodeNode { _nn_node1_id   :: !node1_id
+                              , _nn_node2_id   :: !node2_id
+                              , _nn_score      :: !score
+                              , _nn_category   :: !cat
                               } deriving (Show)
 
 type NodeNodeWrite     = NodeNodePoly (Column (PGInt4))
                                       (Column (PGInt4))
                                       (Maybe  (Column (PGFloat8)))
-                                      (Maybe  (Column (PGBool)))
-                                      (Maybe  (Column (PGBool)))
+                                      (Maybe  (Column (PGInt4)))
 
 type NodeNodeRead      = NodeNodePoly (Column (PGInt4))
                                       (Column (PGInt4))
                                       (Column (PGFloat8))
-                                      (Column (PGBool))
-                                      (Column (PGBool))
-                                      
+                                      (Column (PGInt4))
+
 type NodeNodeReadNull  = NodeNodePoly (Column (Nullable PGInt4))
                                       (Column (Nullable PGInt4))
                                       (Column (Nullable PGFloat8))
-                                      (Column (Nullable PGBool))
-                                      (Column (Nullable PGBool))
+                                      (Column (Nullable PGInt4))
 
-type NodeNode = NodeNodePoly Int Int (Maybe Double) (Maybe Bool) (Maybe Bool)
+type NodeNode = NodeNodePoly NodeId NodeId (Maybe Double) (Maybe Int)
 
 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
-$(makeLensesWith abbreviatedFields   ''NodeNodePoly)
+makeLenses ''NodeNodePoly
 
 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
-nodeNodeTable  = Table "nodes_nodes" (pNodeNode
-                                NodeNode { nodeNode_node1_id = required "node1_id"
-                                         , nodeNode_node2_id = required "node2_id"
-                                         , nodeNode_score    = optional "score"
-                                         , nodeNode_favorite = optional "favorite"
-                                         , nodeNode_delete   = optional "delete"
-                                     }
-                                     )
-
-queryNodeNodeTable :: Query NodeNodeRead
-queryNodeNodeTable = queryTable nodeNodeTable
-
-
--- | not optimized (get all ngrams without filters)
-nodesNodes :: Cmd [NodeNode]
-nodesNodes = mkCmd $ \c -> runQuery c queryNodeNodeTable
-
-instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
+nodeNodeTable  =
+  Table "nodes_nodes"
+         ( pNodeNode
+           NodeNode { _nn_node1_id = required "node1_id"
+                    , _nn_node2_id = required "node2_id"
+                    , _nn_score    = optional "score"
+                    , _nn_category = optional "category"
+                    }
+                )
+
+instance QueryRunnerColumnDefault (Nullable PGInt4)   Int            where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
+instance QueryRunnerColumnDefault (Nullable PGFloat8) Int            where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGBool (Maybe Bool) where
+instance QueryRunnerColumnDefault (Nullable PGFloat8) Double         where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
+instance QueryRunnerColumnDefault PGFloat8            (Maybe Double) where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-------------------------------------------------------------------------
--- | Favorite management
-nodeToFavorite :: PGS.Connection -> CorpusId -> DocId -> Bool -> IO [Int]
-nodeToFavorite c cId dId b = map (\(PGS.Only a) -> a) <$> PGS.query c favQuery (b,cId,dId)
-  where
-    favQuery :: PGS.Query
-    favQuery = [sql|UPDATE nodes_nodes SET favorite = ?
-               WHERE node1_id = ? AND node2_id = ?
-               RETURNING node2_id;
-               |]
-
-nodesToFavorite :: PGS.Connection -> [(CorpusId,DocId,Bool)] -> IO [Int]
-nodesToFavorite c inputData = map (\(PGS.Only a) -> a) 
-                            <$> PGS.query c trashQuery (PGS.Only $ Values fields inputData)
-  where
-    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
-    trashQuery :: PGS.Query
-    trashQuery = [sql| UPDATE nodes_nodes as old SET
-                 favorite = new.favorite
-                 from (?) as new(node1_id,node2_id,favorite)
-                 WHERE old.node1_id = new.node1_id
-                 AND   old.node2_id = new.node2_id
-                 RETURNING new.node2_id
-                  |]
-
-------------------------------------------------------------------------
-------------------------------------------------------------------------
--- | Trash management
-nodeToTrash :: PGS.Connection -> CorpusId -> DocId -> Bool -> IO [PGS.Only Int]
-nodeToTrash c cId dId b = PGS.query c trashQuery (b,cId,dId)
-  where
-    trashQuery :: PGS.Query
-    trashQuery = [sql|UPDATE nodes_nodes SET delete = ?
-                  WHERE node1_id = ? AND node2_id = ?
-                  RETURNING node2_id
-                  |]
-
--- | Trash Massive
-nodesToTrash :: PGS.Connection -> [(CorpusId,DocId,Bool)] -> IO [Int]
-nodesToTrash c input = map (\(PGS.Only a) -> a)
-                        <$> PGS.query c trashQuery (PGS.Only $ Values fields input)
-  where
-    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
-    trashQuery :: PGS.Query
-    trashQuery = [sql| UPDATE nodes_nodes as old SET
-                 delete = new.delete
-                 from (?) as new(node1_id,node2_id,delete)
-                 WHERE old.node1_id = new.node1_id
-                 AND   old.node2_id = new.node2_id
-                 RETURNING new.node2_id
-                  |]
-
--- | /!\ Really remove nodes in the Corpus or Annuaire
-emptyTrash :: PGS.Connection -> CorpusId -> IO [PGS.Only Int]
-emptyTrash c cId = PGS.query c delQuery (PGS.Only cId)
-  where
-    delQuery :: PGS.Query
-    delQuery = [sql|DELETE from nodes_nodes n
-                    WHERE n.node1_id = ?
-                      AND n.delete = true
-                    RETURNING n.node2_id
-                |]
-------------------------------------------------------------------------
-
+instance QueryRunnerColumnDefault PGInt4              (Maybe Int)    where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn