taskell 1.10.1 → 1.11.0
raw patch · 2 files changed
+84/−71 lines, 2 filesdep ~aesondep ~attoparsecdep ~base
Dependency ranges changed: aeson, attoparsec, base, brick, bytestring, classy-prelude, config-ini, containers, directory, file-embed, fold-debounce, http-client, http-conduit, http-types, lens, mtl, raw-strings-qq, tasty, tasty-discover, tasty-expected-failure, tasty-hunit, template-haskell, text, time, tz, vty
Files
- src/Taskell/IO.hs +43/−30
- taskell.cabal +41/−41
src/Taskell/IO.hs view
@@ -4,7 +4,8 @@ import Control.Monad.Reader (runReader) import Data.Text.Encoding (decodeUtf8With)-import System.Directory (doesFileExist, getCurrentDirectory)+import System.Directory (doesFileExist, doesDirectoryExist, canonicalizePath, makeRelativeToCurrentDirectory)+import Data.Either (fromRight) import Data.Time.Zones (TZ) @@ -38,14 +39,23 @@ Lists | Exit ++getPath :: Text -> ReaderConfig FilePath+getPath path = do+ config <- asks ioConfig+ canonicial <- lift $ canonicalizePath (unpack path)+ let defaultFilename = filename (general config)+ isDir <- lift $ doesDirectoryExist canonicial+ pure $ if isDir then canonicial </> defaultFilename else canonicial+ parseArgs :: [Text] -> ReaderConfig Next parseArgs ["-v"] = pure $ Output version parseArgs ["-h"] = pure $ Output usage-parseArgs ["-t", boardID, file] = loadTrello boardID file-parseArgs ["-g", identifier, file] = loadGitHub identifier file-parseArgs ["-i", file] = fileInfo file-parseArgs [file] = loadFile file-parseArgs [] = (pack . filename . general <$> asks ioConfig) >>= loadFile+parseArgs ["-t", boardID, file] = getPath file >>= loadTrello boardID+parseArgs ["-g", identifier, file] = getPath file >>= loadGitHub identifier+parseArgs ["-i", file] = getPath file >>= fileInfo+parseArgs [file] = getPath file >>= loadFile+parseArgs [] = getPath "" >>= loadFile parseArgs _ = pure $ Error (unlines ["Invalid options", "", usage]) load :: ReaderConfig Next@@ -54,34 +64,41 @@ colonic :: FilePath -> Text -> Text colonic path = ((pack path <> ": ") <>) -loadFile :: Text -> ReaderConfig Next+createLoad :: FilePath -> Lists -> ReaderConfig Next+createLoad path lists = do+ relative <- lift $ makeRelativeToCurrentDirectory path+ pure $ Load relative lists++loadFile :: FilePath -> ReaderConfig Next loadFile filepath = do mPath <- exists filepath case mPath of Nothing -> pure Exit- Just path -> either (Error . colonic path) (Load path) <$> readData path+ Just path -> do+ lists <- readData path+ case lists of+ Left err -> pure $ Error (colonic path err)+ Right ls -> createLoad path ls -loadRemote :: (token -> FilePath -> ReaderConfig Next) -> token -> Text -> ReaderConfig Next-loadRemote createFn identifier filepath = do- let path = unpack filepath+loadRemote :: (token -> FilePath -> ReaderConfig Next) -> token -> FilePath -> ReaderConfig Next+loadRemote createFn identifier path = do exists' <- fileExists path if exists'- then pure $ Error (filepath <> " already exists")+ then pure $ Error (pack path <> " already exists") else createFn identifier path -loadTrello :: Trello.TrelloBoardID -> Text -> ReaderConfig Next+loadTrello :: Trello.TrelloBoardID -> FilePath -> ReaderConfig Next loadTrello = loadRemote createTrello -loadGitHub :: GitHub.GitHubIdentifier -> Text -> ReaderConfig Next+loadGitHub :: GitHub.GitHubIdentifier -> FilePath -> ReaderConfig Next loadGitHub = loadRemote createGitHub -fileInfo :: Text -> ReaderConfig Next-fileInfo filepath = do- let path = unpack filepath+fileInfo :: FilePath -> ReaderConfig Next+fileInfo path = do exists' <- fileExists path if exists'- then either (Error . colonic path) (Output . analyse filepath) <$> readData path- else pure $ Error (filepath <> " does not exist")+ then either (Error . colonic path) (Output . analyse (pack path)) <$> readData path+ else pure $ Error (pack path <> " does not exist") createRemote :: (Config -> Maybe token)@@ -99,9 +116,8 @@ lists <- lift $ runReaderT (getFn identifier) token case lists of Left txt -> pure $ Error txt- Right ls ->- promptCreate path >>=- bool (pure Exit) (Load path ls <$ lift (writeData tz config ls path))+ Right ls -> do+ promptCreate path >>= bool (pure Exit) (lift (writeData tz config ls path) >> createLoad path ls) createTrello :: Trello.TrelloBoardID -> FilePath -> ReaderConfig Next createTrello = createRemote (Trello.token . trello) trelloUsage Trello.getLists@@ -109,9 +125,8 @@ createGitHub :: GitHub.GitHubIdentifier -> FilePath -> ReaderConfig Next createGitHub = createRemote (GitHub.token . github) githubUsage GitHub.getLists -exists :: Text -> ReaderConfig (Maybe FilePath)-exists filepath = do- let path = unpack filepath+exists :: FilePath -> ReaderConfig (Maybe FilePath)+exists path = do exists' <- fileExists path if exists' then pure $ Just path@@ -121,17 +136,15 @@ fileExists path = lift $ doesFileExist path promptCreate :: FilePath -> ReaderConfig Bool-promptCreate path = do- cwd <- lift $ pack <$> getCurrentDirectory- lift $ promptYN PromptYes $ concat ["Create ", cwd, "/", pack path, "?"]+promptCreate path = lift $ promptYN PromptYes $ concat ["Create ", pack path, "?"] -- creates taskell file createPath :: FilePath -> ReaderConfig () createPath path = do config <- asks ioConfig tz <- asks ioTZ- template <- readData =<< templatePath <$> lift getDir- let ls = either (const initial) id template+ template <- readData . templatePath =<< lift getDir+ let ls = fromRight initial template lift (writeData tz config ls path) -- writes Tasks to json file
taskell.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: taskell-version: 1.10.1+version: 1.11.0 license: BSD3 license-file: LICENSE copyright: 2019 Mark Wales@@ -116,27 +116,27 @@ RankNTypes build-depends:- aeson >=1.4.7.1 && <1.5,- attoparsec >=0.13.2.4 && <0.14,- base >=4.13.0.0 && <=5,- brick >=0.52.1 && <0.53,- bytestring >=0.10.10.1 && <0.11,- classy-prelude >=1.5.0 && <1.6,- config-ini >=0.2.4.0 && <0.3,- containers >=0.6.2.1 && <0.7,- directory >=1.3.6.0 && <1.4,- file-embed >=0.0.11.2 && <0.1,- fold-debounce >=0.2.0.9 && <0.3,- http-client >=0.6.4.1 && <0.7,- http-conduit >=2.3.7.3 && <2.4,- http-types >=0.12.3 && <0.13,- lens >=4.18.1 && <4.19,- mtl >=2.2.2 && <2.3,- template-haskell >=2.15.0.0 && <2.16,- text >=1.2.4.0 && <1.3,- time >=1.9.3 && <1.10,- tz >=0.1.3.3 && <0.2,- vty >=5.28.2 && <5.29+ aeson >=1.5.6.0,+ attoparsec >=0.13.2.5,+ base >=4.14.1.0 && <=5,+ brick >=0.58.1,+ bytestring >=0.10.12.0,+ classy-prelude >=1.5.0,+ config-ini >=0.2.4.0,+ containers >=0.6.2.1,+ directory >=1.3.6.0,+ file-embed >=0.0.13.0,+ fold-debounce >=0.2.0.9,+ http-client >=0.6.4.1,+ http-conduit >=2.3.8,+ http-types >=0.12.3,+ lens >=4.19.2,+ mtl >=2.2.2,+ template-haskell >=2.16.0.0,+ text >=1.2.4.1,+ time >=1.9.3,+ tz >=0.1.3.5,+ vty >=5.32 executable taskell main-is: Main.hs@@ -149,10 +149,10 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends:- base >=4.13.0.0 && <4.14,- classy-prelude >=1.5.0 && <1.6,+ base >=4.14.1.0,+ classy-prelude >=1.5.0, taskell -any,- tz >=0.1.3.3 && <0.2+ tz >=0.1.3.5 test-suite taskell-test type: exitcode-stdio-1.0@@ -187,20 +187,20 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends:- aeson >=1.4.7.1 && <1.5,- base >=4.13.0.0 && <4.14,- classy-prelude >=1.5.0 && <1.6,- containers >=0.6.2.1 && <0.7,- file-embed >=0.0.11.2 && <0.1,- lens >=4.18.1 && <4.19,- mtl >=2.2.2 && <2.3,- raw-strings-qq ==1.1.*,+ aeson >=1.5.6.0,+ base >=4.14.1.0,+ classy-prelude >=1.5.0,+ containers >=0.6.2.1,+ file-embed >=0.0.13.0,+ lens >=4.19.2,+ mtl >=2.2.2,+ raw-strings-qq >=1.1, taskell -any,- tasty >=1.2.3 && <1.3,- tasty-discover >=4.2.1 && <4.3,- tasty-expected-failure >=0.11.1.2 && <0.12,- tasty-hunit >=0.10.0.2 && <0.11,- text >=1.2.4.0 && <1.3,- time >=1.9.3 && <1.10,- tz >=0.1.3.3 && <0.2,- vty >=5.28.2 && <5.29+ tasty >=1.2.3,+ tasty-discover >=4.2.2,+ tasty-expected-failure >=0.12.3,+ tasty-hunit >=0.10.0.3,+ text >=1.2.4.1,+ time >=1.9.3,+ tz >=0.1.3.5,+ vty >=5.32