feat: add `edit` command

1 files changed, 64 insertions, 23 deletions

diff --git a/app/Main.hs b/app/Main.hs
index d0df4d1..2e64edc 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -21,7 +21,7 @@ import Data.Default
 import Data.Digest.Pure.SHA (sha256, showDigest)
 import Data.List
 import Data.Map qualified as M
-import Data.Maybe (catMaybes, fromMaybe)
+import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
 import Data.Set qualified as S
 import Data.String (IsString (fromString))
 import Data.Text qualified as T
@@ -51,6 +51,9 @@ data Cmd
       { keep :: Bool,
         inputs :: [FilePath]
       }
+  | Edit
+      { indexNames :: [FilePath]
+      }
   | List
       { filters :: [Filter],
         todo :: Bool,
@@ -71,6 +74,8 @@ cmd =
   O.hsubparser . mconcat $
     [ O.command "consume" . O.info consumeCmd $
         O.progDesc "Consume document(s)",
+      O.command "edit" . O.info editCmd $
+        O.progDesc "Edit document(s)",
       O.command "list" . O.info listCmd $
         O.progDesc "List document(s)",
       O.command "todo" . O.info todoCmd $
@@ -85,6 +90,11 @@ consumeCmd =
     <$> keepArg
     <*> inputsArg
 
+editCmd :: O.Parser Cmd
+editCmd =
+  Edit
+    <$> indexNamesArg
+
 listCmd :: O.Parser Cmd
 listCmd =
   List
@@ -175,6 +185,9 @@ main = do
     Args {cmd = Consume {keep, inputs}} ->
       mapM_ putStrLn
         =<< parMapM (consume1 keep) (map (cwd </>) inputs)
+    Args {cmd = Edit {indexNames}} -> do
+      editDocuments
+        =<< mapM (readDocument . (<.> "json")) indexNames
     Args {cmd = List {filters, redo, todo = False, view = False}} -> do
       doRedoIf filters redo
       mapM_
@@ -222,6 +235,15 @@ data Document = Document
   }
   deriving (Show)
 
+tagValues :: [Document] -> M.Map T.Text (S.Set T.Text)
+tagValues docs =
+  M.unionsWith S.union $
+    mapMaybe
+      ( \(Tag tagKey tagValue) ->
+          M.singleton tagKey . S.singleton <$> tagValue
+      )
+      (S.toList (S.unions (map (.index.tags) docs)))
+
 instance HasField "oFilePath" Document FilePath where
   getField doc = "originals" </> takeBaseName doc.iFileName <.> "pdf"
 
@@ -255,6 +277,7 @@ processDocuments docs =
   mapM_ (uncurry processDocuments') (zip [1 :: Int ..] docs)
   where
     numDocs = length docs
+    tagValues' = tagValues docs
     processDocuments' n (doc@Document {iFileName, index}) = do
       choice <-
         promptChoiceHelp
@@ -273,16 +296,9 @@ processDocuments docs =
       case choice of
         "f" -> do
           printf "%s\n" (takeBaseName doc.iFileName)
-          printf
-            "%s\n"
-            ( T.unlines
-                . filter (not . T.null)
-                . map T.strip
-                . T.lines
-                $ doc.index.originalText
-            )
+          printf "%s\n" doc.index.originalText
           processDocuments' n doc
-        "p" -> processDocument doc
+        "p" -> processDocument tagValues' doc
         "s" -> pure ()
         "v" -> do
           viewDocuments [doc]
@@ -298,8 +314,34 @@ viewDocuments docs =
            )
     )
 
-processDocument :: Document -> IO ()
-processDocument (Document {iFileName, index}) = do
+editDocuments :: [Document] -> IO ()
+editDocuments docs =
+  withSystemTempDirectory "apaperless" $ \tmp -> do
+    let fp doc = tmp </> takeBaseName doc.iFileName <.> "txt"
+    mapM_
+      ( \doc ->
+          T.writeFile (fp doc) doc.index.originalText
+      )
+      docs
+    sh_
+      ( "vim "
+          <> ( intercalate
+                 " "
+                 (map (\doc -> printf "'%s'" (fp doc)) docs)
+             )
+      )
+    mapM_
+      ( \doc -> do
+          originalText <- T.readFile (fp doc)
+          withGit do
+            J.encodeFile doc.iFilePath doc.index {originalText = originalText}
+            commitAll [doc.iFilePath] (printf "edit %s" (takeBaseName doc.iFilePath))
+          pure originalText
+      )
+      docs
+
+processDocument :: M.Map T.Text (S.Set T.Text) -> Document -> IO ()
+processDocument tagValues (Document {iFileName, index}) = do
   printf "%s\n" index.originalText
   let suggestedTags =
         [ Tag "correspondent" (Just ""),
@@ -308,7 +350,7 @@ processDocument (Document {iFileName, index}) = do
         ]
   tags <-
     S.fromList . catMaybes
-      <$> mapM processSuggestedTag suggestedTags
+      <$> mapM (processSuggestedTag tagValues) suggestedTags
   let tags' = S.delete (Tag "todo" Nothing) (index.tags `S.union` tags)
       index' = index {tags = tags'}
       iFilePath = "index" </> iFileName
@@ -316,12 +358,15 @@ processDocument (Document {iFileName, index}) = do
     J.encodeFile iFilePath index'
     commitAll [iFilePath] (printf "process %s (interactive)" iFilePath)
 
-processSuggestedTag :: Tag -> IO (Maybe Tag)
-processSuggestedTag tag@(Tag tagKey Nothing) = do
+processSuggestedTag :: M.Map T.Text (S.Set T.Text) -> Tag -> IO (Maybe Tag)
+processSuggestedTag _ tag@(Tag tagKey Nothing) = do
   choice <- promptChoice (Just "n") ["n", "y"] (printf "tag with %s?" tagKey)
   pure $ if (choice == "y") then Just tag else Nothing
-processSuggestedTag (Tag tagKey (Just _)) = do
-  tagValue <- promptString [] (printf "tag with %s?" tagKey)
+processSuggestedTag tagValues (Tag tagKey (Just _)) = do
+  tagValue <-
+    promptString
+      (maybe [] S.toList (M.lookup tagKey tagValues))
+      (printf "tag with %s?" tagKey)
   pure $
     if not (T.null tagValue)
       then Just (Tag tagKey (Just tagValue))
@@ -419,7 +464,7 @@ consume1 keep filePath = do
   originalText <- do
     originalText' <-
       T.decodeUtf8 . LB.toStrict
-        <$> sh (printf "pdftotext '%s' -" filePath)
+        <$> sh (printf "pdftotext -layout '%s' -" filePath)
     let hasText = (not . T.null) . T.strip $ originalText'
     if not hasText
       then ocr filePath
@@ -498,11 +543,7 @@ instance J.FromJSON Index
 
 instance HasField "shortText" Index T.Text where
   getField =
-    T.unlines
-      . take 10
-      . filter (not . T.null)
-      . map T.strip
-      . T.lines
+    (T.unlines . take 10 . T.lines)
       . (.originalText)
 
 data Tag = Tag T.Text (Maybe T.Text)