[VIZ/CHARTS] Histogram by year.

src/Gargantext/API/Metrics.hs

@@ -25,15 +25,19 @@ Metrics API
 module Gargantext.API.Metrics
     where
 
+import Data.Aeson.TH (deriveJSON)
+import Data.Swagger
+import Data.Time (UTCTime)
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Gargantext.Prelude
-import Data.Aeson.TH (deriveJSON)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import Gargantext.Core.Types (ListType(..))
 import Gargantext.Core.Utils.Prefix (unPrefix)
-import Data.Swagger
-
+import Gargantext.Database.Utils
+import Gargantext.Core.Types (CorpusId)
+import Gargantext.Prelude
+import Gargantext.Viz.Chart
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 data Metrics = Metrics
   { metrics_data :: [Metric]}
@@ -63,3 +67,46 @@ deriveJSON (unPrefix "metrics_") ''Metrics
 deriveJSON (unPrefix "m_") ''Metric
 
 
+-------------------------------------------------------------
+
+data ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
+  deriving (Generic, Show)
+
+instance (ToSchema a) => ToSchema (ChartMetrics a)
+instance (Arbitrary a) => Arbitrary (ChartMetrics a)
+  where
+    arbitrary = ChartMetrics <$> arbitrary
+
+deriveJSON (unPrefix "chartMetrics_") ''ChartMetrics
+
+-------------------------------------------------------------
+instance ToSchema Histo
+instance Arbitrary Histo
+  where
+    arbitrary = elements [ Histo ["2012"] [1]
+                         , Histo ["2013"] [1]
+                         ]
+deriveJSON (unPrefix "histo_") ''Histo
+
+
+-- TODO add start / end
+getChart :: CorpusId -> Maybe UTCTime -> Maybe UTCTime -> Cmd err (ChartMetrics Histo)
+getChart cId _start _end = do
+  h <- histoData cId
+  pure (ChartMetrics h)
+
+
+
+{-
+data FacetChart = FacetChart { facetChart_time  :: UTCTime'
+                             , facetChart_count :: Double
+                        }
+        deriving (Show, Generic)
+$(deriveJSON (unPrefix "facetChart_") ''FacetChart)
+instance ToSchema FacetChart
+
+instance Arbitrary FacetChart where
+    arbitrary = FacetChart <$> arbitrary <*> arbitrary
+
+-}
+

src/Gargantext/API/Node.hs

@@ -50,7 +50,7 @@ import Gargantext.API.Search ( SearchAPI, searchIn, SearchInQuery)
 import Gargantext.API.Types
 import Gargantext.Core.Types (Offset, Limit)
 import Gargantext.Core.Types.Main (Tree, NodeTree)
-import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),FacetChart,runViewAuthorsDoc)
+import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),runViewAuthorsDoc)
 import Gargantext.Database.Node.Children (getChildren)
 import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, NodeError(..), HasNodeError(..))
 import Gargantext.Database.Schema.NodeNode (nodesToFavorite, nodesToTrash)
@@ -60,6 +60,7 @@ import Gargantext.Database.Utils -- (Cmd, CmdM)
 import Gargantext.Prelude
 import Gargantext.Text.Metrics (Scored(..))
 import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI)
+import Gargantext.Viz.Chart
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
@@ -124,9 +125,6 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "listGet"   :> TableNgramsApiGet
              :<|> "pairing"   :> PairingApi
              
-             -- VIZ
-             :<|> "chart"     :> ChartApi
-             :<|> "phylo"     :> PhyloAPI
              
              :<|> "favorites" :> FavApi
              :<|> "documents" :> DocsApi
@@ -136,7 +134,11 @@ type NodeAPI a = Get '[JSON] (Node a)
                         :> QueryParam "limit"  Int
                         :> QueryParam "order"  OrderBy
                         :> SearchAPI
-            :<|> "metrics" :> MetricsAPI
+             
+             -- VIZ
+             :<|> "metrics" :> MetricsAPI
+             :<|> "chart"     :> ChartApi
+             :<|> "phylo"     :> PhyloAPI
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
@@ -169,14 +171,14 @@ nodeAPI p uId id
            :<|> tableNgramsPatch id
            :<|> getTableNgrams   id
            :<|> getPairing       id
-
-           :<|> getChart id
-           :<|> phyloAPI id
            
            :<|> favApi   id
            :<|> delDocs  id
            :<|> searchIn id
+           
            :<|> getMetrics id
+           :<|> getChart id
+           :<|> phyloAPI id
            -- Annuaire
            -- :<|> upload
            -- :<|> query
@@ -260,7 +262,7 @@ type PairingApi = Summary " Pairing API"
 type ChartApi = Summary " Chart API"
               :> QueryParam "from" UTCTime
               :> QueryParam "to"   UTCTime
-              :> Get '[JSON] [FacetChart]
+              :> Get '[JSON] (ChartMetrics Histo)
 
                 -- Depending on the Type of the Node, we could post
                 -- New documents for a corpus
@@ -328,11 +330,6 @@ getPairing cId ft o l order =
     (Just Trash) -> runViewAuthorsDoc cId True  o l order
     _     -> panic "not implemented"
 
-
-getChart :: NodeId -> Maybe UTCTime -> Maybe UTCTime
-                   -> Cmd err [FacetChart]
-getChart _ _ _ = undefined -- TODO
-
 postNode :: HasNodeError err => UserId -> NodeId -> PostNode -> Cmd err [NodeId]
 postNode uId pId (PostNode nodeName nt) = mkNodeWithParent nt (Just pId) uId nodeName
 

src/Gargantext/Database/Facet.hs

