[phylo] implement hh/mm/ss, also some refactorings

bin/gargantext-cli/CLI/Phylo/Common.hs

@@ -62,11 +62,17 @@ wosToDocs limit patterns time path = do
                         in Document (toPhyloDate
                                       (fromIntegral $ fromJust $ _hd_publication_year d)
                                       (fromJust $ _hd_publication_month d)
-                                      (fromJust $ _hd_publication_day d) time)
+                                      (fromJust $ _hd_publication_day d)
+                                      (fromJust $ _hd_publication_hour d)
+                                      (fromJust $ _hd_publication_minute d)
+                                      (fromJust $ _hd_publication_second d) time)
                                     (toPhyloDate'
                                       (fromIntegral $ fromJust $ _hd_publication_year d)
                                       (fromJust $ _hd_publication_month d)
-                                      (fromJust $ _hd_publication_day d) time)
+                                      (fromJust $ _hd_publication_day d)
+                                      (fromJust $ _hd_publication_hour d)
+                                      (fromJust $ _hd_publication_minute d)
+                                      (fromJust $ _hd_publication_second d) time)
                                     (termsInText patterns $ title <> " " <> abstr) Nothing [] time)
         <$> concat
         <$> mapConcurrently (\file ->
@@ -82,8 +88,9 @@ tsvToDocs parser patterns time path =
     Wos  _     -> errorTrace "tsvToDocs: unimplemented"
     Tsv  limit -> Vector.toList
       <$> Vector.take limit
-      <$> Vector.map (\row -> Document (toPhyloDate  (Tsv.fromMIntOrDec Tsv.defaultYear $ tsv_publication_year row) (fromMaybe Tsv.defaultMonth $ tsv_publication_month row) (fromMaybe Tsv.defaultDay $ tsv_publication_day row) time)
-                                       (toPhyloDate' (Tsv.fromMIntOrDec Tsv.defaultYear $ tsv_publication_year row) (fromMaybe Tsv.defaultMonth $ tsv_publication_month row) (fromMaybe Tsv.defaultDay $ tsv_publication_day row) time)
+      -- NOTE: TSV doesn't have hour/minute/second information
+      <$> Vector.map (\row -> Document (toPhyloDate  (Tsv.fromMIntOrDec Tsv.defaultYear $ tsv_publication_year row) (fromMaybe Tsv.defaultMonth $ tsv_publication_month row) (fromMaybe Tsv.defaultDay $ tsv_publication_day row) 0 0 0 time)
+                                       (toPhyloDate' (Tsv.fromMIntOrDec Tsv.defaultYear $ tsv_publication_year row) (fromMaybe Tsv.defaultMonth $ tsv_publication_month row) (fromMaybe Tsv.defaultDay $ tsv_publication_day row) 0 0 0 time)
                                        (termsInText patterns $ (tsv_title row) <> " " <> (tsv_abstract row))
                                        Nothing
                                        []
@@ -91,8 +98,9 @@ tsvToDocs parser patterns time path =
                      ) <$> snd <$> either (\err -> panicTrace $ "TSV error" <> (show err)) identity <$> Tsv.readTSVFile path
     Tsv' limit -> Vector.toList
       <$> Vector.take limit
-      <$> Vector.map (\row -> Document (toPhyloDate  (tsv'_publication_year row) (tsv'_publication_month row) (tsv'_publication_day row) time)
-                                       (toPhyloDate' (tsv'_publication_year row) (tsv'_publication_month row) (tsv'_publication_day row) time)
+      -- NOTE: TSV doesn't have hour/minute/second information
+      <$> Vector.map (\row -> Document (toPhyloDate  (tsv'_publication_year row) (tsv'_publication_month row) (tsv'_publication_day row) 0 0 0 time)
+                                       (toPhyloDate' (tsv'_publication_year row) (tsv'_publication_month row) (tsv'_publication_day row) 0 0 0 time)
                                        (termsInText patterns $ (tsv'_title row) <> " " <> (tsv'_abstract row))
                                        (Just $ tsv'_weight row)
                                        (map (T.strip . pack) $ splitOn ";" (unpack $ (tsv'_source row)))
@@ -157,11 +165,14 @@ fileToList parser path =
 -- Config time parameters to label
 timeToLabel :: PhyloConfig -> [Char]
 timeToLabel config = case (timeUnit config) of
-      Epoch p s f -> ("time_epochs" <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
-      Year  p s f -> ("time_years"  <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
-      Month p s f -> ("time_months" <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
-      Week  p s f -> ("time_weeks"  <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
-      Day   p s f -> ("time_days"   <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
+      Epoch  p s f -> ("time_epochs" <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
+      Year   p s f -> ("time_years"  <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
+      Month  p s f -> ("time_months" <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
+      Week   p s f -> ("time_weeks"  <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
+      Day    p s f -> ("time_days"   <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
+      Hour   p s f -> ("time_hours"   <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
+      Minute p s f -> ("time_minutes"   <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
+      Second p s f -> ("time_seconds"   <> "_" <> (show p) <> "_" <> (show s) <> "_" <> (show f))
 
 
 seaToLabel :: PhyloConfig -> [Char]

gargantext.cabal

@@ -258,6 +258,7 @@ library
       Gargantext.Core.Types.Query
       Gargantext.Core.Utils
       Gargantext.Core.Utils.Aeson
+      Gargantext.Core.Utils.DateUtils
       Gargantext.Core.Utils.Prefix
       Gargantext.Core.Viz.Graph.Index
       Gargantext.Core.Viz.Graph.Tools
@@ -418,7 +419,6 @@ library
       Gargantext.Core.Text.Terms.Multi.PosTagging
       Gargantext.Core.Text.Terms.Multi.PosTagging.Types
       Gargantext.Core.Types.Search
-      Gargantext.Core.Utils.DateUtils
       Gargantext.Core.Utils.Swagger
       Gargantext.Core.Viz
       Gargantext.Core.Viz.Chart

src/Gargantext/Core/Utils/DateUtils.hs

@@ -11,8 +11,14 @@ Portability : POSIX
 
 module Gargantext.Core.Utils.DateUtils where
 
+import Data.Text qualified as T
+import Data.Time (UTCTime(..), fromGregorian, toGregorian, utctDay)
+import Data.Time.Format (parseTimeM, defaultTimeLocale)
+import Data.Time.Format.ISO8601 (iso8601ParseM)
+import Data.Time.LocalTime (TimeOfDay(..), timeOfDayToTime)
+import Gargantext.Defaults qualified as Def
 import Gargantext.Prelude
-import Data.Time (UTCTime, toGregorian, utctDay)
+import Text.Printf (printf)
 
 --
 --readInt :: IO [Char] -> IO Int
@@ -38,3 +44,30 @@ averageLength l = fromIntegral (sum (map length l)) / fromIntegral (length l)
 --	c <- getCurrentTime
 --	print c -- $ toYear $ toGregorian $ utctDay c
 
+
+makeUTCTime :: Int -> Int -> Int -> Int -> Int -> Int -> UTCTime
+makeUTCTime year month day hour minute second' = 
+  UTCTime dayPart timePart
+  where
+    dayPart = fromGregorian (fromIntegral year) month day
+    timePart = timeOfDayToTime (TimeOfDay hour minute (fromIntegral second'))
+
+
+-- | Parse with multiple format attempts
+parseFlexibleTime :: Text -> Maybe UTCTime
+parseFlexibleTime t = msum
+  [ iso8601ParseM s
+  , parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M:%S UTC" s
+  , parseTimeM True defaultTimeLocale "%Y-%m-%d" s
+  ]
+  where
+    s = T.unpack t
+
+-- | Parse date and return date parts (list of [yyyy, mm, dd])
+dateParts :: Text -> [Text]
+dateParts t = [T.pack $ printf "%04d" y, T.pack $ printf "%02d" m, T.pack $ printf "%02d" d]
+  where
+    mParsed = parseFlexibleTime t
+    parsed = fromMaybe (makeUTCTime (fromIntegral Def.year) Def.month Def.day
+                                    Def.hour Def.minute Def.second) mParsed
+    (y, m, d) = toGregorian $ utctDay parsed

src/Gargantext/Core/Viz/Chart.hs

@@ -31,19 +31,19 @@ import Gargantext.Database.Admin.Config ( userMaster )
 import Gargantext.Database.Prelude (DBQuery)
 import Gargantext.Database.Query.Table.Node ( getListsWithParentId )
 import Gargantext.Database.Query.Table.Node.Select ( selectNodesWithUsername )
-import Gargantext.Database.Query.Table.NodeContext (selectDocsDates)
+import Gargantext.Database.Query.Table.NodeContext (selectDocsYears)
 import Gargantext.Database.Schema.Node ( NodePoly(_node_id) )
 import Gargantext.Prelude hiding (toList)
 
 
 histoData :: CorpusId -> DBQuery err x Histo
 histoData cId = do
-  dates <- selectDocsDates cId
+  years <- selectDocsYears cId
   let (ls, css) = V.unzip
                 $ V.fromList
                 $ sortOn fst -- TODO Vector.sortOn
                 $ toList
-                $ countOccurrences dates
+                $ countOccurrences years
   pure (Histo ls css)
 
 

src/Gargantext/Core/Viz/Phylo.hs

@@ -135,6 +135,18 @@ data TimeUnit =
       { _day_period :: Int
       , _day_step   :: Int
       , _day_matchingFrame :: Int }
+    | Hour
+      { _hour_period :: Int
+      , _hour_step   :: Int
+      , _hour_matchingFrame :: Int }
+    | Minute
+      { _minute_period :: Int
+      , _minute_step   :: Int
+      , _minute_matchingFrame :: Int }
+    | Second
+      { _second_period :: Int
+      , _second_step   :: Int
+      , _second_matchingFrame :: Int }
       deriving (Show,Generic,Eq,NFData,ToExpr)
 
 instance ToSchema TimeUnit where
@@ -341,7 +353,7 @@ defaultPhyloParam =
 -- | Document | --
 ------------------
 
--- | Date : a simple Integer
+-- | Date : a simple Integer (maxInt on 64 bit is good enough for storing number of seconds since year 0)
 type Date = Int
 
 -- | DateStr : the string version of a Date

src/Gargantext/Core/Viz/Phylo/API/Tools.hs

@@ -25,7 +25,9 @@ import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Data.Text (pack)
 import Data.Time.Calendar (fromGregorian, diffGregorianDurationClip, cdMonths, diffDays, showGregorian)
-import Data.Time.Clock.POSIX(posixSecondsToUTCTime)
+import Data.Time.Clock (UTCTime(..))
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
+import Data.Time.Format (defaultTimeLocale, formatTime)
 import Gargantext.API.Ngrams.Prelude (getTermList)
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Core (withDefaultLanguage, Lang)
@@ -33,6 +35,7 @@ import Gargantext.Core.NodeStory.Types (HasNodeStory, NodeStoryEnv, HasNodeStory
 import Gargantext.Core.Text.Ngrams (NgramsType(..))
 import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, termsInText)
 import Gargantext.Core.Types.Main (ListType(MapTerm))
+import Gargantext.Core.Utils.DateUtils (makeUTCTime)
 import Gargantext.Core.Viz.Phylo (TimeUnit(..), Date, Document(..), PhyloConfig(..), Phylo (_phylo_computeTime), trackComputeTime, ComputeTimeHistory)
 import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
 import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloWithoutLink)
@@ -50,7 +53,6 @@ import Gargantext.Database.Schema.Node ( NodePoly(_node_hyperdata), node_hyperda
 import Gargantext.Prelude hiding (to)
 import Gargantext.System.Logging ( MonadLogger, LogLevel(DEBUG), logLocM )
 import Gargantext.Utils.UTCTime (timeMeasured, timeMeasured'')
-import Prelude qualified
 import System.FilePath ((</>))
 import System.IO.Temp (withTempDirectory)
 import System.Process qualified as Shell
@@ -156,13 +158,19 @@ toPhyloDocs lang patterns time d =
   let title = fromMaybe "" (_hd_title d)
       abstr = fromMaybe "" (_hd_abstract d)
                   in Document (toPhyloDate
-                                      (fromIntegral $ fromMaybe 1 $ _hd_publication_year d)
+                                      (fromMaybe 1 $ _hd_publication_year d)
                                       (fromMaybe 1 $ _hd_publication_month d)
-                                      (fromMaybe 1 $ _hd_publication_day d) time)
+                                      (fromMaybe 1 $ _hd_publication_day d)
+                                      (fromMaybe 1 $ _hd_publication_hour d)
+                                      (fromMaybe 1 $ _hd_publication_minute d)
+                                      (fromMaybe 1 $ _hd_publication_second d) time)
                                     (toPhyloDate'
-                                      (fromIntegral $ fromMaybe 1 $ _hd_publication_year d)
+                                      (fromMaybe 1 $ _hd_publication_year d)
                                       (fromMaybe 1 $ _hd_publication_month d)
-                                      (fromMaybe 1 $ _hd_publication_day d) time)
+                                      (fromMaybe 1 $ _hd_publication_day d)
+                                      (fromMaybe 1 $ _hd_publication_hour d)
+                                      (fromMaybe 1 $ _hd_publication_minute d)
+                                      (fromMaybe 1 $ _hd_publication_second d) time)
                                     (termsInText' lang patterns $ title <> " " <> abstr) Nothing [] time
 
 
@@ -189,35 +197,75 @@ context2date :: Context HyperdataDocument -> TimeUnit -> Maybe (Date, Text)
 context2date context timeUnit = do
   let hyperdata =  _context_hyperdata context
   let
-    year  = fromMaybe 1 $ _hd_publication_year  hyperdata
-    month = fromMaybe 1 $ _hd_publication_month hyperdata
-    day   = fromMaybe 1 $ _hd_publication_day   hyperdata
-  pure (toPhyloDate year month day timeUnit, toPhyloDate' year month day timeUnit)
+    year    = fromMaybe 1 $ _hd_publication_year   hyperdata
+    month   = fromMaybe 1 $ _hd_publication_month  hyperdata
+    day     = fromMaybe 1 $ _hd_publication_day    hyperdata
+    hour    = fromMaybe 1 $ _hd_publication_hour   hyperdata
+    minute  = fromMaybe 1 $ _hd_publication_minute hyperdata
+    second' = fromMaybe 1 $ _hd_publication_second hyperdata
+  pure ( toPhyloDate year month day hour minute second' timeUnit
+       , toPhyloDate' year month day hour minute second' timeUnit)
 
 
 ---------------
 -- | Dates | --
 ---------------
-toMonths :: Integer -> Int -> Int -> Date
+toMonths :: Int -> Int -> Int -> Date
 toMonths y m d = fromIntegral $ cdMonths
-               $ diffGregorianDurationClip (fromGregorian y    m d)
+               $ diffGregorianDurationClip (fromGregorian (fromIntegral y) m d)
                                            (fromGregorian 0000 0 0)
 
-toDays :: Integer -> Int -> Int -> Date
+toDays :: Int -> Int -> Int -> Date
 toDays y m d = fromIntegral
-             $ diffDays (fromGregorian y m d) (fromGregorian 0000 0 0)
-
-toPhyloDate :: Int -> Int -> Int -> TimeUnit -> Date
-toPhyloDate y m d tu = case tu of
-  Year  {} -> y
-  Month {} -> toMonths (Prelude.toInteger y) m d
-  Week  {} -> div (toDays (Prelude.toInteger y) m d) 7
-  Day   {} -> toDays (Prelude.toInteger y) m d
-  _        -> panic "[G.C.V.Phylo.API] toPhyloDate"
-
-toPhyloDate' :: Int -> Int -> Int -> TimeUnit -> Text
-toPhyloDate' y _m _d (Epoch {}) = pack $ show $ posixSecondsToUTCTime $ fromIntegral y
-toPhyloDate' y  m  d _          = pack $ showGregorian $ fromGregorian (toInteger y) m d
+             $ diffDays (fromGregorian (fromIntegral y) m d) (fromGregorian 0000 0 0)
+
+-- Convert UTCTime to seconds since year 0
+utcTimeToSecondsFromYear0 :: UTCTime -> Integer
+utcTimeToSecondsFromYear0 utcTime = 
+  let posixSeconds = utcTimeToPOSIXSeconds utcTime
+      -- POSIX epoch is 1970-01-01, need to add seconds from year 0 to 1970
+      year0To1970Seconds = 1970 * 365.25 * 24 * 3600  -- Approximate
+  in floor (posixSeconds + year0To1970Seconds)
+
+
+toHours :: Int -> Int -> Int -> Int -> Date
+toHours y m d hh = fromIntegral $
+  (utcTimeToSecondsFromYear0 $ makeUTCTime y m d hh 0 0) `div` (60*60)
+
+toMinutes :: Int -> Int -> Int -> Int -> Int -> Date
+toMinutes y m d hh mm = fromIntegral $
+  (utcTimeToSecondsFromYear0 $ makeUTCTime y m d hh mm 0) `div` 60
+
+toSeconds :: Int -> Int -> Int -> Int -> Int -> Int -> Date
+toSeconds y m d hh mm ss = fromIntegral $
+  utcTimeToSecondsFromYear0 $ makeUTCTime y m d hh mm ss
+
+-- | This is kinda like a hashing function that assigns different
+-- 'Date' (in fact an 'Int') to different period, depending on the
+-- 'TimeUnit'
+toPhyloDate :: Int -> Int -> Int -> Int -> Int -> Int -> TimeUnit -> Date
+toPhyloDate y m d hh mm ss tu = case tu of
+  Year   {} -> y
+  Month  {} -> toMonths y m d
+  Week   {} -> div (toDays y m d) 7
+  Day    {} -> toDays y m d
+  Hour   {} -> toHours y m d hh
+  Minute {} -> toMinutes y m d hh mm
+  Second {} -> toSeconds y m d hh mm ss
+  Epoch  {} -> panic "[G.C.V.Phylo.API.Tools] toPhyloDate doesn't support Epoch"
+
+toPhyloDate' :: Int -> Int -> Int -> Int -> Int -> Int -> TimeUnit -> Text
+toPhyloDate' y _m _d _hh _mm _ss (Epoch {})  = pack $ show $ posixSecondsToUTCTime $ fromIntegral y
+toPhyloDate' y  m  d _hh _mm _ss (Year {})   = pack $ showGregorian $ fromGregorian (toInteger y) m d
+toPhyloDate' y  m  d _hh _mm _ss (Month {})  = pack $ showGregorian $ fromGregorian (toInteger y) m d
+toPhyloDate' y  m  d _hh _mm _ss (Week {})   = pack $ showGregorian $ fromGregorian (toInteger y) m d
+toPhyloDate' y  m  d _hh _mm _ss (Day {})    = pack $ showGregorian $ fromGregorian (toInteger y) m d
+toPhyloDate' y  m  d  hh _mm _ss (Hour {})   =
+  pack $ formatTime defaultTimeLocale "%Y-%m-%d %H" $ makeUTCTime y m d hh 0 0
+toPhyloDate' y  m  d  hh  mm _ss (Minute {}) =
+  pack $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M" $ makeUTCTime y m d hh mm 0
+toPhyloDate' y  m  d  hh  mm  ss (Second {}) =
+  pack $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" $ makeUTCTime y m d hh mm ss
 
 -- Utils
 

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

@@ -174,11 +174,14 @@ toLstDate ds = snd
 
 getTimeScale :: Phylo -> [Char]
 getTimeScale p = case (timeUnit $ getConfig p) of
-    Epoch {} -> "epoch"
-    Year  {} -> "year"
-    Month {} -> "month"
-    Week  {} -> "week"
-    Day   {} -> "day"
+    Epoch  {} -> "epoch"
+    Year   {} -> "year"
+    Month  {} -> "month"
+    Week   {} -> "week"
+    Day    {} -> "day"
+    Hour   {} -> "hour"
+    Minute {} -> "minute"
+    Second {} -> "second"
 
 
 -- | Get a regular & ascendante timeScale from a given list of dates
@@ -190,11 +193,14 @@ toTimeScale dates step =
 
 getTimeStep :: TimeUnit -> Int
 getTimeStep time = case time of
-    Epoch { .. } -> _epoch_step
-    Year  { .. } -> _year_step
-    Month { .. } -> _month_step
-    Week  { .. } -> _week_step
-    Day   { .. } -> _day_step
+    Epoch  { .. } -> _epoch_step
+    Year   { .. } -> _year_step
+    Month  { .. } -> _month_step
+    Week   { .. } -> _week_step
+    Day    { .. } -> _day_step
+    Hour   { .. } -> _hour_step
+    Minute { .. } -> _minute_step
+    Second { .. } -> _second_step
 
 getTimePeriod :: TimeUnit -> Int
 getTimePeriod time = case time of
@@ -203,6 +209,9 @@ getTimePeriod time = case time of
     Month { .. } -> _month_period
     Week  { .. } -> _week_period
     Day   { .. } -> _day_period
+    Hour   { .. } -> _hour_period
+    Minute { .. } -> _minute_period
+    Second { .. } -> _second_period
 
 getTimeFrame :: TimeUnit -> Int
 getTimeFrame time = case time of
@@ -211,6 +220,9 @@ getTimeFrame time = case time of
     Month { .. } -> _month_matchingFrame
     Week  { .. } -> _week_matchingFrame
     Day   { .. } -> _day_matchingFrame
+    Hour   { .. } -> _hour_matchingFrame
+    Minute { .. } -> _minute_matchingFrame
+    Second { .. } -> _second_matchingFrame
 
 -------------
 -- | Fis | --

src/Gargantext/Database/Query/Table/NodeContext.hs

@@ -20,7 +20,7 @@ commentary with @some markup@.
 module Gargantext.Database.Query.Table.NodeContext
   ( module Gargantext.Database.Schema.NodeContext
   , queryNodeContextTable
-  , selectDocsDates
+  , selectDocsYears
   , selectDocNodes
   , selectDocNodesOnlyId
   , selectDocs
@@ -44,12 +44,12 @@ module Gargantext.Database.Query.Table.NodeContext
 
 import Control.Arrow (returnA)
 import Control.Lens (view)
-import Data.Text (splitOn)
 import Data.Time (UTCTime)
 import Database.PostgreSQL.Simple qualified as PGS (In(..), Query, Only(..))
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Gargantext.Core ( HasDBid(toDBid) )
+import Gargantext.Core.Utils.DateUtils (dateParts)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, hd_publication_date )
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( Hyperdata )
@@ -379,9 +379,8 @@ selectCountDocs cId = mkOpaCountQuery (queryCountDocs cId)
       returnA  -< c
 
 
--- | TODO use UTCTime fast
-selectDocsDates :: HasDBid NodeType => CorpusId -> DBQuery err x [Text]
-selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
+selectDocsYears :: HasDBid NodeType => CorpusId -> DBQuery err x [Text]
+selectDocsYears cId = map (head' "G.D.Q.T.NodeContext.selectDocsYears" . dateParts)
                    <$> catMaybes
                    <$> map (view hd_publication_date)
                    <$> selectDocs cId

src/Gargantext/Database/Query/Table/NodeNode.hs

@@ -32,7 +32,7 @@ module Gargantext.Database.Query.Table.NodeNode
   , isNodeReadOnly
   , selectDocNodes
   , selectDocs
-  , selectDocsDates
+  , selectDocsYears
   , selectPublicNodes
   , selectPublishedNodes
 
@@ -56,8 +56,8 @@ import Control.Lens (view)
 import Database.PostgreSQL.Simple qualified as PGS
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..), Only (..))
-import Data.Text (splitOn)
 import Gargantext.Core ( HasDBid(toDBid) )
+import Gargantext.Core.Utils.DateUtils (dateParts)
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, hd_publication_date )
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( Hyperdata )
 import Gargantext.Database.Admin.Types.Node
@@ -222,9 +222,8 @@ _selectCountDocs cId = mkOpaCountQuery (queryCountDocs cId)
 
 
 
--- | TODO use UTCTime fast
-selectDocsDates :: HasDBid NodeType => CorpusId -> DBQuery err x [Text]
-selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
+selectDocsYears :: HasDBid NodeType => CorpusId -> DBQuery err x [Text]
+selectDocsYears cId =  map (head' "G.D.Q.T.NodeNode.selectDocsYears" . dateParts)
                    <$> catMaybes
                    <$> map (view hd_publication_date)
                    <$> selectDocs cId

test/Test/Core/Utils.hs

@@ -11,28 +11,54 @@ Portability : POSIX
 
 module Test.Core.Utils where
 
+import Data.Time (toGregorian, utctDay, utctDayTime)
+import Data.Time.LocalTime (TimeOfDay(..), timeOfDayToTime)
 import Gargantext.Core.Utils
+import Gargantext.Core.Utils.DateUtils (dateParts, parseFlexibleTime)
 import Gargantext.Prelude
 import Test.Hspec
 
 -- | Core.Utils tests
 test :: Spec
 test = do
-  describe "check if groupWithCounts works" $ do
-    it "simple integer array" $ groupWithCounts testArray  `shouldBe` groupedArray
-    it "string"               $ groupWithCounts testString `shouldBe` groupedString
-  describe "check nonemptyIntercalate" $ do
-    it "empty list" $ nonemptyIntercalate "," [] `shouldBe` ""
-    it "simple list" $ nonemptyIntercalate "," ["x"] `shouldBe` "x"
-    it "two-element list" $ nonemptyIntercalate "," ["x", "y"] `shouldBe` "x,y"
-    it "with empty strings" $ nonemptyIntercalate "," ["a", "", "b", "", "c", ""] `shouldBe` "a,b,c"
-  where
-    testArray :: [Int]
-    testArray = [1, 2, 3, 1, 2, 3]
-    groupedArray :: [(Int, Int)]
-    groupedArray = [(1, 2), (2, 2), (3, 2)]
-    testString :: [Char]
-    testString = "abccba"
-    groupedString :: [(Char, Int)]
-    groupedString = [('a', 2), ('b', 2), ('c', 2)]
-    
+  describe "array utils work" $ do
+    describe "check if groupWithCounts works" $ do
+      it "simple integer array" $ do
+        let testArray :: [Int]
+            testArray = [1, 2, 3, 1, 2, 3]
+            groupedArray :: [(Int, Int)]
+            groupedArray = [(1, 2), (2, 2), (3, 2)]
+        groupWithCounts testArray  `shouldBe` groupedArray
+      it "string"               $ do
+        let testString :: [Char]
+            testString = "abccba"
+            groupedString :: [(Char, Int)]
+            groupedString = [('a', 2), ('b', 2), ('c', 2)]
+        groupWithCounts testString `shouldBe` groupedString
+    describe "check nonemptyIntercalate" $ do
+      it "empty list" $ nonemptyIntercalate "," [] `shouldBe` ""
+      it "simple list" $ nonemptyIntercalate "," ["x"] `shouldBe` "x"
+      it "two-element list" $ nonemptyIntercalate "," ["x", "y"] `shouldBe` "x,y"
+      it "with empty strings" $ nonemptyIntercalate "," ["a", "", "b", "", "c", ""] `shouldBe` "a,b,c"
+  describe "DateUtils works" $ do
+    describe "parseFlexibleTime works" $ do
+      it "ISO8601 format works 1" $ do
+        let parsed = parseFlexibleTime "2025-05-04T12:05:01.000Z"
+        (toGregorian . utctDay) <$> parsed `shouldBe` (Just (2025, 5, 4))
+        utctDayTime <$> parsed `shouldBe` (Just $ timeOfDayToTime $ TimeOfDay 12 5 1)
+      it "ISO8601 format works 2" $ do
+        let parsed = parseFlexibleTime "2025-05-04T12:05:01Z"
+        (toGregorian . utctDay) <$> parsed `shouldBe` (Just (2025, 5, 4))
+        utctDayTime <$> parsed `shouldBe` (Just $ timeOfDayToTime $ TimeOfDay 12 5 1)
+      it "'2025-07-20 01:00:13 UTC' format works" $ do
+        let parsed = parseFlexibleTime "2025-07-20 01:00:13 UTC"
+        (toGregorian . utctDay) <$> parsed `shouldBe` (Just (2025, 7, 20))
+        utctDayTime <$> parsed `shouldBe` (Just $ timeOfDayToTime $ TimeOfDay 1 0 13)
+    describe "dateParts works" $ do
+      it "ISO8601 format works 1" $
+        dateParts "2025-05-04T12:05:01.000Z" `shouldBe` ["2025", "05", "04"]
+      it "ISO8601 format works 2" $
+        dateParts "2025-05-04T12:05:01Z" `shouldBe` ["2025", "05", "04"]
+      it "'2025-07-20 01:00:13 UTC' format works" $
+        dateParts "2025-07-20 01:00:13 UTC" `shouldBe` ["2025", "07", "20"]
+