[DBFLOW] /api/v1.0/node/{id}/table ok

package.yaml

@@ -37,7 +37,8 @@ library:
   - Gargantext.Core.Utils.Prefix
   - Gargantext.Database
   - Gargantext.Database.Bashql
-  - Gargantext.Database.Node.Document.Import
+  - Gargantext.Database.Node.Document.Insert
+  - Gargantext.Database.Node.Document.Add
   - Gargantext.Database.Types.Node
   - Gargantext.Database.User
   - Gargantext.Database.Cooc

src/Gargantext/API/Node.hs

@@ -30,12 +30,13 @@ module Gargantext.API.Node
   , HyperdataDocumentV3(..)
   ) where
 -------------------------------------------------------------------
-
+import Prelude (Enum, Bounded, minBound, maxBound)
 import Control.Lens (prism')
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad ((>>))
 --import System.IO (putStrLn, readFile)
 
+import Data.Either(Either(Left))
 import Data.Aeson (FromJSON, ToJSON, Value())
 --import Data.Text (Text(), pack)
 import Data.Text (Text())
@@ -46,7 +47,6 @@ import Database.PostgreSQL.Simple (Connection)
 
 import GHC.Generics (Generic)
 import Servant
--- import Servant.Multipart
 
 import Gargantext.Prelude
 import Gargantext.Database.Types.Node
@@ -55,7 +55,7 @@ import Gargantext.Database.Node ( runCmd
                                 , getNode, getNodesWith
                                 , deleteNode, deleteNodes, mk, JSONB)
 import qualified Gargantext.Database.Node.Update as U (update, Update(..))
-import Gargantext.Database.Facet (FacetDoc {-,getDocFacet-}
+import Gargantext.Database.Facet (FacetDoc , runViewDocuments', OrderBy(..)
                                  ,FacetChart)
 import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
 
@@ -63,6 +63,7 @@ import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
 import Gargantext.TextFlow
 import Gargantext.Viz.Graph (Graph)
 import Gargantext.Core (Lang(..))
+import Gargantext.Core.Types (Offset, Limit)
 import Gargantext.Core.Types.Main (Tree, NodeTree)
 import Gargantext.Text.Terms (TermType(..))
 
@@ -117,21 +118,35 @@ type NodeAPI a = Get '[JSON] (Node a)
                              :> QueryParam "offset" Int
                              :> QueryParam "limit"  Int
                              :> Get '[JSON] [Node a]
-             :<|> "facet" :> Summary " Facet documents"
-                          :> "documents" :> FacetDocAPI
---             :<|> "facet" :<|> "sources"   :<|> FacetSourcesAPI
---             :<|> "facet" :<|> "authors"   :<|> FacetAuthorsAPI
---             :<|> "facet" :<|> "terms"     :<|> FacetTermsAPI
+             :<|> Summary " Tabs" :> FacetDocAPI
 
 --data FacetFormat = Table | Chart
---data FacetType   = Doc   | Term  | Source | Author
---data Facet       = Facet Doc Format
+data FacetType   = Docs   | Terms  | Sources | Authors | Trash
+  deriving (Generic, Enum, Bounded)
 
+instance FromHttpApiData FacetType
+  where
+    parseUrlPiece "Docs" = pure Docs
+    parseUrlPiece "Terms" = pure Terms
+    parseUrlPiece "Sources" = pure Sources
+    parseUrlPiece "Authors" = pure Authors
+    parseUrlPiece "Trash"   = pure Trash
+    parseUrlPiece _         = Left "Unexpected value of FacetType"
+
+instance ToParamSchema   FacetType
+instance ToJSON    FacetType
+instance FromJSON  FacetType
+instance ToSchema  FacetType
+instance Arbitrary FacetType
+  where
+    arbitrary = elements [minBound .. maxBound]
 
 type FacetDocAPI = "table"
                    :> Summary " Table data"
+                   :> QueryParam "view"   FacetType
                    :> QueryParam "offset" Int
                    :> QueryParam "limit"  Int
+                   :> QueryParam "order"  OrderBy
                    :> Get '[JSON] [FacetDoc]
 
                 :<|> "chart"
@@ -183,7 +198,7 @@ nodeAPI conn p id
               :<|> putNode       conn id
               :<|> deleteNode'   conn id
               :<|> getNodesWith' conn id p
-              :<|> getFacet      conn id
+              :<|> getTable      conn id
               :<|> getChart      conn id
               -- :<|> upload
               -- :<|> query
@@ -195,6 +210,15 @@ rename c nId (RenameNode name) = liftIO $ U.update (U.Rename nId name) c
 nodesAPI :: Connection -> [NodeId] -> Server NodesAPI
 nodesAPI conn ids = deleteNodes' conn ids
 
+getTable :: Connection -> NodeId -> Maybe FacetType -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Handler [FacetDoc]
+getTable c cId ft o l order = liftIO $ case ft of
+                                (Just Docs)  -> runViewDocuments' c cId False o l order
+                                (Just Trash) -> runViewDocuments' c cId True  o l order
+                                _     -> panic "not implemented"
+
+
+
+
 postNode :: Connection -> NodeId -> PostNode -> Handler [Int]
 postNode c pId (PostNode name nt) = liftIO $ mk c nt (Just pId) name
 
@@ -212,10 +236,6 @@ getNodesWith' :: JSONB a => Connection -> NodeId -> proxy a -> Maybe NodeType
 getNodesWith' conn id p nodeType offset limit  = liftIO (getNodesWith conn id p nodeType offset limit)
 
 
-getFacet :: Connection -> NodeId -> Maybe Int -> Maybe Int
-                        -> Handler [FacetDoc]
-getFacet conn id offset limit = undefined -- liftIO (putStrLn ( "/facet" :: Text)) >> liftIO (getDocFacet conn NodeCorpus id (Just NodeDocument) offset limit)
-
 getChart :: Connection -> NodeId -> Maybe UTCTime -> Maybe UTCTime
                         -> Handler [FacetChart]
 getChart _ _ _ _ = undefined -- TODO

src/Gargantext/Database/Facet.hs

@@ -11,6 +11,7 @@ Portability : POSIX
 {-# OPTIONS_GHC -fno-warn-orphans        #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
+
 {-# LANGUAGE Arrows                    #-}
 {-# LANGUAGE DeriveGeneric             #-}
 {-# LANGUAGE FlexibleContexts          #-}
@@ -19,41 +20,41 @@ Portability : POSIX
 {-# LANGUAGE MultiParamTypeClasses     #-}
 {-# LANGUAGE NoImplicitPrelude         #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE TemplateHaskell           #-}
-
 ------------------------------------------------------------------------
 module Gargantext.Database.Facet 
   where
 ------------------------------------------------------------------------
 
-import Prelude hiding (null, id, map, sum, not)
+import Prelude hiding (null, id, map, sum, not, read)
+import Prelude (Enum, Bounded, minBound, maxBound)
 import GHC.Generics (Generic)
 
--- import Data.Aeson (Value)
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Either(Either(Left))
 import Control.Arrow (returnA)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
 
 import Data.Aeson.TH (deriveJSON)
 import Data.Maybe (Maybe)
-import Data.Profunctor.Product.Default (Default)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
+import Data.Text (Text)
 import Data.Time (UTCTime)
 import Data.Time.Segment (jour)
 import Data.Swagger
 
 import Database.PostgreSQL.Simple (Connection)
 import           Opaleye
-import           Opaleye.Internal.Join (NullMaker)
 import qualified Opaleye.Internal.Unpackspec()
 
+import Servant.API
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck (elements)
 
 import Gargantext.Core.Types
-import Gargantext.Database.Types.Node (NodeType)
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.NodeNode
-import Gargantext.Database.NodeNodeNgram
 import Gargantext.Database.Node
 import Gargantext.Database.Queries
 import Gargantext.Database.Config (nodeTypeId)
@@ -68,17 +69,19 @@ import Gargantext.Database.Config (nodeTypeId)
 --instance ToJSON   Facet
 
 type Favorite = Bool
+type Title    = Text
 
-type FacetDoc = Facet NodeId UTCTime HyperdataDocument Favorite Int
+type FacetDoc = Facet NodeId UTCTime Title HyperdataDocument Favorite Int
 type FacetSources = FacetDoc
 type FacetAuthors = FacetDoc
 type FacetTerms   = FacetDoc
 
 
 
-data Facet id created hyperdata favorite ngramCount = 
+data Facet id created title hyperdata favorite ngramCount = 
      FacetDoc { facetDoc_id         :: id
               , facetDoc_created    :: created
+              , facetDoc_title      :: title
               , facetDoc_hyperdata  :: hyperdata
               , facetDoc_favorite   :: favorite
               , facetDoc_ngramCount :: ngramCount
@@ -94,9 +97,10 @@ instance ToSchema FacetDoc
 -- | Mock and Quickcheck instances
 
 instance Arbitrary FacetDoc where
-    arbitrary = elements [ FacetDoc id' (jour year 01 01) hp fav ngramCount
+    arbitrary = elements [ FacetDoc id' (jour year 01 01) t hp fav ngramCount
                          | id'  <- [1..10]
                          , year <- [1990..2000]
+                         , t    <- ["title", "another title"]
                          , hp   <- hyperdataDocuments
                          , fav  <- [True, False]
                          , ngramCount <- [3..100]
@@ -109,6 +113,7 @@ $(makeLensesWith abbreviatedFields   ''Facet)
 
 type FacetDocRead = Facet (Column PGInt4       )
                           (Column PGTimestamptz)
+                          (Column PGText       )
                           (Column PGJsonb      )
                           (Column PGBool)
                           (Column PGInt4       )
@@ -128,8 +133,28 @@ instance Arbitrary FacetChart where
 -----------------------------------------------------------------------
 type Trash   = Bool
 data OrderBy =  DateAsc | DateDesc
-       --      | TitleAsc | TitleDesc 
-             | FavDesc  | FavAsc -- | NgramCount
+             | TitleAsc | TitleDesc
+             | FavDesc  | FavAsc
+             deriving (Generic, Enum, Bounded, Read, Show)
+             -- | NgramCoun
+
+instance FromHttpApiData OrderBy
+  where
+    parseUrlPiece "DateAsc"  = pure DateAsc
+    parseUrlPiece "DateDesc" = pure DateDesc
+    parseUrlPiece "TitleAsc" = pure TitleAsc
+    parseUrlPiece "TitleDesc" = pure TitleDesc
+    parseUrlPiece "FavAsc"   = pure FavAsc
+    parseUrlPiece "FavDesc"   = pure FavDesc
+    parseUrlPiece _           = Left "Unexpected value of OrderBy"
+
+instance ToParamSchema OrderBy
+instance FromJSON  OrderBy
+instance ToJSON    OrderBy
+instance ToSchema  OrderBy
+instance Arbitrary OrderBy
+  where
+    arbitrary = elements [minBound..maxBound]
 
 viewDocuments :: CorpusId -> Trash -> NodeTypeId -> Query FacetDocRead
 viewDocuments cId t ntId = proc () -> do
@@ -139,35 +164,41 @@ viewDocuments cId t ntId = proc () -> do
   restrict -< nodeNode_node1_id nn .== (pgInt4 cId)
   restrict -< _node_typename    n  .== (pgInt4 ntId)
   restrict -< nodeNode_delete   nn .== (pgBool t)
-  returnA  -< FacetDoc (_node_id n) (_node_date n) (_node_hyperdata n) (nodeNode_favorite nn) (pgInt4 1)
+  returnA  -< FacetDoc (_node_id n) (_node_date n) (_node_name n) (_node_hyperdata n) (nodeNode_favorite nn) (pgInt4 1)
 
 
-filterDocuments :: (PGOrd date, PGOrd favorite) =>
+filterDocuments :: (PGOrd date, PGOrd title, PGOrd favorite) =>
      Maybe Gargantext.Core.Types.Offset
      -> Maybe Gargantext.Core.Types.Limit
-     -> OrderBy
-     -> Select (Facet id (Column date) hyperdata (Column favorite) ngramCount)
-     -> Query  (Facet id (Column date) hyperdata (Column favorite) ngramCount)
+     -> Maybe OrderBy
+     -> Select (Facet id (Column date) (Column title) hyperdata (Column favorite) ngramCount)
+     -> Query  (Facet id (Column date) (Column title) hyperdata (Column favorite) ngramCount)
 filterDocuments o l order q = limit' l $ offset' o $ orderBy ordering q
   where
     ordering = case order of
-      DateAsc   -> asc  facetDoc_created
-      DateDesc  -> desc facetDoc_created
+      (Just DateAsc)   -> asc  facetDoc_created
+      
+      (Just TitleAsc)  -> asc  facetDoc_title
+      (Just TitleDesc) -> desc facetDoc_title
       
-      --TitleAsc  -> asc  facetDoc_hyperdata
-      --TitleDesc -> desc facetDoc_hyperdata
+      (Just FavAsc)    -> asc  facetDoc_favorite
+      (Just FavDesc)   -> desc facetDoc_favorite
+      _                -> desc facetDoc_created
 
-      FavAsc    -> asc  facetDoc_favorite
-      FavDesc   -> desc facetDoc_favorite
 
+runViewDocuments :: CorpusId -> Trash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd [FacetDoc]
+runViewDocuments cId t o l order = mkCmd $ \c -> runViewDocuments' c cId t o l order
 
-runViewDocuments :: CorpusId -> Trash -> Maybe Offset -> Maybe Limit -> OrderBy -> Cmd [FacetDoc]
-runViewDocuments cId t o l order = mkCmd $ \c -> runQuery c ( filterDocuments o l order
+-- | TODO use only Cmd with Reader and delete function below
+runViewDocuments' :: Connection -> CorpusId -> Trash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> IO [FacetDoc]
+runViewDocuments' c cId t o l order = runQuery c ( filterDocuments o l order
                                                 $ viewDocuments cId t ntId)
   where
     ntId = nodeTypeId NodeDocument
 
 
+
+
 {-
 getDocFacet :: Connection -> NodeType -> Int -> Maybe NodeType 
             -> Maybe Offset -> Maybe Limit

src/Gargantext/Database/Flow.hs

@@ -24,12 +24,11 @@ authors
 module Gargantext.Database.Flow
     where
 import System.FilePath (FilePath)
-import GHC.Base ((>>))
 import Data.Maybe (Maybe(..))
 import Gargantext.Core.Types (NodePoly(..))
 import Gargantext.Prelude
 import Gargantext.Database.Bashql (runCmd', del)
-import Gargantext.Database.Node (Cmd(..), getRoot, mkRoot, mkCorpus)
+import Gargantext.Database.Node (getRoot, mkRoot, mkCorpus)
 import Gargantext.Database.User (getUser, UserLight(..), Username)
 import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(reId))
 import Gargantext.Database.Node.Document.Add    (add)
@@ -64,7 +63,7 @@ subFlow username = do
   pure (userId, rootId, corpusId)
 
 
--- flow :: FilePath -> IO ()
+flow :: FilePath -> IO Int
 flow fp = do
 
   (masterUserId, _, corpusId) <- subFlow "gargantua"
@@ -76,18 +75,10 @@ flow fp = do
   idsRepeat  <- runCmd' $ insertDocuments masterUserId corpusId docs
   printDebug "Docs IDs : " idsRepeat
   
-  (userId, rootId, corpusId2) <- subFlow "alexandre"
+  (_, _, corpusId2) <- subFlow "alexandre"
 
   inserted <- runCmd' $ add corpusId2 (map reId ids)
   printDebug "Inserted : " inserted
 
-  -- runCmd' (del [corpusId2, corpusId])
-
-{-
-  ids  <- add (Documents corpusId) docs
-
-  user_id <- runCmd' (get RootUser "alexandre")
-  rootUser_id <- runCmd' (getRootUser $ userLight_id user_id
-  corpusId <- mk Corpus 
--}
+  runCmd' (del [corpusId2, corpusId])
 

src/Gargantext/Database/Node/Document/Add.hs

@@ -20,25 +20,18 @@ Add Documents/Contact to a Corpus/Annuaire.
 ------------------------------------------------------------------------
 module Gargantext.Database.Node.Document.Add where
 
-import Control.Lens (set)
 
-import Data.Aeson (toJSON, Value)
 import Data.ByteString.Internal (ByteString)
-import Data.Maybe (maybe)
 import Data.Typeable (Typeable)
-import Database.PostgreSQL.Simple (Connection, FromRow, Query, formatQuery, query, Only(..))
-import Database.PostgreSQL.Simple.FromRow (fromRow, field)
+import Database.PostgreSQL.Simple (Query, formatQuery, query, Only(..))
 import Database.PostgreSQL.Simple.SqlQQ
 import Database.PostgreSQL.Simple.ToField (toField)
 import Database.PostgreSQL.Simple.ToRow (ToRow(..))
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 
 import Data.Text (Text)
-import qualified Data.Text                   as DT (pack, unpack, concat)
-import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
-import qualified Data.ByteString.Lazy.Char8  as DC (pack)
+import qualified Data.Text                   as DT (pack)
 
-import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Node (mkCmd, Cmd(..))
 import Gargantext.Database.Types.Node
 import Gargantext.Prelude

src/Gargantext/Database/Node/Document/Insert.hs

@@ -49,11 +49,12 @@ the concatenation of the parameters defined by @hashParameters@.
 
 -}
 ------------------------------------------------------------------------
+{-# LANGUAGE DeriveDataTypeable   #-}
 {-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE NoImplicitPrelude    #-}
+{-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE QuasiQuotes          #-}
-{-# LANGUAGE DeriveDataTypeable   #-}
-{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 ------------------------------------------------------------------------
 module Gargantext.Database.Node.Document.Insert where
@@ -64,7 +65,7 @@ import Data.Aeson (toJSON, Value)
 import Data.ByteString.Internal (ByteString)
 import Data.Maybe (maybe)
 import Data.Typeable (Typeable)
-import Database.PostgreSQL.Simple (Connection, FromRow, Query, formatQuery, query, Only(..))
+import Database.PostgreSQL.Simple (FromRow, Query, formatQuery, query, Only(..))
 import Database.PostgreSQL.Simple.FromRow (fromRow, field)
 import Database.PostgreSQL.Simple.SqlQQ
 import Database.PostgreSQL.Simple.ToField (toField)
@@ -149,7 +150,9 @@ queryInsert = [sql|
            |]
 
 prepare :: UserId -> ParentId -> [HyperdataDocument] -> [InputData]
-prepare uId pId = map (\h -> InputData tId uId pId (DT.pack "Doc") (toJSON $ addUniqId h))
+prepare uId pId = map (\h -> InputData tId uId pId (maybe "No Title of Document" identity $ _hyperdataDocument_title h) 
+                                                   (toJSON $ addUniqId h)
+                      )
   where
     tId  = nodeTypeId NodeDocument
 
@@ -192,15 +195,6 @@ instance ToRow InputData where
 ---------------------------------------------------------------------------
 -- * Uniqueness of document definition
 
-hashParameters :: [(HyperdataDocument -> Text)]
-hashParameters = [ \d -> maybe' (_hyperdataDocument_title    d)
-                 , \d -> maybe' (_hyperdataDocument_abstract d)
-                 , \d -> maybe' (_hyperdataDocument_source   d)
-                 , \d -> maybe' (_hyperdataDocument_publication_date   d)
-                 ]
-
-maybe' = maybe (DT.pack "") identity
-
 addUniqId :: HyperdataDocument -> HyperdataDocument
 addUniqId doc = set hyperdataDocument_uniqIdBdd (Just hashBdd)
               $ set hyperdataDocument_uniqId    (Just hash) doc
@@ -211,5 +205,16 @@ addUniqId doc = set hyperdataDocument_uniqIdBdd (Just hashBdd)
     uniqId :: Text -> Text
     uniqId = DT.pack . SHA.showDigest . SHA.sha256 . DC.pack . DT.unpack
 
+
+hashParameters :: [(HyperdataDocument -> Text)]
+hashParameters = [ \d -> maybe' (_hyperdataDocument_title    d)
+                 , \d -> maybe' (_hyperdataDocument_abstract d)
+                 , \d -> maybe' (_hyperdataDocument_source   d)
+                 , \d -> maybe' (_hyperdataDocument_publication_date   d)
+                 ]
+
+maybe' :: Maybe Text -> Text
+maybe' = maybe (DT.pack "") identity
+
 ---------------------------------------------------------------------------
 

src/Gargantext/Database/NodeNode.hs

@@ -27,7 +27,6 @@ import Gargantext.Prelude
 import Data.Maybe (Maybe)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
-import qualified Database.PostgreSQL.Simple as PGS
 
 import Opaleye