[FIX scores]
[gargantext.git] / src / Gargantext / Database / Node.hs
index 62c6eb70a8602ec7237f98993e43f9534e32f304..dbfb3fc1d5ed60b5b25f0d509756f76ad0cc92a7 100644 (file)
@@ -9,13 +9,15 @@ Portability : POSIX
 -}
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# OPTIONS_GHC -fno-warn-orphans        #-}
+
+{-# LANGUAGE Arrows                 #-}
+{-# LANGUAGE DeriveGeneric          #-}
+{-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE Arrows #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE NoImplicitPrelude      #-}
+{-# LANGUAGE TemplateHaskell        #-}
 
 module Gargantext.Database.Node where
 
@@ -27,8 +29,8 @@ import Database.PostgreSQL.Simple.FromField ( Conversion
                                             )
 import Prelude hiding (null, id, map, sum)
 
-import Gargantext.Types
-import Gargantext.Types.Main (NodeType)
+import Gargantext.Core.Types
+import Gargantext.Core.Types.Node (NodeType)
 import Gargantext.Database.Queries
 import Gargantext.Prelude hiding (sum)
 
@@ -43,7 +45,7 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Data.Typeable (Typeable)
 import qualified Data.ByteString.Internal as DBI
 import Database.PostgreSQL.Simple (Connection)
-import Opaleye
+import Opaleye hiding (FromField)
 
 -- | Types for Node Database Management
 data PGTSVector
@@ -118,7 +120,8 @@ runGetNodes = runQuery
 
 -- | order by publication date
 -- Favorites (Bool), node_ngrams
-selectNodesWith :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query NodeRead
+selectNodesWith :: ParentId     -> Maybe NodeType
+                -> Maybe Offset -> Maybe Limit   -> Query NodeRead
 selectNodesWith parentId maybeNodeType maybeOffset maybeLimit = 
         --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
         limit' maybeLimit $ offset' maybeOffset $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
@@ -149,16 +152,16 @@ deleteNodes conn ns = fromIntegral
                    (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
 
 
-getNodesWith :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node Value]
+getNodesWith :: Connection   -> Int         -> Maybe NodeType 
+             -> Maybe Offset -> Maybe Limit -> IO [Node HyperdataDocument]
 getNodesWith conn parentId nodeType maybeOffset maybeLimit = 
     runQuery conn $ selectNodesWith 
                   parentId nodeType maybeOffset maybeLimit
 
 
-
-
 -- NP check type
-getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
+getNodesWithParentId :: Connection -> Int 
+                     -> Maybe Text -> IO [Node HyperdataDocument]
 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
 
 selectNodesWithParentID :: Int -> Query NodeRead
@@ -172,18 +175,17 @@ selectNodesWithParentID n = proc () -> do
     returnA -< row
 
 
-
 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 selectNodesWithType type_id = proc () -> do
     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
     restrict -< tn .== type_id
     returnA -< row
 
-getNode :: Connection -> Int -> IO (Node Value)
+getNode :: Connection -> Int -> IO (Node HyperdataDocument)
 getNode conn id = do
     fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
 
-getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
+getNodesWithType :: Connection -> Column PGInt4 -> IO [Node HyperdataDocument]
 getNodesWithType conn type_id = do
     runQuery conn $ selectNodesWithType type_id