Skip to content

Commit

Permalink
If a duplicate tag is added, don't crash but show a warning
Browse files Browse the repository at this point in the history
  • Loading branch information
@ad-si
ad-si committed Apr 23, 2024
1 parent 10e1e52 commit c240837
Show file tree
Hide file tree
Showing 4 changed files with 171 additions and 94 deletions.
52 changes: 32 additions & 20 deletions tasklite-core/source/ImportExport.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -133,6 +133,7 @@ import Utils (
ulidTextToDateTime,
zeroTime,
zonedTimeToDateTime,
(<$$>),
)


Expand Down Expand Up @@ -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
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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"

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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
149 changes: 87 additions & 62 deletions tasklite-core/source/Lib.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..),
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -224,6 +224,7 @@ import Config (
HooksConfig (add),
defaultConfig,
)
import Control.Monad.Catch (catchIf)
import FullTask (
FullTask (
awake_utc,
Expand Down Expand Up @@ -274,6 +275,7 @@ import Utils (
ulidTextToDateTime,
utcFormatReadable,
utcTimeToDateTime,
(<$$>),
(<++>),
)

Expand Down Expand Up @@ -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
Expand All @@ -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 ()
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down
Loading

0 comments on commit c240837

Please sign in to comment.