Add subcommands importdir and ingestdir

ad-si · May 22, 2024 · 4c3c50a · 4c3c50a
1 parent f85c641
commit 4c3c50a
Show file tree

Hide file tree

Showing 2 changed files with 116 additions and 53 deletions.
diff --git a/tasklite-core/source/Cli.hs b/tasklite-core/source/Cli.hs
@@ -147,9 +147,11 @@ import ImportExport (
   dumpNdjson,
   dumpSql,
   editTask,
+  importDir,
   importEml,
   importFile,
   importJson,
+  ingestDir,
   ingestFile,
  )
 import Lib (
@@ -283,9 +285,11 @@ data Command
   | FindTask Text --
   {- I/O -}
   | ImportFile FilePath
+  | ImportDir FilePath
   | ImportJson
   | ImportEml
   | IngestFile FilePath
+  | IngestDir FilePath
   | Csv
   | Json
   | Ndjson
@@ -820,6 +824,10 @@ commandParser conf =
         (metavar "FILEPATH" <> help "Path to import file"))
         "Import a .json or .eml file containing one task")
 
+    <> command "importdir" (toParserInfo (ImportDir <$> strArgument
+        (metavar "DIRECTORY_PATH" <> help "Path to directory"))
+        "Import all .json and .eml files in a directory")
+
     <> command "importjson" (toParserInfo (pure ImportJson)
         "Import one JSON object from stdin")
 
@@ -831,6 +839,10 @@ commandParser conf =
         ("Ingest a .json or .eml file containing one task "
           <> "(import, open in editor, delete the original file)"))
 
+    <> command "ingestdir" (toParserInfo (IngestDir <$> strArgument
+        (metavar "DIRECTORY_PATH" <> help "Path to directory"))
+        "Ingest all .json and .eml files in a directory")
+
     <> command "csv" (toParserInfo (pure Csv)
         "Show tasks in CSV format")
 
@@ -1187,9 +1199,11 @@ executeCLiCommand conf now connection progName args = do
         Notes -> listNotes conf connection
         Stats -> getStats conf connection
         ImportFile filePath -> importFile conf connection filePath
+        ImportDir filePath -> importDir conf connection filePath
         ImportJson -> importJson conf connection
         ImportEml -> importEml conf connection
         IngestFile filePath -> ingestFile conf connection filePath
+        IngestDir filePath -> ingestDir conf connection filePath
         Csv -> dumpCsv conf
         Json -> dumpJson conf
         Ndjson -> dumpNdjson conf

