Fix parsing of timestamp part in ULIDs for small timestamp values

Author: ad-si

tasklite-core/source/Utils.hs

@@ -53,15 +53,13 @@ parseUtc utcText =
 parseUlidUtcSection :: Text -> Maybe DateTime
 parseUlidUtcSection encodedUtc = do
   let
-    decodedUtc = (Crock.decode . unpack) encodedUtc
+    decodedUtcMaybe = (Crock.decode . unpack) encodedUtc
     getElapsed val = Elapsed $ Seconds $ val `div` 1000
-    getMilliSeconds val =
-      readMaybe $ T.unpack $ T.takeEnd 3 $ show val :: Maybe Int64
 
-  elapsed <- fmap getElapsed decodedUtc
-  milliSeconds <- getMilliSeconds decodedUtc
+  elapsed <- fmap getElapsed decodedUtcMaybe
+  milliSecPart <- fmap (`mod` 1000) decodedUtcMaybe
 
-  let nanoSeconds = NanoSeconds $ milliSeconds * 1000000
+  let nanoSeconds = NanoSeconds $ milliSecPart * 1000000
 
   pure $ timeGetDateTimeOfDay $ ElapsedP elapsed nanoSeconds
 

tasklite-core/test/Spec.hs

@@ -24,6 +24,22 @@ import Migrations
 -- | and therefore the order must not be changed
 testSuite :: Config -> DateTime -> Sql.Connection -> SpecWith ()
 testSuite conf now connection = do
+  describe "Utils" $ do
+    it "correctly parses beginning of UNIX epoch" $ do
+      (parseUlidUtcSection "0000000000")
+      `shouldBe`
+      (Just $ timeGetDateTimeOfDay $ Elapsed 0)
+
+    it "correctly parses 36 ms after UNIX epoch" $ do
+      (parseUlidUtcSection "0000000014")
+      `shouldBe`
+      (Just $ timeGetDateTimeOfDay $ ElapsedP 0 36000000)
+
+    it "correctly parses a ULID string" $ do
+      let ulidText = "0000000014T4R3JR7HMQNREEW8" :: Text
+
+      (fmap show $ parseUlidText ulidText) `shouldBe` (Just ulidText)
+
   describe "TaskLite" $ do
     let
       -- TODO: Make function more generic