Add ComputeTimeHistory to Phylo type

src/Gargantext/Core/Viz/Phylo.hs

@@ -23,19 +23,26 @@ one 8, e54847.
 
 {-# LANGUAGE DeriveAnyClass   #-}
 {-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Gargantext.Core.Viz.Phylo where
 
 import Data.Swagger
-import Data.Text (pack)
 import Data.Text.Lazy qualified as TextLazy
-import Data.TreeDiff (ToExpr)
+import Data.Text (pack)
+import Data.Time.Clock.POSIX (POSIXTime)
+import Data.TreeDiff (ToExpr (..))
 import Data.Vector (Vector)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Prelude
+import qualified Data.Aeson.Types as JS
 import Test.QuickCheck
 import Test.QuickCheck.Instances.Text()
 import Test.QuickCheck.Instances.Vector()
+import Data.Time (nominalDiffTimeToSeconds)
+import Data.Fixed (Fixed(..))
 
 ---------------------
 -- | PhyloConfig | --
@@ -110,7 +117,17 @@ data Synchrony =
 instance ToSchema Synchrony where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_")
 
+newtype ElapsedSeconds = ElapsedSeconds { _Seconds :: POSIXTime }
+  deriving stock (Show, Eq, Generic)
+  deriving newtype (FromJSON, ToJSON)
+
+instance ToExpr ElapsedSeconds where
+  toExpr (ElapsedSeconds x) =
+    let (MkFixed secs) = nominalDiffTimeToSeconds x
+    in toExpr secs
 
+instance ToSchema ElapsedSeconds where
+  declareNamedSchema _ = declareNamedSchema (Proxy @Int)
 
 data TimeUnit =
       Epoch
@@ -425,7 +442,16 @@ type Period = (Date,Date)
 type PeriodStr = (DateStr,DateStr)
 
 
+data ComputeTimeHistory
+  = NoHistoricalDataAvailable
+  | ComputeTimeHistory (NonEmpty ElapsedSeconds)
+  deriving (Show, Eq, Generic, ToExpr)
 
+noComputeTimeHistory :: ComputeTimeHistory
+noComputeTimeHistory = NoHistoricalDataAvailable
+
+instance ToSchema ComputeTimeHistory where
+  declareNamedSchema _ = declareNamedSchema (Proxy @[ElapsedSeconds])
 
 -- | Phylo datatype of a phylomemy
 --  foundations : the foundations of the phylo
@@ -442,6 +468,11 @@ data Phylo =
            , _phylo_periods      :: Map Period PhyloPeriod
            , _phylo_quality      :: Double
            , _phylo_level        :: Double
+           -- See #409, store historical data on
+           -- how many seconds it took to generate
+           -- a given phylomemy graph, to give a rough
+           -- estimate to end users.
+           , _phylo_computeTime  :: !ComputeTimeHistory
            }
            deriving (Generic, Show, Eq, ToExpr)
 
@@ -685,6 +716,18 @@ instance ToJSON Software
 instance FromJSON PhyloGroup
 instance ToJSON PhyloGroup
 
+instance ToJSON ComputeTimeHistory where
+ toJSON = \case
+   NoHistoricalDataAvailable
+     -> JS.Null
+   ComputeTimeHistory runs
+     -> toJSON runs
+
+instance FromJSON ComputeTimeHistory where
+  parseJSON JS.Null         = pure NoHistoricalDataAvailable
+  parseJSON (JS.Array runs) = ComputeTimeHistory <$> parseJSON (JS.Array runs)
+  parseJSON ty              = JS.typeMismatch "ComputeTimeHistory" ty
+
 $(deriveJSON (unPrefix "_foundations_"  ) ''PhyloFoundations)
 
 instance FromJSON Phylo
@@ -708,6 +751,8 @@ instance NFData PhyloParam
 instance NFData PhyloFoundations
 instance NFData PhyloCounts
 instance NFData PhyloSources
+instance NFData ElapsedSeconds
+instance NFData ComputeTimeHistory
 instance NFData Phylo
 instance NFData PhyloPeriod
 instance NFData PhyloScale

src/Gargantext/Core/Viz/Phylo/PhyloMaker.hs

@@ -551,3 +551,4 @@ initPhylo docs conf =
                (fromList $ map (\prd -> (prd, PhyloPeriod prd ("","") (initPhyloScales 1 prd))) periods)
                0
                (_qua_granularity $ phyloQuality $ _phyloParam_config params)
+               noComputeTimeHistory