Import: Add support for milliseconds in UTC timestamps

- Add support for more names for created UTC field
- Ensure date / datetime parsing is correct

Author: ad-si

stack.yaml

@@ -6,6 +6,7 @@ packages:
   # - tasklite-app
 
 extra-deps:
+  - aeson-2.2.1.0
   # TODO: Upgrade after 0.7.x includes missing megaparsec dependency
   - simple-sql-parser-0.6.0
 

stack.yaml.lock

@@ -4,6 +4,13 @@
 #   https://docs.haskellstack.org/en/stable/lock_files
 
 packages:
+- completed:
+    hackage: aeson-2.2.1.0@sha256:a23a61aada8233e10573e1612c0b2efe5a1aba0d59b05dbe2f63301822f136cb,6582
+    pantry-tree:
+      sha256: 8a50c54b9ecba80ecc3df3ea67faa4d155d6f6a6b3e342c74f3e6b0dcdc87e13
+      size: 83518
+  original:
+    hackage: aeson-2.2.1.0
 - completed:
     hackage: simple-sql-parser-0.6.0@sha256:ce8f602fa81001287deb25af7b711fc45e1cdf36ff7702edde5dee2358f19a37,5580
     pantry-tree:

tasklite-core/app/Main.hs

@@ -54,12 +54,7 @@ import Protolude qualified as P
 import Control.Monad.Catch (catchAll)
 import Data.Aeson as Aeson (KeyValue ((.=)), encode, object)
 import Data.FileEmbed (embedStringFile, makeRelativeToProject)
-import Data.Hourglass (
-  DateTime,
-  Time (timeFromElapsedP),
-  TimeFormat (toFormat),
-  timePrint,
- )
+import Data.Hourglass (DateTime, Time (timeFromElapsedP))
 import Data.String (fromString)
 import Data.Text qualified as T
 import Data.Text.Lazy qualified as TL
@@ -231,7 +226,7 @@ import Utils (
   TagText,
   executeHooks,
   parseUtc,
-  ulidTextToDateTime,
+  ulid2utc,
  )
 
 
@@ -1095,11 +1090,7 @@ executeCLiCommand :: Config -> DateTime -> Connection -> IO (Doc AnsiStyle)
 executeCLiCommand conf now connection = do
   let
     addTaskC = addTask conf connection
-    prettyUlid ulid =
-      pretty $
-        fmap
-          (T.pack . timePrint (toFormat ("YYYY-MM-DD H:MI:S.ms" :: [Char])))
-          (ulidTextToDateTime ulid)
+
     days3 = Iso.DurationDate (Iso.DurDateDay (Iso.DurDay 3) Nothing)
 
   cliArgs <- execParser (parserInfo conf)
@@ -1195,7 +1186,7 @@ executeCLiCommand conf now connection = do
       Help -> pure $ extendHelp $ parserHelp defaultPrefs $ cliArgsParser conf
       PrintConfig -> pure $ pretty conf
       Alias alias _ -> pure $ aliasWarning alias
-      UlidToUtc ulid -> pure $ prettyUlid ulid
+      UlidToUtc ulid -> pure $ pretty $ ulid2utc ulid
       ExternalCommand cmd argsMb -> do
         let
           args =

tasklite-core/source/ImportExport.hs

@@ -208,12 +208,28 @@ instance FromJSON ImportTask where
     utc <- o .:? "utc"
     entry <- o .:? "entry"
     creation <- o .:? "creation"
+    creation_utc <- o .:? "creation_utc"
+    creationUtc <- o .:? "creationUtc"
+    created <- o .:? "created"
     created_at <- o .:? "created_at"
+    createdAt <- o .:? "createdAt"
+    created_utc <- o .:? "created_utc"
+    createdUtc_ <- o .:? "createdUtc"
 
     let
       parsedCreatedUtc =
         parseUtc
-          =<< (utc <|> entry <|> creation <|> created_at)
+          =<< ( utc
+                  <|> entry
+                  <|> creation
+                  <|> creation_utc
+                  <|> creationUtc
+                  <|> created
+                  <|> created_at
+                  <|> createdAt
+                  <|> created_utc
+                  <|> createdUtc_
+              )
       createdUtc = fromMaybe zeroTime parsedCreatedUtc
 
     o_body <- o .:? "body"

tasklite-core/source/Task.hs

