Commit 7beb5d72 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

computeTime field in now optional

parent 2fd9c3e9
...@@ -430,13 +430,10 @@ type Period = (Date,Date) ...@@ -430,13 +430,10 @@ type Period = (Date,Date)
type PeriodStr = (DateStr,DateStr) type PeriodStr = (DateStr,DateStr)
data ComputeTimeHistory newtype ComputeTimeHistory
= NoHistoricalDataAvailable = ComputeTimeHistory (NonEmpty ElapsedSeconds)
| ComputeTimeHistory (NonEmpty ElapsedSeconds) deriving stock (Show, Eq, Generic)
deriving (Show, Eq, Generic, ToExpr) deriving newtype ToExpr
noComputeTimeHistory :: ComputeTimeHistory
noComputeTimeHistory = NoHistoricalDataAvailable
instance ToSchema ComputeTimeHistory where instance ToSchema ComputeTimeHistory where
declareNamedSchema _ = declareNamedSchema (Proxy @[ElapsedSeconds]) declareNamedSchema _ = declareNamedSchema (Proxy @[ElapsedSeconds])
...@@ -459,8 +456,9 @@ data Phylo = ...@@ -459,8 +456,9 @@ data Phylo =
-- See #409, store historical data on -- See #409, store historical data on
-- how many seconds it took to generate -- how many seconds it took to generate
-- a given phylomemy graph, to give a rough -- a given phylomemy graph, to give a rough
-- estimate to end users. -- estimate to end users. The field is optional
, _phylo_computeTime :: !ComputeTimeHistory -- to make it backward compatible.
, _phylo_computeTime :: !(Maybe ComputeTimeHistory)
} }
deriving (Generic, Show, Eq, ToExpr) deriving (Generic, Show, Eq, ToExpr)
...@@ -706,13 +704,10 @@ instance ToJSON PhyloGroup ...@@ -706,13 +704,10 @@ instance ToJSON PhyloGroup
instance ToJSON ComputeTimeHistory where instance ToJSON ComputeTimeHistory where
toJSON = \case toJSON = \case
NoHistoricalDataAvailable
-> JS.Null
ComputeTimeHistory runs ComputeTimeHistory runs
-> toJSON runs -> toJSON runs
instance FromJSON ComputeTimeHistory where instance FromJSON ComputeTimeHistory where
parseJSON JS.Null = pure NoHistoricalDataAvailable
parseJSON (JS.Array runs) = ComputeTimeHistory <$> parseJSON (JS.Array runs) parseJSON (JS.Array runs) = ComputeTimeHistory <$> parseJSON (JS.Array runs)
parseJSON ty = JS.typeMismatch "ComputeTimeHistory" ty parseJSON ty = JS.typeMismatch "ComputeTimeHistory" ty
...@@ -832,7 +827,7 @@ instance Arbitrary PhyloParam where ...@@ -832,7 +827,7 @@ instance Arbitrary PhyloParam where
arbitrary = pure defaultPhyloParam arbitrary = pure defaultPhyloParam
instance Arbitrary ComputeTimeHistory where instance Arbitrary ComputeTimeHistory where
arbitrary = oneof [ pure NoHistoricalDataAvailable, ComputeTimeHistory . NE.fromList . getNonEmpty <$> arbitrary ] arbitrary = oneof [ ComputeTimeHistory . NE.fromList . getNonEmpty <$> arbitrary ]
-- The 'resize' ensure our tests won't take too long as -- The 'resize' ensure our tests won't take too long as
-- we won't be generating very long lists. -- we won't be generating very long lists.
...@@ -857,9 +852,9 @@ trackComputeTime elapsedSecs = over phylo_computeTime update_time ...@@ -857,9 +852,9 @@ trackComputeTime elapsedSecs = over phylo_computeTime update_time
where where
-- In case we have more than one historical data available, we take only the last 5 -- In case we have more than one historical data available, we take only the last 5
-- runs, to not make the list unbounded. -- runs, to not make the list unbounded.
update_time :: ComputeTimeHistory -> ComputeTimeHistory update_time :: Maybe ComputeTimeHistory -> Maybe ComputeTimeHistory
update_time NoHistoricalDataAvailable update_time Nothing
= ComputeTimeHistory (NE.singleton elapsedSecs) = Just $ ComputeTimeHistory (NE.singleton elapsedSecs)
update_time (ComputeTimeHistory (r NE.:| runs)) = update_time (Just (ComputeTimeHistory (r NE.:| runs))) =
ComputeTimeHistory (elapsedSecs NE.:| (r : take 3 runs)) Just $ ComputeTimeHistory (elapsedSecs NE.:| (r : take 3 runs))
...@@ -551,4 +551,4 @@ initPhylo docs conf = ...@@ -551,4 +551,4 @@ initPhylo docs conf =
(fromList $ map (\prd -> (prd, PhyloPeriod prd ("","") (initPhyloScales 1 prd))) periods) (fromList $ map (\prd -> (prd, PhyloPeriod prd ("","") (initPhyloScales 1 prd))) periods)
0 0
(_qua_granularity $ phyloQuality $ _phyloParam_config params) (_qua_granularity $ phyloQuality $ _phyloParam_config params)
noComputeTimeHistory Nothing
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