Skip to content

haskell-gargantext
haskell-gargantext
Commit b570ce3c authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[VIZ/CHARTS] Histogram by year.

parent 422f0ca4
Hide whitespace changes
Inline Side-by-side
Showing with 136 additions and 37 deletions
src/Gargantext/API/Metrics.hs
View file @ b570ce3c
......@@ -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
View file @ b570ce3c
......@@ -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
View file @ b570ce3c
......@@ -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
View file @ b570ce3c
......@@ -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
View file @ b570ce3c
......@@ -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
View file @ b570ce3c
{-|
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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment