From 8a821de5a90c08d63f90f0b13bc0e7a515e9fab3 Mon Sep 17 00:00:00 2001 From: Adrian Sieber Date: Fri, 10 Apr 2020 21:56:40 +0000 Subject: [PATCH] Feat: Add support for importing .json and .eml files --- stack.yaml | 1 + stack.yaml.lock | 7 ++ tasklite-core/app/Main.hs | 8 +- tasklite-core/package.yaml | 4 + tasklite-core/source/ImportExport.hs | 124 ++++++++++++++++++++++++++- tasklite-core/source/Lib.hs | 2 +- tasklite-core/source/Task.hs | 12 +++ tasklite-core/source/Utils.hs | 7 ++ 8 files changed, 159 insertions(+), 6 deletions(-) diff --git a/stack.yaml b/stack.yaml index a02118d..c4ea599 100644 --- a/stack.yaml +++ b/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 diff --git a/stack.yaml.lock b/stack.yaml.lock index 3700893..fafc983 100644 --- a/stack.yaml.lock +++ b/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: diff --git a/tasklite-core/app/Main.hs b/tasklite-core/app/Main.hs index 5f59d38..a5526e6 100644 --- a/tasklite-core/app/Main.hs +++ b/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 diff --git a/tasklite-core/package.yaml b/tasklite-core/package.yaml index e612216..c9ea9da 100644 --- a/tasklite-core/package.yaml +++ b/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 diff --git a/tasklite-core/source/ImportExport.hs b/tasklite-core/source/ImportExport.hs index 7be07c8..83ef685 100644 --- a/tasklite-core/source/ImportExport.hs +++ b/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 diff --git a/tasklite-core/source/Lib.hs b/tasklite-core/source/Lib.hs index 50f5aa2..2b356fb 100644 --- a/tasklite-core/source/Lib.hs +++ b/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 diff --git a/tasklite-core/source/Task.hs b/tasklite-core/source/Task.hs index 20dd042..657eb4e 100644 --- a/tasklite-core/source/Task.hs +++ b/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) + } diff --git a/tasklite-core/source/Utils.hs b/tasklite-core/source/Utils.hs index 9529118..1372a04 100644 --- a/tasklite-core/source/Utils.hs +++ b/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)) =