@@ -166,17 +166,6 @@ type FacetDocRead = Facet (Column PGInt4       )
                           (Column PGInt4       )
 
 -----------------------------------------------------------------------
-
-data FacetChart = FacetChart { facetChart_time  :: UTCTime'
-                             , facetChart_count :: Double
-                        }
-        deriving (Show, Generic)
-$(deriveJSON (unPrefix "facetChart_") ''FacetChart)
-instance ToSchema FacetChart
-
-instance Arbitrary FacetChart where
-    arbitrary = FacetChart <$> arbitrary <*> arbitrary
-
 -----------------------------------------------------------------------
 type Trash   = Bool
 data OrderBy =  DateAsc   | DateDesc

src/Gargantext/Database/Schema/NodeNode.hs

@@ -25,17 +25,23 @@ commentary with @some markup@.
 
 module Gargantext.Database.Schema.NodeNode where
 
+import Control.Lens (view)
 import qualified Database.PostgreSQL.Simple as PGS (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.Maybe (Maybe, catMaybes)
+import Data.Text (Text, splitOn)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
+import Gargantext.Database.Schema.Node 
+import Gargantext.Core.Types
 import Gargantext.Database.Utils
+import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Types.Node (CorpusId, DocId)
 import Gargantext.Prelude
 import Opaleye
-
+import Control.Arrow (returnA)
+import qualified Opaleye as O
 
 data NodeNodePoly node1_id node2_id score fav del
                    = NodeNode { nn_node1_id   :: node1_id
@@ -122,6 +128,34 @@ nodesToFavorite inputData = map (\(PGS.Only a) -> a)
                   |]
 
 ------------------------------------------------------------------------
+-- | TODO use UTCTime fast 
+selectDocsDates :: CorpusId -> Cmd err [Text]
+selectDocsDates cId = 
+                map (head' "selectDocsDates" . splitOn "-")
+               <$> catMaybes
+               <$> map (view hyperdataDocument_publication_date)
+               <$> selectDocs cId
+
+
+selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
+selectDocs cId = runOpaQuery (queryDocs cId)
+
+queryDocs :: CorpusId -> O.Query (Column PGJsonb)
+queryDocs cId = proc () -> do
+  (n, nn) <- joinInCorpus -< ()
+  restrict -< ( nn_node1_id nn)  .== (toNullable $ pgNodeId cId)
+  restrict -< ( nn_delete nn)    .== (toNullable $ pgBool False)
+  restrict -< (_node_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
+  returnA -< view (node_hyperdata) n
+
+
+joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
+joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
+  where
+    cond :: (NodeRead, NodeNodeRead) -> Column PGBool
+    cond (n, nn) = nn_node2_id nn .== (view node_id n)
+
+
 ------------------------------------------------------------------------
 -- | Trash management
 nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int]
@@ -159,5 +193,3 @@ emptyTrash cId = runPGSQuery delQuery (PGS.Only cId)
                     RETURNING n.node2_id
                 |]
 ------------------------------------------------------------------------
-
-

src/Gargantext/Database/TextSearch.hs

@@ -31,7 +31,7 @@ import Gargantext.Prelude
 import Gargantext.Database.Facet
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.NodeNode
+import Gargantext.Database.Schema.NodeNode hiding (joinInCorpus)
 import Gargantext.Database.Schema.NodeNgram
 import Gargantext.Database.Queries.Join (leftJoin6)
 import Gargantext.Database.Utils (Cmd, runPGSQuery, runOpaQuery)
@@ -65,6 +65,7 @@ queryInCorpus :: CorpusId -> Text -> O.Query FacetDocRead
 queryInCorpus cId q = proc () -> do
   (n, nn) <- joinInCorpus -< ()
   restrict -< ( nn_node1_id nn) .== (toNullable $ pgNodeId cId)
+  restrict -< ( nn_delete nn)   .== (toNullable $ pgBool False)
   restrict -< (_ns_search n)           @@ (pgTSQuery (unpack q))
   restrict -< (_ns_typename n)        .== (pgInt4 $ nodeTypeId NodeDocument)
   returnA  -< FacetDoc (_ns_id n) (_ns_date n) (_ns_name n) (_ns_hyperdata n) (pgBool True) (pgInt4 1)

src/Gargantext/Viz/Chart.hs

 {-|
 Module      : Gargantext.Viz.Chart
-Description : Chart management
+Description : Graph utils
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
@@ -10,7 +10,40 @@ Portability : POSIX
 -}
 
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE RankNTypes        #-}
 
-module Gargantext.Viz.Chart where
+module Gargantext.Viz.Chart
+  where
 
 
+import Data.Text (Text)
+import Data.List (unzip, sortOn)
+import Data.Map (toList)
+import GHC.Generics (Generic)
+import Gargantext.Prelude
+import Gargantext.Database.Schema.NodeNode (selectDocsDates)
+import Gargantext.Database.Utils
+import Gargantext.Database.Types.Node (CorpusId)
+import Gargantext.Text.Metrics.Count (occurrencesWith)
+
+
+data Chart = ChartHisto | ChartScatter | ChartPie
+  deriving (Generic)
+
+-- TODO use UTCTime
+data Histo = Histo { histo_dates :: [Text]
+                   , histo_count :: [Int]
+                   }
+  deriving (Generic)
+
+histoData :: CorpusId -> Cmd err Histo
+histoData cId = do
+  dates <- selectDocsDates cId
+  let (ls, css) = unzip
+                $ sortOn fst
+                $ toList
+                $ occurrencesWith identity dates
+  pure (Histo ls css)
+