diff --git a/stack.yaml b/stack.yaml index d2fcade..9693f3f 100644 --- a/stack.yaml +++ b/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 diff --git a/stack.yaml.lock b/stack.yaml.lock index 2579438..685c3bb 100644 --- a/stack.yaml.lock +++ b/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: diff --git a/tasklite-core/app/Main.hs b/tasklite-core/app/Main.hs index c9f2060..5811cdb 100644 --- a/tasklite-core/app/Main.hs +++ b/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 = diff --git a/tasklite-core/source/ImportExport.hs b/tasklite-core/source/ImportExport.hs index 3447f61..6be5dbe 100644 --- a/tasklite-core/source/ImportExport.hs +++ b/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" diff --git a/tasklite-core/source/Task.hs b/tasklite-core/source/Task.hs index 79816f7..a3f02d1 100644 --- a/tasklite-core/source/Task.hs +++ b/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" diff --git a/tasklite-core/source/Utils.hs b/tasklite-core/source/Utils.hs index 588d7bb..a267c2f 100644 --- a/tasklite-core/source/Utils.hs +++ b/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 diff --git a/tasklite-core/test/Spec.hs b/tasklite-core/test/Spec.hs index 5263198..162648a 100644 --- a/tasklite-core/test/Spec.hs +++ b/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