diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/Main.hs | 23 |
1 files changed, 14 insertions, 9 deletions
diff --git a/app/Main.hs b/app/Main.hs index 096f253..9593825 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -21,6 +21,7 @@ import Data.Attoparsec.Text qualified as A import Data.ByteString.Lazy qualified as LB import Data.Default import Data.Digest.Pure.SHA (sha1, showDigest) +import Data.Either (partitionEithers) import Data.Function ((&)) import Data.List import Data.List.NonEmpty qualified as N @@ -509,14 +510,18 @@ processDocuments settings allDocs docs = tagDocumentInteractively :: S.Settings -> [Document] -> Document -> IO Document tagDocumentInteractively settings allDocs doc = do suggestedTags <- suggestTags settings allDocs doc - tags <- - S.fromList . catMaybes + (tagsToRemove, tagsToAdd) <- + partitionEithers <$> mapM (uncurry tagDocumentInteractively') suggestedTags let doc' = doc { index = doc.index - { tags = doc.index.tags `S.union` tags, + { tags = + S.filter + (not . (`elem` tagsToRemove) . tagKey) + doc.index.tags + `S.union` (S.fromList tagsToAdd), todo = False } } @@ -525,22 +530,22 @@ tagDocumentInteractively settings allDocs doc = do commitAll [doc.iFilePath] (printf "process %s (interactive)" doc.iFilePath) pure doc' where - tagDocumentInteractively' :: Tag -> [Tag] -> IO (Maybe Tag) + tagDocumentInteractively' :: Tag -> [Tag] -> IO (Either T.Text Tag) tagDocumentInteractively' tag@(Tag tagKey Nothing) tags = do choice <- P.prompt $ P.choice (printf "tag with %s?" tagKey) (("n" :: String) N.:| ["y"]) - pure $ if (choice == "y") then Just tag else Nothing + pure $ if (choice == "y") then Right tag else Left tagKey tagDocumentInteractively' (Tag tagKey (Just _)) tags = do tagValue <- fmap T.pack . P.prompt $ P.string (printf "tag with %s?" tagKey) - (map T.unpack $ mapMaybe tagValue tags) + (mapMaybe (fmap T.unpack . tagValue) tags ++ ["-"]) pure $ - if not (T.null tagValue) - then Just (Tag tagKey (Just tagValue)) - else Nothing + if tagValue == "-" + then Left tagKey + else Right (Tag tagKey (Just tagValue)) ensureGit :: IO () ensureGit = do |