diff --git a/tasklite-core/source/ImportExport.hs b/tasklite-core/source/ImportExport.hs index a893d77..5e8fe36 100644 --- a/tasklite-core/source/ImportExport.hs +++ b/tasklite-core/source/ImportExport.hs @@ -133,6 +133,7 @@ import Utils ( ulidTextToDateTime, zeroTime, zonedTimeToDateTime, + (<$$>), ) @@ -448,7 +449,7 @@ instance FromJSON ImportTask where pure $ ImportTask finalTask notes tags -insertImportTask :: Connection -> ImportTask -> IO (Doc ann) +insertImportTask :: Connection -> ImportTask -> IO (Doc AnsiStyle) insertImportTask connection importTaskRecord = do effectiveUserName <- getEffectiveUserName let @@ -458,18 +459,20 @@ insertImportTask connection importTaskRecord = do then taskParsed{Task.user = T.pack effectiveUserName} else taskParsed insertRecord "tasks" connection theTask - insertTags - connection - (ulidTextToDateTime $ Task.ulid taskParsed) - theTask - importTaskRecord.tags + warnings <- + insertTags + connection + (ulidTextToDateTime $ Task.ulid taskParsed) + theTask + importTaskRecord.tags insertNotes connection (ulidTextToDateTime $ Task.ulid taskParsed) theTask importTaskRecord.notes pure $ - "📥 Imported task" + warnings + <$$> "📥 Imported task" <+> dquotes (pretty $ Task.body theTask) <+> "with ulid" <+> dquotes (pretty $ Task.ulid theTask) @@ -599,7 +602,7 @@ importFile _ connection filePath = do ingestFile :: Config -> Connection -> FilePath -> IO (Doc AnsiStyle) -ingestFile config connection filePath = do +ingestFile _config connection filePath = do content <- BSL.readFile filePath let @@ -614,7 +617,7 @@ ingestFile config connection filePath = do Right importTaskRecord@ImportTask{task} -> sequence [ insertImportTask connection importTaskRecord - , editTaskByTask config connection task + , editTaskByTask NoPreEdit connection task ] ".eml" -> case Parsec.parse message filePath content of @@ -624,7 +627,7 @@ ingestFile config connection filePath = do emailToImportTask email in sequence [ insertImportTask connection taskRecord - , editTaskByTask config connection task + , editTaskByTask NoPreEdit connection task ] _ -> die $ T.pack $ "File type " <> fileExt <> " is not supported" @@ -709,10 +712,17 @@ backupDatabase conf = do ) -editTaskByTask :: Config -> Connection -> Task -> IO (Doc AnsiStyle) -editTaskByTask _ connection taskToEdit = do +data PreEdit + = ApplyPreEdit (P.ByteString -> P.ByteString) + | NoPreEdit + + +editTaskByTask :: PreEdit -> Connection -> Task -> IO (Doc AnsiStyle) +editTaskByTask preEdit connection taskToEdit = do let taskYaml = Yaml.encode taskToEdit - newContent <- runUserEditorDWIM yamlTemplate taskYaml + newContent <- case preEdit of + ApplyPreEdit editFunc -> pure $ editFunc taskYaml + NoPreEdit -> runUserEditorDWIM yamlTemplate taskYaml if newContent == taskYaml then @@ -755,18 +765,20 @@ editTaskByTask _ connection taskToEdit = do } updateTask connection taskFixed - insertTags - connection - Nothing - taskFixed - (tags importTaskRecord) + warnings <- + insertTags + connection + Nothing + taskFixed + (tags importTaskRecord) insertNotes connection Nothing taskFixed (notes importTaskRecord) pure $ - "✏️ Edited task" + warnings + <$$> "✏️ Edited task" <+> dquotes (pretty $ Task.body taskFixed) <+> "with ulid" <+> dquotes (pretty $ Task.ulid taskFixed) @@ -776,4 +788,4 @@ editTaskByTask _ connection taskToEdit = do editTask :: Config -> Connection -> IdText -> IO (Doc AnsiStyle) editTask conf connection idSubstr = do execWithTask conf connection idSubstr $ \taskToEdit -> do - editTaskByTask conf connection taskToEdit + editTaskByTask NoPreEdit connection taskToEdit diff --git a/tasklite-core/source/Lib.hs b/tasklite-core/source/Lib.hs index cf85988..44958c1 100644 --- a/tasklite-core/source/Lib.hs +++ b/tasklite-core/source/Lib.hs @@ -129,7 +129,7 @@ import Data.Time.Clock (UTCTime) import Data.Time.ISO8601.Duration qualified as Iso import Data.ULID (ULID, getULID) import Data.Yaml as Yaml (encode) -import Database.SQLite.Simple (Only (Only)) +import Database.SQLite.Simple (Error (ErrorConstraint), Only (Only), SQLError (sqlError)) import Database.SQLite.Simple as Sql ( Connection, FromRow (..), @@ -169,7 +169,7 @@ import Prettyprinter as Pp ( ) import Prettyprinter.Render.Terminal ( AnsiStyle, - Color (Black, Green, Red), + Color (Black, Green, Red, Yellow), bgColorDull, bold, color, @@ -224,6 +224,7 @@ import Config ( HooksConfig (add), defaultConfig, ) +import Control.Monad.Catch (catchIf) import FullTask ( FullTask ( awake_utc, @@ -274,6 +275,7 @@ import Utils ( ulidTextToDateTime, utcFormatReadable, utcTimeToDateTime, + (<$$>), (<++>), ) @@ -354,7 +356,15 @@ updateTask connection task = do (toRow task <> [SQLText task.ulid]) -insertTags :: Connection -> Maybe DateTime -> Task -> [Text] -> IO () +handleTagDupError :: Text -> (Applicative f) => e -> f (Doc AnsiStyle) +handleTagDupError tag _exception = + pure $ + annotate (color Yellow) $ + "⚠️ Tag " <> dquotes (pretty tag) <> " is already assigned" + + +insertTags + :: Connection -> Maybe DateTime -> Task -> [Text] -> IO (Doc AnsiStyle) insertTags connection mbCreatedUtc task tags = do let uniqueTags = nub tags taskToTags <- forM uniqueTags $ \tag -> do @@ -372,8 +382,14 @@ insertTags connection mbCreatedUtc task tags = do } -- TODO: Insert all tags at once - P.forM_ taskToTags $ \taskToTag -> - insertRecord "task_to_tag" connection taskToTag + insertWarnings <- P.forM taskToTags $ \taskToTag -> + catchIf + -- TODO: Find out why it's not `ErrorConstraintUnique` + (\(err :: SQLError) -> err.sqlError == ErrorConstraint) + (insertRecord "task_to_tag" connection taskToTag P.>> pure "") + (handleTagDupError taskToTag.tag) + + pure $ vsep insertWarnings insertNotes :: Connection -> Maybe DateTime -> Task -> [Note] -> IO () @@ -515,13 +531,15 @@ addTask conf connection bodyWords = do putDoc preAddResult insertRecord "tasks" connection task - insertTags connection Nothing task tags + warnings <- insertTags connection Nothing task tags pure $ - "🆕 Added task" - <+> dquotes (pretty task.body) - <+> "with id" - <+> dquotes (pretty task.ulid) + warnings + <$$> ( "🆕 Added task" + <+> dquotes (pretty task.body) + <+> "with id" + <+> dquotes (pretty task.ulid) + ) logTask :: Config -> Connection -> [Text] -> IO (Doc AnsiStyle) @@ -544,9 +562,10 @@ logTask conf connection bodyWords = do } insertRecord "tasks" connection task - insertTags connection Nothing task tags + warnings <- insertTags connection Nothing task tags pure $ - "📝 Logged task" + warnings + <$$> "📝 Logged task" <+> dquotes (pretty task.body) <+> "with id" <+> dquotes (pretty task.ulid) @@ -761,7 +780,7 @@ showEither conf theEither = -- TODO: Eliminate code duplication with createNextRecurrence createNextRepetition - :: Config -> Connection -> Task -> IO (Maybe (Doc ann)) + :: Config -> Connection -> Task -> IO (Maybe (Doc AnsiStyle)) createNextRepetition conf connection task = do newUlidText <- formatUlid getULID let @@ -829,12 +848,13 @@ createNextRepetition conf connection task = do |] (Only task.ulid) - liftIO $ insertTags connection Nothing newTask (tags & P.concat) + warnings <- liftIO $ insertTags connection Nothing newTask (tags & P.concat) liftIO $ pure $ Just $ - "➡️ Created next task" + warnings + <$$> "➡️ Created next task" <+> dquotes (pretty newTask.body) <+> "in repetition series" <+> dquotes (pretty newTask.group_ulid) @@ -844,7 +864,7 @@ createNextRepetition conf connection task = do -- TODO: Eliminate code duplication with createNextRepetition createNextRecurrence - :: Config -> Connection -> Task -> IO (Maybe (Doc ann)) + :: Config -> Connection -> Task -> IO (Maybe (Doc AnsiStyle)) createNextRecurrence conf connection task = do newUlidText <- formatUlid getULID let @@ -908,12 +928,13 @@ createNextRecurrence conf connection task = do |] (Only task.ulid) - liftIO $ insertTags connection Nothing newTask (tags & P.concat) + warnings <- liftIO $ insertTags connection Nothing newTask (tags & P.concat) liftIO $ pure $ Just $ - "➡️ Created next task" + warnings + <$$> "➡️ Created next task" <+> dquotes (pretty task.body) <+> "in recurrence series" <+> dquotes (pretty task.group_ulid) @@ -1593,40 +1614,43 @@ findTask connection aPattern = do -- ContT $ withConnection dbPath addTag :: Config -> Connection -> Text -> [IdText] -> IO (Doc AnsiStyle) -addTag conf connection tag ids = do +addTag conf conn tag ids = do docs <- forM ids $ \idSubstr -> - execWithTask conf connection idSubstr $ \task -> do + execWithTask conf conn idSubstr $ \task -> do now <- fmap (pack . timePrint conf.utcFormat) timeCurrentP ulid <- formatUlid getULID - insertRecord - "task_to_tag" - connection - TaskToTag{ulid, task_ulid = task.ulid, tag} - - -- TODO: Check if modified_utc could be set via SQL trigger - executeNamed - connection - [sql| - UPDATE tasks - SET modified_utc = :now - WHERE ulid == :ulid - |] - [ ":now" := now - , ":ulid" := task.ulid - ] + catchIf + -- TODO: Find out why it's not `ErrorConstraintUnique` + (\(err :: SQLError) -> err.sqlError == ErrorConstraint) + ( do + insertRecord "task_to_tag" conn TaskToTag{ulid, task_ulid = task.ulid, tag} + + -- TODO: Check if modified_utc could be set via SQL trigger + executeNamed + conn + [sql| + UPDATE tasks + SET modified_utc = :now + WHERE ulid == :ulid + |] + [ ":now" := now + , ":ulid" := task.ulid + ] - let - prettyBody = dquotes $ pretty task.body - prettyId = dquotes $ pretty task.ulid + let + prettyBody = dquotes $ pretty task.body + prettyId = dquotes $ pretty task.ulid - pure $ - "🏷 Added tag" - <+> dquotes (pretty tag) - <+> "to task" - <+> prettyBody - <+> "with id" - <+> prettyId + pure $ + "🏷 Added tag" + <+> dquotes (pretty tag) + <+> "to task" + <+> prettyBody + <+> "with id" + <+> prettyId + ) + (handleTagDupError tag) pure $ vsep docs @@ -1971,7 +1995,7 @@ duplicateTasks conf connection ids = do |] (Only task.ulid) - liftIO $ insertTags connection Nothing dupeTask (tags & P.concat) + warnings <- liftIO $ insertTags connection Nothing dupeTask (tags & P.concat) notes <- query @@ -2003,21 +2027,22 @@ duplicateTasks conf connection ids = do prettyId = dquotes $ pretty task.ulid pure $ - if numOfChanges == 0 - then - "⚠️ Task" - <+> prettyBody - <+> "with id" - <+> prettyId - <+> "could not be duplicated" - else - "👯 Created a duplicate of task" - <+> prettyBody - <+> "(id:" - <+> pretty task.ulid - <+> ")" - <+> "with id" - <+> pretty dupeUlid + warnings + <$$> if numOfChanges == 0 + then + "⚠️ Task" + <+> prettyBody + <+> "with id" + <+> prettyId + <+> "could not be duplicated" + else + "👯 Created a duplicate of task" + <+> prettyBody + <+> "(id:" + <+> pretty task.ulid + <+> ")" + <+> "with id" + <+> pretty dupeUlid pure $ vsep docs diff --git a/tasklite-core/source/Utils.hs b/tasklite-core/source/Utils.hs index dfb663d..c835311 100644 --- a/tasklite-core/source/Utils.hs +++ b/tasklite-core/source/Utils.hs @@ -94,6 +94,7 @@ import Config ( Hook (body, filePath, interpreter), ) import Control.Arrow ((>>>)) +import Prettyprinter.Internal.Type (Doc (Empty)) import System.Random (mkStdGen) @@ -109,11 +110,22 @@ data ListModifiedFlag = AllItems | ModifiedItemsOnly deriving (Eq, Show) +-- | Combine documents with 2 newlines (<++>) :: Doc ann -> Doc ann -> Doc ann x <++> y = x <> softline <> softline <> y +-- | Combine documents with 2 newlines if both documents are non-empty +(<$$>) :: Doc ann -> Doc ann -> Doc ann +Empty <$$> y = y +x <$$> Empty = x +x <$$> y = x <++> y + + +infixr 6 <$$> + + zeroTime :: DateTime zeroTime = timeFromElapsedP 0 diff --git a/tasklite-core/test/LibSpec.hs b/tasklite-core/test/LibSpec.hs index 30208f9..e60150b 100644 --- a/tasklite-core/test/LibSpec.hs +++ b/tasklite-core/test/LibSpec.hs @@ -6,6 +6,7 @@ import Protolude ( pure, show, ($), + (<>), ) import Protolude qualified as P @@ -16,26 +17,32 @@ import Test.Hspec ( it, shouldBe, shouldContain, + shouldEndWith, shouldNotContain, ) import Data.Hourglass (DateTime) -import Lib (countTasks, insertRecord, insertTags, newTasks) +import Data.Text qualified as T +import ImportExport (PreEdit (ApplyPreEdit), editTaskByTask) +import Lib (addTag, countTasks, insertRecord, insertTags, newTasks) import Task (Task (body, closed_utc, state, ulid), TaskState (Done), zeroTask) import TestUtils (withMemoryDb) +task1 :: Task +task1 = + zeroTask + { ulid = "01hs68z7mdg4ktpxbv0yfafznq" + , body = "New task 1" + } + + spec :: DateTime -> Spec spec now = do describe "Lib" $ do it "counts tasks" $ do withMemoryDb defaultConfig $ \memConn -> do let - task1 = - zeroTask - { ulid = "01hs68z7mdg4ktpxbv0yfafznq" - , body = "New task 1" - } task2 = zeroTask { ulid = "01hs690f9hkzk9z7zews9j2k1d" @@ -53,7 +60,8 @@ spec now = do count2 <- countTasks defaultConfig memConn P.mempty show count2 `shouldBe` ("2" :: Text) - insertTags memConn Nothing task2 ["test"] + warnings <- insertTags memConn Nothing task2 ["test"] + P.show warnings `shouldBe` T.empty countWithTag <- countTasks defaultConfig memConn (Just ["+test"]) show countWithTag `shouldBe` ("1" :: Text) @@ -62,11 +70,6 @@ spec now = do it "gets new tasks" $ do withMemoryDb defaultConfig $ \memConn -> do let - task1 = - zeroTask - { ulid = "01hs68z7mdg4ktpxbv0yfafznq" - , body = "New task 1" - } task2 = zeroTask { ulid = "01hs6zsf3c0vqx6egfnmbqtmvy" @@ -81,3 +84,28 @@ spec now = do cliOutput <- newTasks defaultConfig now memConn (Just ["state:done"]) show cliOutput `shouldContain` "New task 2" show cliOutput `shouldNotContain` "New task 1" + + it "shows warning if a tag is duplicated" $ do + withMemoryDb defaultConfig $ \memConn -> do + let newTag = "test" + insertRecord "tasks" memConn task1 + warnings <- insertTags memConn Nothing task1 [newTag] + P.show warnings `shouldBe` T.empty + + cliOutput <- addTag defaultConfig memConn newTag [task1.ulid] + show cliOutput `shouldEndWith` "Tag \"test\" is already assigned" + + it "lets you edit a task and shows warning if a tag was duplicated" $ do + withMemoryDb defaultConfig $ \memConn -> do + let existTag = "existing-tag" + insertRecord "tasks" memConn task1 + warnings <- insertTags memConn Nothing task1 [existTag] + P.show warnings `shouldBe` T.empty + + cliOutput <- + editTaskByTask + (ApplyPreEdit (<> ("\ntags: " <> P.show [existTag, "new-tag"]))) + memConn + task1 + let errMsg = "Tag \"" <> T.unpack existTag <> "\" is already assigned" + show cliOutput `shouldContain` errMsg