[utils] add DateUtils UTCTimeR to make time management easier

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,15 @@ 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, timeToTimeOfDay)
+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 +45,60 @@ averageLength l = fromIntegral (sum (map length l)) / fromIntegral (length l)
 --	c <- getCurrentTime
 --	print c -- $ toYear $ toGregorian $ utctDay c
 
+
+-- | A simplified UTCTime record for our purposes.
+--   The standard 'Date.Time.Clock.UTCTime' requires 'Integer' for
+--   year and separates day from time. This structure is supposed to
+--   reduce the boilerplate needed for date manipulation.
+data UTCTimeR =
+  UTCTimeR { year   :: Int
+           , month  :: Int
+           , day    :: Int
+           , hour   :: Int
+           , minute :: Int
+           , sec    :: Int }
+  deriving (Show, Eq, Generic)
+
+defUTCTimeR :: UTCTimeR
+defUTCTimeR = UTCTimeR { year   = fromIntegral Def.year
+                       , month  = Def.month
+                       , day    = Def.day
+                       , hour   = Def.hour
+                       , minute = Def.minute
+                       , sec    = Def.second }
+
+toUTCTime :: UTCTimeR -> UTCTime
+toUTCTime (UTCTimeR { .. }) = UTCTime dayPart timePart
+  where
+    dayPart = fromGregorian (fromIntegral year) month day
+    timePart = timeOfDayToTime (TimeOfDay hour minute (fromIntegral sec))
+
+toUTCTimeR :: UTCTime -> UTCTimeR
+toUTCTimeR (UTCTime { .. }) = UTCTimeR { year = fromIntegral year
+                                       , sec = round (realToFrac sec :: Float)
+                                       , .. }
+  where
+    (year, month, day) = toGregorian utctDay
+    TimeOfDay hour minute sec = timeToTimeOfDay utctDayTime
+
+
+-- | Parse with multiple format attempts
+parseFlexibleTime :: Text -> Maybe UTCTime
+parseFlexibleTime t = msum
+  [ iso8601ParseM s
+  , parseTimeM True defaultTimeLocale "%Y-%m-%dT%H:%M:%S" s
+  , parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M:%S" 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 (toUTCTime defUTCTimeR) mParsed
+    (y, m, d) = toGregorian $ utctDay parsed
+

src/Gargantext/Defaults.hs

@@ -21,3 +21,9 @@ month :: Int
 month = 1
 day :: Int
 day = 1
+hour :: Int
+hour = 0
+minute :: Int
+minute = 0
+second :: Int
+second = 0

test/Test/Core/Utils.hs

@@ -11,28 +11,68 @@ 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, toUTCTime, toUTCTimeR)
 import Gargantext.Prelude
 import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.Instances ()
+
 
 -- | 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" $ do
+    describe "UTCTimeR works" $ do
+      prop "can convert to/from" $
+        \utcTimeR -> toUTCTimeR (toUTCTime utcTimeR) == utcTimeR
+    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-20T01:00:13' format works" $ do
+        let parsed = parseFlexibleTime "2025-07-20T01:00:13"
+        (toGregorian . utctDay) <$> parsed `shouldBe` (Just (2025, 7, 20))
+        utctDayTime <$> parsed `shouldBe` (Just $ timeOfDayToTime $ TimeOfDay 1 0 13)
+      it "'2025-07-20 01:00:13' format works" $ do
+        let parsed = parseFlexibleTime "2025-07-20 01:00:13"
+        (toGregorian . utctDay) <$> parsed `shouldBe` (Just (2025, 7, 20))
+        utctDayTime <$> parsed `shouldBe` (Just $ timeOfDayToTime $ TimeOfDay 1 0 13)
+      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"]

test/Test/Instances.hs

@@ -54,6 +54,7 @@ import Gargantext.Core.Text.Corpus.Query (RawQuery(..))
 import Gargantext.Core.Types (TableResult)
 import Gargantext.Core.Types.Individu qualified as Individu
 import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm))
+import Gargantext.Core.Utils.DateUtils (UTCTimeR(..))
 import Gargantext.Core.Viz.Phylo qualified as Phylo
 import Gargantext.Core.Worker.Jobs.Types (Job(..))
 import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata
@@ -210,6 +211,22 @@ instance Arbitrary TableQuery where
                                    , tq_query = "electrodes" }]
 
 
+instance Arbitrary UTCTimeR where
+  arbitrary = do
+    year <- arbitrary
+    month <- chooseInt (1, 12)
+    day <- if month `elem` [1, 3, 5, 7, 8, 10, 12]
+      then chooseInt (1, 31)
+      else if month == 2
+        then chooseInt (1, 28)
+        else chooseInt (1, 30)
+    hour <- chooseInt (0, 23)
+    minute <- chooseInt (0, 59)
+    sec <- chooseInt (0, 59)
+
+    pure $ UTCTimeR { .. }
+
+