diff options
Diffstat (limited to 'app/Main.hs')
| -rw-r--r-- | app/Main.hs | 87 |
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) |