Feat: Add support for importing .json and .eml files

stack.yaml

@@ -9,6 +9,7 @@ packages:
 extra-deps:
   - gi-gtk-declarative-0.4.2
   - gi-gtk-declarative-app-simple-0.4.1
+  - portable-lines-0.1
   - ulid-0.3.0.0
   - github: JakeWheat/simple-sql-parser
     commit: 00433a26e8303c9e61359f406da5a2dbf1293fc8

stack.yaml.lock

@@ -18,6 +18,13 @@ packages:
       sha256: 3e2ca55f6838ad1fb9e54c4b7a0ec91fb78321a77d6cf27cc59d10750b8da39f
   original:
     hackage: gi-gtk-declarative-app-simple-0.4.1
+- completed:
+    hackage: portable-lines-0.1@sha256:21c3b905888a4b43f957cd8e8cdf2af00942bb161aa19a6b20db18b661de0510,1552
+    pantry-tree:
+      size: 371
+      sha256: 2eeb1d9aefe4fb172dc56baa75f09aaaac824799d926922b4673188293f9f95c
+  original:
+    hackage: portable-lines-0.1
 - completed:
     hackage: ulid-0.3.0.0@sha256:f0eff432ed0f0d0b71be0fd7f45acb54d87aebc4e1e153d2c2e1be4b09eb20b5,2918
     pantry-tree:

tasklite-core/app/Main.hs

@@ -91,6 +91,7 @@ data Command
 
   {- I/O -}
   | Import
+  | ImportFile FilePath
   | Csv
   | Ndjson
   | Sql
@@ -571,6 +572,10 @@ commandParser conf =
     <> command "import" (toParserInfo (pure Import)
         "Import one JSON task from stdin")
 
+    <> command "importfile" (toParserInfo (ImportFile <$> strArgument
+        (metavar "FILEPATH" <> help "Path to import file"))
+        "Import a .json or .eml file containing one task")
+
     <> command "csv" (toParserInfo (pure Csv)
         "Show tasks in CSV format")
 
@@ -825,7 +830,8 @@ executeCLiCommand conf now connection cmd =
     Tags -> listTags conf connection
     Projects -> listProjects conf connection
     Stats -> getStats conf connection
-    Import -> importTask conf
+    Import -> importTask conf connection
+    ImportFile filePath -> importFile conf connection filePath
     Csv -> dumpCsv conf
     Ndjson -> dumpNdjson conf
     Sql -> dumpSql conf

tasklite-core/package.yaml

@@ -33,8 +33,11 @@ dependencies:
   - generic-random
   - githash
   - hourglass
+  - hsemail
   - huzzy
   - optparse-applicative
+  - parsec
+  - portable-lines
   - prettyprinter
   - prettyprinter-ansi-terminal
   - process
@@ -45,6 +48,7 @@ dependencies:
   - simple-sql-parser
   - sqlite-simple
   - text
+  - time
   - ulid
   - unix
   - unordered-containers

tasklite-core/source/ImportExport.hs

@@ -11,21 +11,29 @@ import Data.Aeson.Types
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.Csv as Csv
 import qualified Data.HashMap.Strict as HM
+import qualified Data.HashMap.Lazy as HML
 import Data.Hourglass
 import qualified Data.Text as T
 import qualified Data.Text.Lazy.Encoding as TL
 import Data.Text.Prettyprint.Doc hiding ((<>))
 import Data.Text.Prettyprint.Doc.Render.Terminal
+import Data.Time.LocalTime (zonedTimeToUTC)
+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
 import Data.ULID
+import qualified Data.Vector as V
 import Data.Yaml as Yaml
 import Database.Beam
 import Database.SQLite.Simple as Sql
 import Lib
 import System.Directory
-import System.FilePath ((</>))
+import System.FilePath ((</>), takeExtension)
 import System.Process
 import System.Posix.User (getEffectiveUserName)
 import System.ReadEditor (readEditorWith)
+import Text.ParserCombinators.Parsec as Parsec (parse)
+import qualified Text.Parsec.Rfc2822 as Email
+import Text.Parsec.Rfc2822 (GenericMessage(..), message)
+import Text.PortableLines.ByteString.Lazy (lines8)
 import Time.System
 import Utils
 import Task
@@ -73,6 +81,14 @@ data ImportTask = ImportTask
   } deriving Show
 
 
