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