[REST] Document View route.

src/Gargantext/API.hs

@@ -34,6 +34,8 @@ import Gargantext.API.Node (Roots, roots, NodeAPI, nodeAPI)
 
 import Gargantext.Database.Private (databaseParameters)
 
+
+
 -- | startGargantext takes as parameters port number and Ini file.
 startGargantext :: Int -> FilePath -> IO ()
 startGargantext port file = do
@@ -46,6 +48,7 @@ startGargantext port file = do
 -- | Main routes of the API are typed
 type API =  "roots"  :> Roots
        :<|> "node"   :> Capture "id" Int            :> NodeAPI
+       -- :<|> "static"   
        -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
        -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
        -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI

src/Gargantext/API/Node.hs

@@ -25,37 +25,51 @@ import Servant
 import Servant.Multipart
 import System.IO (putStrLn, readFile)
 import Data.Text (Text(), pack)
-
 import Database.PostgreSQL.Simple (Connection)
-
 import Gargantext.Prelude
-import Gargantext.Types.Main (Node, NodeId)
-import Gargantext.Database.Node (getNodesWithParentId, getNode)
+import Gargantext.Types.Main (Node, NodeId, NodeType)
+import Gargantext.Database.Node (getNodesWithParentId, getNode, getNodesWith)
 
 
 -- | Node API Types management
 type Roots = Get '[JSON] [Node Value]
 
 type NodeAPI   = Get '[JSON] (Node Value)
-             :<|> "children" :> Get '[JSON] [Node Value]
-             :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
+
+                -- Example for Document Facet view, to populate the tabular:
+                -- http://localhost:8008/node/347476/children?type=Document&limit=3
+                -- /!\ FIXME : nodeType is case sensitive
+                -- /!\ see NodeTypes in Types/Main.hs
+             :<|> "children" :> QueryParam "type"   NodeType
+                             :> QueryParam "offset" Int
+                             :> QueryParam "limit"  Int
+                             :> Get '[JSON] [Node Value]
+             
                 -- Depending on the Type of the Node, we could post
                 -- New documents for a corpus
                 -- New map list terms
+             :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
+                
+                -- To launch a query and update the corpus
              :<|> "query"    :> Capture "string" Text       :> Get  '[JSON] Text
-           -- :<|> "children" :> QueryParam "type" Text :> Get '[JSON] [Node Value]
+
 
 
 -- | Node API functions
 roots :: Connection -> Server Roots
-roots conn = liftIO (getNodesWithParentId conn 0)
+roots conn = liftIO (getNodesWithParentId conn 0 Nothing)
 
 nodeAPI :: Connection -> NodeId -> Server NodeAPI
 nodeAPI conn id =  liftIO (getNode              conn id)
-              :<|> liftIO (getNodesWithParentId conn id)
+              :<|> getNodesWith' conn id
               :<|> upload
               :<|> query
 
+getNodesWith' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int 
+                        -> Handler [Node Value]
+getNodesWith' conn id nodeType offset limit  = liftIO (getNodesWith conn id nodeType offset limit)
+
+
 query :: Text -> Handler Text
 query s = pure s
 

src/Gargantext/Database/Node.hs

+{-|
+Module      : Gargantext.Database.Node
+Description : Main requests of Node to the database
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -16,6 +26,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion
                                             , returnError
                                             )
 import Prelude hiding (null, id)
+import Gargantext.Types.Main (NodeType)
 import Database.PostgreSQL.Simple.Internal  (Field)
 import Control.Arrow (returnA)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