+emptyImportTask :: ImportTask
+emptyImportTask = ImportTask
+  { task = zeroTask
+  , notes = []
+  , tags = []
+  }
+
+
 -- | Values a suffixed with a prime (') to avoid name collisions
 instance FromJSON ImportTask where
   parseJSON = withObject "task" $ \o -> do
@@ -272,9 +288,8 @@ insertImportTask connection importTaskRecord = do
     <+> hardline
 
 
-importTask :: Config -> IO (Doc AnsiStyle)
-importTask conf = do
-  connection <- setupConnection conf
+importTask :: Config -> Connection -> IO (Doc AnsiStyle)
+importTask _ connection = do
   content <- BSL.getContents
 
   let
@@ -285,6 +300,107 @@ importTask conf = do
     Right importTaskRecord -> insertImportTask connection importTaskRecord
 
 
+emailToImportTask :: GenericMessage BSL.ByteString -> ImportTask
+emailToImportTask email@(Message headerFields msgBody) =
+  let
+    addBody (ImportTask task notes tags) = ImportTask
+      task {Task.body = Task.body task <> (msgBody
+        & lines8
+        <&> TL.decodeUtf8
+        <&> toStrict
+        & T.unlines
+        & T.dropEnd 1
+      )}
+      notes
+      tags
+
+    namesToJson names = Array $ V.fromList $ names
+      <&> (\(Email.NameAddr name emailAddress) -> Object $ HML.fromList $
+              [ ("name", Aeson.String $ T.pack $ fromMaybe "" name)
+              , ("email", Aeson.String $ T.pack emailAddress)
+              ])
+
+    addHeaderToTask :: ImportTask -> Email.Field -> ImportTask
+    addHeaderToTask impTask@(ImportTask task notes tags) headerValue =
+      case headerValue of
+        Email.Date emailDate ->
+          let
+            utc = emailDate
+              & zonedTimeToUTC
+              & utcTimeToPOSIXSeconds
+              & toRational
+              & rationalToElapsedP
+              & timeFromElapsedP
+              :: DateTime
+            Right ulidGenerated =
+              (ulidFromInteger . abs . toInteger . hash) $ (show email :: Text)
+            ulidCombined = setDateTime ulidGenerated utc
+          in
+            ImportTask
+              task { Task.ulid = T.toLower $ show ulidCombined
+                    , Task.modified_utc =
+                        T.pack $ timePrint (toFormat importUtcFormat) utc
+                    }
+              notes
+              tags
+
+        Email.From names -> ImportTask
+          (setMetadataField "from" (namesToJson names) task)
+          notes
+          tags
+
+        Email.To names -> ImportTask
+          (setMetadataField "to" (namesToJson names) task)
+          notes
+          tags
+
+        Email.MessageID msgId -> ImportTask
+          (setMetadataField "messageId" (Aeson.String $ T.pack msgId) task)
+          notes
+          tags
+
+        Email.Subject subj -> ImportTask
+          task {Task.body = Task.body task <> T.pack subj}
+          notes
+          tags
+
+        Email.Keywords kwords -> ImportTask task notes
+          (tags <> fmap (T.unwords . fmap T.pack) kwords)
+
+        Email.Comments cmnts -> ImportTask
+          (setMetadataField "comments" (Aeson.String $ T.pack cmnts) task)
+          notes
+          tags
+
+        _ -> impTask
+  in
+    foldl addHeaderToTask (addBody emptyImportTask) headerFields
+
+
+importFile :: Config -> Connection -> FilePath -> IO (Doc AnsiStyle)
+importFile _ connection filePath = do
+  content <- BSL.readFile filePath
+
+  let
+    fileExt = takeExtension filePath
+
+  case fileExt of
+    ".json" ->
+      let decodeResult = Aeson.eitherDecode content :: Either [Char] ImportTask
+      in case decodeResult of
+            Left error ->
+              die $ (T.pack error) <> " in task \n" <> show content
+            Right importTaskRecord ->
+              insertImportTask connection importTaskRecord
+
+    ".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"
+
+
 -- TODO: Use Task instead of FullTask to fix broken notes export
 dumpCsv :: Config -> IO (Doc AnsiStyle)
 dumpCsv conf = do

tasklite-core/source/Lib.hs

@@ -884,7 +884,7 @@ findTask connection aPattern = do
 
     -- | Calculate fuzzy score for each part individually
     -- and pick the highest one
-    scoreFunc = \(ulid, theBody, mbTags, mbNotes, mbMetadata) ->
+    scoreFunc = \(ulid, theBody, _, mbNotes, mbMetadata) ->
       let
         scoreParts =
           [ matchFunc theBody

tasklite-core/source/Task.hs

@@ -13,6 +13,7 @@ import Data.Hourglass (DateTime, timePrint)
 import Data.Yaml as Yaml
 import qualified Data.ByteString.Lazy as BSL
 import Data.Csv as Csv
+import Data.HashMap.Lazy as HML
 import Data.Text as T
 import Data.Text.Prettyprint.Doc hiding ((<>))
 import qualified Data.Vector as V
@@ -318,3 +319,14 @@ zeroTask = Task
   , user = ""
   , metadata = Nothing
   }
+
+
+setMetadataField :: Text -> Value -> Task -> Task
+setMetadataField fieldName value task =
+  task {metadata = (case metadata task of
+      Just (Object obj) ->
+        Just $ Object $ HML.insert fieldName value obj
+      Nothing ->
+        Just $ Object $ HML.fromList [(fieldName, value)]
+      _ -> metadata task)
+  }

tasklite-core/source/Utils.hs

@@ -97,6 +97,13 @@ parseUlidText ulidText = do
   pure $ ULID ulidTime ulidRandom
 
 
+-- TODO: Remove after https://github.com/vincenthz/hs-hourglass/issues/52
+rationalToElapsedP :: Rational -> ElapsedP
+rationalToElapsedP secondsFrac =
+  let (sec, nanoSec) = properFraction secondsFrac
+  in ElapsedP (Elapsed (Seconds sec)) (NanoSeconds $ truncate $ nanoSec * 1e9)
+
+
 -- TODO: Remove after https://github.com/vincenthz/hs-hourglass/issues/45
 elapsedPToRational :: ElapsedP -> Rational
 elapsedPToRational (ElapsedP (Elapsed (Seconds s)) (NanoSeconds ns)) =