chore: add `--auto` to `consume`

1 files changed, 19 insertions, 7 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 186b69f..0ca099b 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -63,7 +64,8 @@ data Cmd
         inputs :: [FilePath],
         prompt :: Bool,
         force :: Bool,
-        language :: Maybe String
+        language :: Maybe String,
+        auto :: Bool
       }
   | Edit
       { indexNames :: [FilePath]
@@ -117,6 +119,7 @@ consumeCmd =
     <*> promptArg
     <*> forceArg
     <*> languageArg
+    <*> autoArg
 
 editCmd :: O.Parser Cmd
 editCmd =
@@ -185,6 +188,14 @@ forceArg =
         <> O.help "Force operation, overriding safety checks"
     )
 
+autoArg :: O.Parser Bool
+autoArg =
+  O.switch
+    ( O.long "auto"
+        <> O.short 'a'
+        <> O.help "Automatically tag document(s)"
+    )
+
 filtersArg :: O.Parser [Filter]
 filtersArg =
   O.many $
@@ -308,7 +319,7 @@ main = do
   ensureDir "index"
 
   O.execParser (O.info (args O.<**> O.helper) O.idm) >>= \case
-    Args {cmd = Consume {keep, inputs, force, prompt, language}} -> do
+    Args {cmd = Consume {keep, inputs, force, prompt, language, auto}} -> do
       indexNames <-
         parMapM
           ( consume1
@@ -320,9 +331,10 @@ main = do
       docs <- mapM (readDocument . (<.> "json")) indexNames
       allDocs <- getDocuments
       docs' <-
-        if prompt
-          then processDocumentsInteractively settings allDocs docs
-          else processDocuments settings allDocs docs
+        if
+            | auto -> processDocuments settings allDocs docs
+            | prompt -> processDocumentsInteractively settings allDocs docs
+            | otherwise -> pure docs
       mapM_
         ( \doc -> do
             printf "%s\n" (takeBaseName doc.iFileName)
@@ -642,8 +654,8 @@ applyTags tags' doc = do
   addTags tags (removeTags untags doc)
   where
     (untags, tags) =
-      first (map (\tagKey -> G.Tag tagKey Nothing))
-        $ partitionEithers tags'
+      first (map (\tagKey -> G.Tag tagKey Nothing)) $
+        partitionEithers tags'
 
 addTags :: [G.Tag] -> Document -> Document
 addTags tags doc =