@@ -106,21 +117,67 @@ nodeTable = Table "nodes" (pNode Node { node_id                = optional "id"
                             )
 
 
+queryNodeTable :: Query NodeRead
+queryNodeTable = queryTable nodeTable
+
+
 selectNodes :: Column PGInt4 -> Query NodeRead
 selectNodes id = proc () -> do
     row <- queryNodeTable -< ()
     restrict -< node_id row .== id
     returnA -< row
 
-runGetNodes :: Connection -> Query NodeRead -> IO [Document]
+runGetNodes :: Connection -> Query NodeRead -> IO [Node Value]
 runGetNodes = runQuery
 
 
+type ParentId = NodeId
+type Limit    = Int
+type Offset    = Int
+
+-- | order by publication date
+-- Favorites (Bool), node_ngrams
+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
+        offset' maybeOffset $ limit' maybeLimit $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
+
+
+limit' ::  Maybe Limit -> Query NodeRead -> Query NodeRead
+limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
+
+
+offset' :: Maybe Offset -> Query NodeRead  -> Query NodeRead
+offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
+
+
+-- Add order by
+selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
+selectNodesWith' parentId maybeNodeType = proc () -> do
+    node <- (proc () -> do
+            row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
+            restrict -< parentId' .== (toNullable $ pgInt4 parentId)
+            
+            let typeId' = maybe 0 nodeTypeId maybeNodeType
+            
+            restrict -< if typeId' > 0
+                           then typeId   .== (pgInt4 (typeId' :: Int))
+                           else (pgBool True)
+            returnA  -< row ) -< ()
+    returnA -< node
+
+
+--getNodesWith' :: Connection -> Int -> Maybe NodeType -> Maybe Offset' -> Maybe Limit' -> IO [Node Value]
+--getNodesWith' conn parentId maybeNodeType maybeOffset maybeLimit = runQuery conn $ selectNodesWith parentId xxx maybeOffset maybeLimit
+
+
+getNodesWith :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node Value]
+getNodesWith conn parentId nodeType maybeOffset maybeLimit = runQuery conn $ selectNodesWith parentId nodeType maybeOffset maybeLimit
 
 
 -- NP check type
-getNodesWithParentId :: Connection -> Int -> IO [Node Value]
-getNodesWithParentId conn n = runQuery conn $ selectNodesWithParentID n
+getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
+getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
 
 selectNodesWithParentID :: Int -> Query NodeRead
 selectNodesWithParentID n = proc () -> do
@@ -132,9 +189,6 @@ selectNodesWithParentID n = proc () -> do
                         isNull parent_id
     returnA -< row
 
-queryNodeTable :: Query NodeRead
-queryNodeTable = queryTable nodeTable
-
 
 
 
@@ -153,11 +207,3 @@ getNodesWithType conn type_id = do
     runQuery conn $ selectNodesWithType type_id
 
 
--- NP check type
-getCorpusDocument :: Connection -> Int -> IO [Document]
-getCorpusDocument conn n = runQuery conn (selectNodesWithParentID n)
-
--- NP check type
-getProjectCorpora :: Connection -> Int -> IO [Corpus]
-getProjectCorpora conn node_id = do
-    runQuery conn $ selectNodesWithParentID node_id

src/Gargantext/Types/Main.hs

@@ -11,6 +11,7 @@ Here is a longer description of this module, containing some
 commentary with @some markup@.
 -}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveGeneric     #-}
 
 module Gargantext.Types.Main where
 
@@ -19,7 +20,12 @@ import Prelude
 import Data.Eq (Eq())
 import Data.Monoid ((<>))
 import Protolude (fromMaybe)
-
+import Data.Aeson
+import GHC.Generics
+import Servant
+import Data.Text (unpack)
+import Text.Read (read)
+import Data.Either (Either(Right))
 --import Data.ByteString (ByteString())
 import Data.Text (Text)
 import Data.Time (UTCTime)
@@ -87,7 +93,11 @@ data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy
               | Classification
               | Lists
               | Metrics
-              deriving (Show, Read, Eq)
+              deriving (Show, Read, Eq, Generic)
+
+instance FromJSON NodeType
+instance ToJSON NodeType
+instance FromHttpApiData NodeType where parseUrlPiece = Right . read . unpack
 
 data Classification = Favorites | MyClassifcation