@@ -19,7 +19,6 @@ import Protolude as P (
   Semigroup ((<>)),
   Show,
   decodeUtf8,
-  encodeUtf8,
   fst,
   otherwise,
   show,
@@ -36,8 +35,8 @@ import Data.Aeson as Aeson (
   FromJSON,
   ToJSON,
   Value (Object),
-  eitherDecode,
   encode,
+  eitherDecodeStrictText,
  )
 import Data.Aeson.Key as Key (fromText)
 import Data.Aeson.KeyMap as KeyMap (fromList, insert)
@@ -341,7 +340,7 @@ instance Hashable Task
 
 instance Sql.FromField.FromField Value where
   fromField aField@(Field (SQLText txt) _) =
-    case Aeson.eitherDecode $ BSL.fromStrict $ encodeUtf8 txt of
+    case eitherDecodeStrictText txt of
       Left error -> returnError ConversionFailed aField error
       Right value -> Ok value
   fromField f = returnError ConversionFailed f "expecting SQLText column type"

tasklite-core/source/Utils.hs

@@ -1,15 +1,18 @@
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use maybe" #-}
+
 {-|
 Several utility functions (e.g for parsing & serializing UTC stamps)
 -}
 module Utils where
 
-import Protolude as P (
+import Protolude (
   Alternative ((<|>)),
   Applicative (pure),
   Char,
   Double,
   Eq,
-  Foldable (elem),
   Fractional (fromRational, (/)),
   Functor (fmap),
   IO,
@@ -41,6 +44,7 @@ import Protolude as P (
   (.),
   (<&>),
  )
+import Protolude qualified as P
 
 import Control.Monad.Catch (catchAll)
 import Data.Colour.RGBSpace (RGB (..))
@@ -57,6 +61,7 @@ import Data.Hourglass (
   Timeable (timeGetElapsedP),
   timeGetDateTimeOfDay,
   timeParse,
+  timePrint,
  )
 import Data.Text as T (
   Text,
@@ -88,6 +93,7 @@ import Config (
   Config (bodyStyle),
   Hook (body, filePath, interpreter),
  )
+import Control.Arrow ((>>>))
 
 
 type IdText = Text
@@ -138,6 +144,10 @@ parseUtc utcText =
   in
     -- From long (specific) to short (unspecific)
     timeParse ISO8601_DateAndTime utcString
+      -- <|> tParse "YYYY-MM-DDtH:MI:S.ns"
+      <|> tParse "YYYY-MM-DDtH:MI:S.msusns"
+      <|> tParse "YYYY-MM-DDtH:MI:S.msus"
+      <|> tParse "YYYY-MM-DDtH:MI:S.ms"
       <|> tParse "YYYY-MM-DDtH:MI:S"
       <|> tParse "YYYY-MM-DDtH:MI"
       <|> tParse "YYYYMMDDtHMIS"
@@ -167,7 +177,19 @@ parseUlidUtcSection encodedUtc = do
 
 ulidTextToDateTime :: Text -> Maybe DateTime
 ulidTextToDateTime =
-  parseUlidUtcSection . T.take 10
+  T.take 10 >>> parseUlidUtcSection
+
+
+{-| `ulid2utc` converts a ULID to a UTC timestamp
+
+>>> ulid2utc "01hq68smfe0r9entg3x4rb9441"
+Just "2024-02-21 16:43:17.358"
+-}
+ulid2utc :: Text -> Maybe Text
+ulid2utc ulid =
+  fmap
+    (T.pack . timePrint (toFormat ("YYYY-MM-DD H:MI:S.ms" :: [Char])))
+    (ulidTextToDateTime ulid)
 
 
 parseUlidText :: Text -> Maybe ULID

tasklite-core/test/Spec.hs

@@ -11,19 +11,23 @@ import Protolude (
   ($),
   (&),
   (/=),
+  (<&>),
   (<>),
  )
 import Protolude qualified as P
 
-import Data.Aeson (decode, eitherDecode)
+import Data.Aeson (decode, eitherDecode, eitherDecodeStrictText)
 import Data.Hourglass (
   DateTime,
   Elapsed (Elapsed),
   ElapsedP (ElapsedP),
   Time (timeFromElapsedP),
   timeGetDateTimeOfDay,
+  timePrint,
+  toFormat,
  )
-import Data.Text as T (unpack)
+import Data.Text (unpack)
+import Data.Text qualified as T
 import Database.SQLite.Simple (query_)
 import Database.SQLite.Simple qualified as Sql
 import Test.Hspec (
@@ -82,7 +86,7 @@ import TaskToNote (TaskToNote)
 import TaskToNote qualified
 import TaskToTag (TaskToTag)
 import TaskToTag qualified
-import Utils (parseUlidText, parseUlidUtcSection, parseUtc)
+import Utils (parseUlidText, parseUlidUtcSection, parseUtc, ulid2utc)
 
 
 withMemoryDb :: Config -> (Sql.Connection -> IO a) -> IO a
@@ -341,6 +345,43 @@ testSuite conf now = do
         runFilter conf now memConn [" "] `shouldThrow` (== ExitFailure 1)
 
     describe "Import & Export" $ do
+      it "parses any sensible datetime string" $ do
+        -- TODO: Maybe keep microseconds and nanoseconds
+        -- , ("YYYY-MM-DDTH:MI:S.msusZ", "2024-03-15T22:20:05.637913Z")
+        -- , ("YYYY-MM-DDTH:MI:S.msusnsZ", "2024-03-15T22:20:05.637913438Z")
+
+        let dateMap :: [(Text, Text)] =
+              [ ("YYYY-MM-DD", "2024-03-15")
+              , ("YYYY-MM-DD H:MI", "2024-03-15 22:20")
+              , ("YYYY-MM-DDTH:MIZ", "2024-03-15T22:20Z")
+              , ("YYYY-MM-DD H:MI:S", "2024-03-15 22:20:05")
+              , ("YYYY-MM-DDTH:MI:SZ", "2024-03-15T22:20:05Z")
+              , ("YYYYMMDDTHMIS", "20240315T222005")
+              , ("YYYY-MM-DDTH:MI:S.msZ", "2024-03-15T22:20:05.637Z")
+              , ("YYYY-MM-DDTH:MI:S.msZ", "2024-03-15T22:20:05.637123Z")
+              , ("YYYY-MM-DDTH:MI:S.msZ", "2024-03-15T22:20:05.637123456Z")
+              ]
+
+        P.forM_ dateMap $ \(formatTxt, utcTxt) -> do
+          case parseUtc utcTxt of
+            Nothing -> P.die "Invalid UTC string"
+            Just utcStamp ->
+              let timeFmt = formatTxt & T.unpack & toFormat
+              in  (utcStamp & timePrint timeFmt)
+                    `shouldBe` T.unpack
+                      ( utcTxt
+                          & T.replace "123" ""
+                          & T.replace "456" ""
+                      )
+
+        let
+          utcTxt = "2024-03-15T22:20:05.386777444Z"
+          printFmt = "YYYY-MM-DDTH:MI:S.ms" & T.unpack & toFormat
+          -- Truncates microseconds and nanoseconds
+          expected = "2024-03-15T22:20:05.386"
+
+        (utcTxt & parseUtc <&> timePrint printFmt) `shouldBe` Just expected
+
       it "imports a JSON task" $ do
         withMemoryDb conf $ \memConn -> do
           let jsonTask = "{\"body\":\"Just a test\", \"notes\":[\"A note\"]}"
@@ -363,8 +404,7 @@ testSuite conf now = do
                   taskToNote `shouldSatisfy` (\task -> task.note == "A note")
                 _ -> P.die "More than one task_to_note row found"
 
-              tasks :: [FullTask] <-
-                query_ memConn "SELECT * FROM tasks_view"
+              tasks :: [FullTask] <- query_ memConn "SELECT * FROM tasks_view"
 
               case tasks of
                 [updatedTask] -> do
@@ -385,6 +425,27 @@ testSuite conf now = do
                       }
                 _ -> P.die "More than one task found"
 
+      it "imports a JSON task with an ISO8601 created_at field" $ do
+        withMemoryDb conf $ \memConn -> do
+          let
+            utc = "2024-03-15T10:32:51.386777444Z"
+            -- ULID only has millisecond precision:
+            utcFromUlid = "2024-03-15 10:32:51.387"
+            jsonTask =
+              "{\"body\":\"Just a test\",\"created_at\":\"{{utc}}\"}"
+                & T.replace "{{utc}}" utc
+
+          case eitherDecodeStrictText jsonTask of
+            Left error ->
+              P.die $ "Error decoding JSON: " <> show error
+            Right importTaskRecord -> do
+              _ <- insertImportTask memConn importTaskRecord
+              tasks :: [FullTask] <- query_ memConn "SELECT * FROM tasks_view"
+              case tasks of
+                [updatedTask] ->
+                  ulid2utc updatedTask.ulid `shouldBe` Just utcFromUlid
+                _ -> P.die "More than one task found"
+
 
 main :: IO ()
 main = do