diff --git a/tasklite-core/source/ImportExport.hs b/tasklite-core/source/ImportExport.hs
@@ -32,6 +32,7 @@ import Protolude (
   putErrLn,
   rightToMaybe,
   show,
+  stderr,
   toStrict,
   ($),
   (&),
@@ -47,6 +48,7 @@ import Protolude qualified as P
 
 import Config (Config (dataDir, dbName))
 import Control.Arrow ((>>>))
+import Control.Monad.Catch (catchAll)
 import Data.Aeson (Value)
 import Data.Aeson as Aeson (
   FromJSON (parseJSON),
@@ -92,14 +94,15 @@ import Note (Note (..))
 import Prettyprinter (
   Doc,
   Pretty (pretty),
+  annotate,
   dquotes,
   hardline,
   vsep,
   (<+>),
  )
-import Prettyprinter.Render.Terminal (AnsiStyle)
-import System.Directory (createDirectoryIfMissing, removeFile)
-import System.FilePath (takeExtension, (</>))
+import Prettyprinter.Render.Terminal (AnsiStyle, Color (Red), color, hPutDoc)
+import System.Directory (createDirectoryIfMissing, listDirectory, removeFile)
+import System.FilePath (isExtensionOf, takeExtension, (</>))
 import System.Posix.User (getEffectiveUserName)
 import System.Process (readProcess)
 import Task (
@@ -646,61 +649,107 @@ emailToImportTask email@(Message headerFields msgBody) =
     foldl addHeaderToTask (addBody emptyImportTask) headerFields
 
 
-importFile :: Config -> Connection -> FilePath -> IO (Doc AnsiStyle)
-importFile _ connection filePath = do
-  content <- BSL.readFile filePath
+isDirError :: FilePath -> P.SomeException -> IO (Doc AnsiStyle)
+isDirError filePath exception = do
+  if "is a directory" `T.isInfixOf` show exception
+    then do
+      hPutDoc stderr $
+        annotate (color Red) $
+          ("ERROR: \"" <> pretty filePath <> "\" is a directory. ")
+            <> "Use `importdir` instead."
+      die ""
+    else die $ show exception
 
-  let
-    fileExt = takeExtension filePath
-
-  case fileExt of
-    ".json" -> do
-      let decodeResult = Aeson.eitherDecode content :: Either [Char] ImportTask
-      case decodeResult of
-        Left error ->
-          die $ T.pack error <> " in task \n" <> show content
-        Right importTaskRec -> do
-          importTaskNorm <- importTaskRec & setMissingFields
-          insertImportTask connection importTaskNorm
-    ".eml" ->
-      case Parsec.parse message filePath content of
-        Left error -> die $ show error
-        Right email -> insertImportTask connection $ emailToImportTask email
-    _ -> die $ T.pack $ "File type " <> fileExt <> " is not supported"
+
+importFile :: Config -> Connection -> FilePath -> IO (Doc AnsiStyle)
+importFile _ conn filePath = do
+  catchAll
+    ( do
+        content <- BSL.readFile filePath
+        let fileExt = filePath & takeExtension
+        case fileExt of
+          ".json" -> do
+            let decodeResult = Aeson.eitherDecode content
+            case decodeResult of
+              Left error ->
+                die $ T.pack error <> " in task \n" <> show content
+              Right importTaskRec -> do
+                importTaskNorm <- importTaskRec & setMissingFields
+                insertImportTask conn importTaskNorm
+          ".eml" ->
+            case Parsec.parse message filePath content of
+              Left error -> die $ show error
+              Right email -> insertImportTask conn $ emailToImportTask email
+          _ ->
+            die $ T.pack $ "File type " <> fileExt <> " is not supported"
+    )
+    (isDirError filePath)
+
+
+filterImportable :: FilePath -> Bool
+filterImportable filePath =
+  (".json" `isExtensionOf` filePath)
+    || (".eml" `isExtensionOf` filePath)
+
+
+importDir :: Config -> Connection -> FilePath -> IO (Doc AnsiStyle)
+importDir conf connection dirPath = do
+  files <- listDirectory dirPath
+  resultDocs <-
+    files
+      & P.filter filterImportable
+      <&> (dirPath </>)
+      & P.mapM (importFile conf connection)
+  pure $ P.fold resultDocs
 
 
 ingestFile :: Config -> Connection -> FilePath -> IO (Doc AnsiStyle)
 ingestFile _config connection filePath = do
-  content <- BSL.readFile filePath
-
-  resultDocs <- case takeExtension filePath of
-    ".json" -> do
-      let decodeResult = Aeson.eitherDecode content :: Either [Char] ImportTask
-      case decodeResult of
-        Left error ->
-          die $ T.pack error <> " in task \n" <> show content
-        Right importTaskRec -> do
-          importTaskNorm <- importTaskRec & setMissingFields
-          sequence
-            [ insertImportTask connection importTaskNorm
-            , editTaskByTask OpenEditor connection importTaskNorm.task
-            ]
-    ".eml" ->
-      case Parsec.parse message filePath content of
-        Left error -> die $ show error
-        Right email -> do
-          let taskRecord@ImportTask{task} = emailToImportTask email
-          sequence
-            [ insertImportTask connection taskRecord
-            , editTaskByTask OpenEditor connection task
-            ]
-    fileExt -> die $ T.pack $ "File type " <> fileExt <> " is not supported"
-
-  removeFile filePath
-
-  pure $
-    P.fold resultDocs
-      <> ("❌ Deleted file" <+> dquotes (pretty filePath))
+  catchAll
+    ( do
+        content <- BSL.readFile filePath
+        resultDocs <- case takeExtension filePath of
+          ".json" -> do
+            let decodeResult = Aeson.eitherDecode content
+            case decodeResult of
+              Left error ->
+                die $ T.pack error <> " in task \n" <> show content
+              Right importTaskRec -> do
+                importTaskNorm <- importTaskRec & setMissingFields
+                sequence
+                  [ insertImportTask connection importTaskNorm
+                  , editTaskByTask OpenEditor connection importTaskNorm.task
+                  ]
+          ".eml" ->
+            case Parsec.parse message filePath content of
+              Left error -> die $ show error
+              Right email -> do
+                let taskRecord@ImportTask{task} = emailToImportTask email
+                sequence
+                  [ insertImportTask connection taskRecord
+                  , editTaskByTask OpenEditor connection task
+                  ]
+          fileExt ->
+            die $ T.pack $ "File type " <> fileExt <> " is not supported"
+
+        removeFile filePath
+
+        pure $
+          P.fold resultDocs
+            <> ("❌ Deleted file" <+> dquotes (pretty filePath))
+    )
+    (isDirError filePath)
+
+
+ingestDir :: Config -> Connection -> FilePath -> IO (Doc AnsiStyle)
+ingestDir conf connection dirPath = do
+  files <- listDirectory dirPath
+  resultDocs <-
+    files
+      & P.filter filterImportable
+      <&> (dirPath </>)
+      & P.mapM (importFile conf connection)
+  pure $ P.fold resultDocs
 
 
 -- TODO: Use Task instead of FullTask to fix broken notes export