From 2bd11a1e490083103fe0cf225e73ca0968c2de57 Mon Sep 17 00:00:00 2001 From: Adrian Sieber Date: Mon, 18 Nov 2024 16:05:29 +0000 Subject: [PATCH] Include notes when exporting tasks as ndjson --- tasklite-core/source/ImportExport.hs | 60 +++- tasklite-core/tasklite-core.cabal | 2 +- tasklite-core/test/ImportExportSpec.hs | 438 ++++++++++++++----------- tasklite/tasklite.cabal | 2 +- 4 files changed, 291 insertions(+), 211 deletions(-) diff --git a/tasklite-core/source/ImportExport.hs b/tasklite-core/source/ImportExport.hs index 3a0abdc..9d61ee2 100644 --- a/tasklite-core/source/ImportExport.hs +++ b/tasklite-core/source/ImportExport.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Use maybe" #-} @@ -75,8 +76,9 @@ import Data.Yaml ( YamlMark (YamlMark), ) import Data.Yaml qualified as Yaml -import Database.SQLite.Simple as Sql (Connection, query_) -import FullTask (FullTask) +import Database.SQLite.Simple (Connection, Only (Only), query, query_) +import Database.SQLite.Simple.QQ (sql) +import FullTask (FullTask (..)) import Hooks (HookResult (message, task), executeHooks, formatHookResult) import ImportTask ( ImportTask (..), @@ -387,14 +389,39 @@ dumpCsv conf = do pure $ pretty $ TL.decodeUtf8 $ Csv.encodeDefaultOrderedByName rows +getNdjsonLines :: Connection -> IO [Doc AnsiStyle] +getNdjsonLines conn = do + -- TODO: Fix after tasks_view is updated to include notes + tasksWithoutNotes :: [FullTask] <- query_ conn "SELECT * FROM tasks_view" + tasks <- + tasksWithoutNotes + & P.mapM + ( \task -> do + notes <- + query + conn + [sql| + SELECT ulid, note + FROM task_to_note + WHERE task_ulid == ? + |] + (Only task.ulid) + + pure $ + task + { FullTask.notes = + if P.null notes then Nothing else Just notes + } + ) + + pure $ tasks <&> (Aeson.encode >>> TL.decodeUtf8 >>> pretty) + + dumpNdjson :: Config -> IO (Doc AnsiStyle) dumpNdjson conf = do - -- TODO: Use Task instead of FullTask to fix broken notes export - execWithConn conf $ \connection -> do - tasks :: [FullTask] <- query_ connection "SELECT * FROM tasks_view" - pure $ - vsep $ - fmap (pretty . TL.decodeUtf8 . Aeson.encode) tasks + execWithConn conf $ \conn -> do + lines <- getNdjsonLines conn + pure $ vsep lines dumpJson :: Config -> IO (Doc AnsiStyle) @@ -612,8 +639,8 @@ editTask conf conn idSubstr = do let importTaskDraft = emptyImportTask { ImportTask.task = taskToEdit - , tags = [] - , notes = [] + , ImportTask.tags = [] + , ImportTask.notes = [] } args <- P.getArgs preModifyResults <- @@ -638,12 +665,13 @@ editTask conf conn idSubstr = do case hookResult.task of Nothing -> pure (importTaskDraft, Empty) Just importTask -> do - fullImportTask <- setMissingFields - importTask - { ImportTask.task = importTask.task - { Task.ulid = taskToEdit.ulid } - } - pure ( fullImportTask, formatHookResult hookResult ) + fullImportTask <- + setMissingFields + importTask + { ImportTask.task = + importTask.task{Task.ulid = taskToEdit.ulid} + } + pure (fullImportTask, formatHookResult hookResult) _ -> do pure ( importTaskDraft diff --git a/tasklite-core/tasklite-core.cabal b/tasklite-core/tasklite-core.cabal index 9d8a2c9..8a6582a 100644 --- a/tasklite-core/tasklite-core.cabal +++ b/tasklite-core/tasklite-core.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack diff --git a/tasklite-core/test/ImportExportSpec.hs b/tasklite-core/test/ImportExportSpec.hs index b37476e..fc68d64 100644 --- a/tasklite-core/test/ImportExportSpec.hs +++ b/tasklite-core/test/ImportExportSpec.hs @@ -23,6 +23,7 @@ import Data.ULID (ULID) import Database.SQLite.Simple (query_) import Test.Hspec ( Spec, + describe, it, shouldBe, shouldNotBe, @@ -32,8 +33,9 @@ import Test.Hspec ( import Config (defaultConfig) import FullTask (FullTask, emptyFullTask) import FullTask qualified -import ImportExport (insertImportTask) +import ImportExport (getNdjsonLines, insertImportTask) import ImportTask (ImportTask (ImportTask, notes, tags, task)) +import Note (Note (Note)) import Task (Task (body, modified_utc, ulid, user), emptyTask) import TaskToNote (TaskToNote (TaskToNote)) import TaskToNote qualified @@ -45,219 +47,269 @@ spec :: Spec spec = do let conf = defaultConfig - 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") + describe "Import" $ 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") - ] + 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" "" - ) + 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" + 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 + (utcTxt & parseUtc <&> timePrint printFmt) `shouldBe` Just expected - it "imports a JSON task and puts unused fields into metadata" $ do - withMemoryDb conf $ \memConn -> do - let - jsonTask = - "\ - \ { 'body': 'Just a test' \ - \ , 'utc': '2024-03-15T10:32:51.853Z' \ - \ , 'tags': ['one', 'two'] \ - \ , 'notes': ['first note', 'second note'] \ - \ , 'xxx': 'yyy' \ - \ } \ - \" - & T.replace "'" "\"" + it "imports a JSON task and puts unused fields into metadata" $ do + withMemoryDb conf $ \memConn -> do + let + jsonTask = + "\ + \ { 'body': 'Just a test' \ + \ , 'utc': '2024-03-15T10:32:51.853Z' \ + \ , 'tags': ['one', 'two'] \ + \ , 'notes': ['first note', 'second note'] \ + \ , 'xxx': 'yyy' \ + \ } \ + \" + & T.replace "'" "\"" - 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 - [insertedTask] -> do - insertedTask.body `shouldBe` "Just a test" - insertedTask.tags `shouldBe` Just ["one", "two"] - insertedTask.metadata - `shouldBe` Just (Object $ KeyMap.fromList [("xxx", "yyy")]) - _ -> P.die "More than one task found" + 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 + [insertedTask] -> do + insertedTask.body `shouldBe` "Just a test" + insertedTask.tags `shouldBe` Just ["one", "two"] + insertedTask.metadata + `shouldBe` Just (Object $ KeyMap.fromList [("xxx", "yyy")]) + _ -> P.die "More than one task found" - taskToNotes :: [TaskToNote] <- - query_ memConn "SELECT * FROM task_to_note" - taskToNotes - `shouldBe` [ TaskToNote - { ulid = "01hs0tqwwd0002xgp98sbejja9" - , task_ulid = "01hs0tqwwd0003ctc29vaj647b" - , note = "first note" - } - , TaskToNote - { ulid = "01hs0tqwwd0007hagxf79yypwa" - , task_ulid = "01hs0tqwwd0003ctc29vaj647b" - , note = "second note" - } - ] - it "imports a JSON task with notes" $ do - withMemoryDb conf $ \memConn -> do - let jsonTask = "{\"body\":\"Just a test\", \"notes\":[\"A note\"]}" + taskToNotes :: [TaskToNote] <- + query_ memConn "SELECT * FROM task_to_note" + taskToNotes + `shouldBe` [ TaskToNote + { ulid = "01hs0tqwwd0002xgp98sbejja9" + , task_ulid = "01hs0tqwwd0003ctc29vaj647b" + , note = "first note" + } + , TaskToNote + { ulid = "01hs0tqwwd0007hagxf79yypwa" + , task_ulid = "01hs0tqwwd0003ctc29vaj647b" + , note = "second note" + } + ] + it "imports a JSON task with notes" $ do + withMemoryDb conf $ \memConn -> do + let jsonTask = "{\"body\":\"Just a test\", \"notes\":[\"A note\"]}" - case eitherDecode jsonTask of - Left error -> - P.die $ "Error decoding JSON: " <> show error - Right importTaskRecord -> do - result <- insertImportTask memConn importTaskRecord + case eitherDecode jsonTask of + Left error -> + P.die $ "Error decoding JSON: " <> show error + Right importTaskRecord -> do + result <- insertImportTask memConn importTaskRecord - unpack (show result) - `shouldStartWith` "📥 Imported task \"Just a test\" with ulid " + unpack (show result) + `shouldStartWith` "📥 Imported task \"Just a test\" with ulid " - taskToNotes :: [TaskToNote] <- - query_ memConn "SELECT * FROM task_to_note" - case taskToNotes of - [taskToNote] -> do - taskToNote.ulid `shouldNotBe` "" - taskToNote.task_ulid `shouldNotBe` "" - taskToNote.note `shouldBe` "A note" - _ -> P.die "More than one task_to_note row found" + taskToNotes :: [TaskToNote] <- + query_ memConn "SELECT * FROM task_to_note" + case taskToNotes of + [taskToNote] -> do + taskToNote.ulid `shouldNotBe` "" + taskToNote.task_ulid `shouldNotBe` "" + taskToNote.note `shouldBe` "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 - updatedTask.ulid `shouldNotBe` "" - updatedTask.modified_utc `shouldNotBe` "" - updatedTask.user `shouldNotBe` "" - updatedTask - { FullTask.ulid = "" - , FullTask.modified_utc = "" - , FullTask.user = "" - } - `shouldBe` emptyFullTask - { FullTask.body = "Just a test" - , -- TODO: Fix after notes are returned as a JSON array - FullTask.notes = Just [] - , FullTask.priority = Just 1.0 - , FullTask.metadata = case decode jsonTask of - Just (Object keyMap) -> - keyMap - & KeyMap.delete "body" - & KeyMap.delete "notes" - & \kMap -> - if KeyMap.null kMap - then Nothing - else Just $ Object kMap - _ -> Nothing + case tasks of + [updatedTask] -> do + updatedTask.ulid `shouldNotBe` "" + updatedTask.modified_utc `shouldNotBe` "" + updatedTask.user `shouldNotBe` "" + updatedTask + { FullTask.ulid = "" + , FullTask.modified_utc = "" + , FullTask.user = "" } - _ -> P.die "More than one task found" + `shouldBe` emptyFullTask + { FullTask.body = "Just a test" + , -- TODO: Fix after notes are returned as a JSON array + FullTask.notes = Just [] + , FullTask.priority = Just 1.0 + , FullTask.metadata = case decode jsonTask of + Just (Object keyMap) -> + keyMap + & KeyMap.delete "body" + & KeyMap.delete "notes" + & \kMap -> + if KeyMap.null kMap + then Nothing + else Just $ Object kMap + _ -> Nothing + } + _ -> 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 + 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 - [insertedTask] -> - ulidText2utc insertedTask.ulid `shouldBe` Just utcFromUlid - _ -> P.die "More than one task found" + 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 + [insertedTask] -> + ulidText2utc insertedTask.ulid `shouldBe` Just utcFromUlid + _ -> P.die "More than one task found" - it "imports JSON task with notes and sets the created_utc for notes" $ do - withMemoryDb conf $ \memConn -> do - let - utc = "2024-03-15 10:32:51" - jsonTask = - "{\"body\":\"Just a test\",\ - \\"created_at\":\"{{utc}}\",\ - \\"notes\": [\"Just a note\"]}" - & T.replace "{{utc}}" utc + it "imports JSON task with notes and sets the created_utc for notes" $ do + withMemoryDb conf $ \memConn -> do + let + utc = "2024-03-15 10:32:51" + jsonTask = + "{\"body\":\"Just a test\",\ + \\"created_at\":\"{{utc}}\",\ + \\"notes\": [\"Just a note\"]}" + & T.replace "{{utc}}" utc - expectedTaskToNote = - TaskToNote - { ulid = - emptyUlid - & P.flip setDateTime (utc & parseUtc & fromMaybe zeroTime) - & show @ULID - & T.toLower - , task_ulid = "01hs0tqw1r0007h0mj78s1jntz" - , note = "Just a note" - } + expectedTaskToNote = + TaskToNote + { ulid = + emptyUlid + & P.flip setDateTime (utc & parseUtc & fromMaybe zeroTime) + & show @ULID + & T.toLower + , task_ulid = "01hs0tqw1r0007h0mj78s1jntz" + , note = "Just a note" + } + + case eitherDecodeStrictText jsonTask of + Left error -> + P.die $ "Error decoding JSON: " <> show error + Right importTaskRecord -> do + _ <- insertImportTask memConn importTaskRecord + taskToNoteList :: [TaskToNote] <- + query_ memConn "SELECT * FROM task_to_note" + case taskToNoteList of + [taskToNote] -> do + taskToNote.ulid `shouldNotBe` expectedTaskToNote.ulid + (taskToNote.ulid & T.take 10) + `shouldBe` (expectedTaskToNote.ulid & T.take 10) + _ -> P.die "Found more than one note" - case eitherDecodeStrictText jsonTask of - Left error -> - P.die $ "Error decoding JSON: " <> show error - Right importTaskRecord -> do - _ <- insertImportTask memConn importTaskRecord - taskToNoteList :: [TaskToNote] <- - query_ memConn "SELECT * FROM task_to_note" - case taskToNoteList of - [taskToNote] -> do - taskToNote.ulid `shouldNotBe` expectedTaskToNote.ulid - (taskToNote.ulid & T.take 10) - `shouldBe` (expectedTaskToNote.ulid & T.take 10) - _ -> P.die "Found more than one note" + it "imports a GitHub issue" $ do + gitHubIssue <- BSL.readFile "test/fixtures/github-issue.json" + withMemoryDb conf $ \memConn -> do + let + expectedImpTask = + ImportTask + { task = + emptyTask + { Task.ulid = "01hrz2qz7g000577et78w9cpst" + , Task.body = "Support getting the note body from stdin" + , Task.user = "ad-si" + , Task.modified_utc = "2024-03-14 18:14:14.000" + } + , notes = [] + , tags = [] + } - it "imports a GitHub issue" $ do - gitHubIssue <- BSL.readFile "test/fixtures/github-issue.json" - withMemoryDb conf $ \memConn -> do + case eitherDecode gitHubIssue of + Left error -> P.die $ "Error decoding JSON: " <> show error + Right importTaskRecord -> do + _ <- insertImportTask memConn importTaskRecord + taskList :: [Task] <- query_ memConn "SELECT * FROM tasks" + case taskList of + [task] -> do + task.ulid `shouldBe` expectedImpTask.task.ulid + task.body `shouldBe` expectedImpTask.task.body + task.user `shouldBe` expectedImpTask.task.user + task.modified_utc `shouldBe` expectedImpTask.task.modified_utc + _ -> P.die "Found more than one note" + + describe "Export" $ do + it "exports several tasks as NDJSON including notes" $ do let - expectedImpTask = + task = + emptyTask + { Task.ulid = "01jczsz9c328fm7xydcwxbmv6n" + , Task.body = "Buy milk" + , Task.user = "ad-si" + , Task.modified_utc = "2024-09-24 22:31:09.123" + } + + importTask = ImportTask - { task = - emptyTask - { Task.ulid = "01hrz2qz7g000577et78w9cpst" - , Task.body = "Support getting the note body from stdin" - , Task.user = "ad-si" - , Task.modified_utc = "2024-03-14 18:14:14.000" - } - , notes = [] + { task = task + , notes = [Note "01jczszra25ec48pagzcw5qw6j" "Test note"] , tags = [] } - case eitherDecode gitHubIssue of - Left error -> P.die $ "Error decoding JSON: " <> show error - Right importTaskRecord -> do - _ <- insertImportTask memConn importTaskRecord - taskList :: [Task] <- query_ memConn "SELECT * FROM tasks" - case taskList of - [task] -> do - task.ulid `shouldBe` expectedImpTask.task.ulid - task.body `shouldBe` expectedImpTask.task.body - task.user `shouldBe` expectedImpTask.task.user - task.modified_utc `shouldBe` expectedImpTask.task.modified_utc - _ -> P.die "Found more than one note" + taskJson = + "[{\ + \\"awake_utc\":null,\ + \\"body\":\"Buy milk\",\ + \\"closed_utc\":null,\ + \\"due_utc\":null,\ + \\"group_ulid\":null,\ + \\"metadata\":null,\ + \\"modified_utc\":\"2024-09-24 22:31:09.123\",\ + \\"notes\":[{\ + \\"body\":\"Test note\",\ + \\"ulid\":\"01jczsz9c35ec48pagzcw5qw6j\"\ + \}],\ + \\"priority\":1,\ + \\"ready_utc\":null,\ + \\"recurrence_duration\":null,\ + \\"repetition_duration\":null,\ + \\"review_utc\":null,\ + \\"state\":null,\ + \\"tags\":null,\ + \\"ulid\":\"01jczsz9c328fm7xydcwxbmv6n\",\ + \\"user\":\"ad-si\",\ + \\"waiting_utc\":null\ + \}]" + + res <- withMemoryDb conf $ \memConn -> do + _ <- insertImportTask memConn importTask + getNdjsonLines memConn + + (show res :: P.Text) `shouldBe` taskJson diff --git a/tasklite/tasklite.cabal b/tasklite/tasklite.cabal index fb843ec..6fc4c52 100644 --- a/tasklite/tasklite.cabal +++ b/tasklite/tasklite.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack