diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -51,12 +51,22 @@ ### Fedora -Run `sudo dnf install ncurses-compat-libs` then download and run binary as described below. +Not officially supported, but try running `sudo dnf install ncurses-compat-libs` then download and run the binary as described below. If that doesn't work you may need to build from scratch ([Cabal](#cabal)/[Stack](#stack)). ### Binaries -[A binary is available for Mac and Linux](https://github.com/smallhadroncollider/taskell/releases). Download it and copy it to a directory in your `$PATH` (e.g. `/usr/local/bin` or `/usr/bin`). +[A binary is available for Mac and Debian/Ubuntu](https://github.com/smallhadroncollider/taskell/releases). Download it and copy it to a directory in your `$PATH` (e.g. `/usr/local/bin` or `/usr/bin`). +### Cabal + +You can install Taskell with `cabal`: + +```bash +cabal install taskell +``` + +Make sure you run `cabal update` if you haven't run it recently. + ### Stack If none of the above options work you can build taskell using [Stack](https://docs.haskellstack.org/en/stable/README/). First [install Stack on your machine](https://docs.haskellstack.org/en/stable/README/#how-to-install). Then clone the repo and run `stack build && stack install`: this will build taskell and then install it in `~/.local/bin` (so make sure that directory is in your `$PATH`). Building from scratch can take a long time and occasionally doesn't work the first time (if this happens try running it again). @@ -192,8 +202,10 @@ ## Configuration -You can edit Taskell's settings by editing `~/.taskell/config.ini`: +Taskell uses the [XDG Base Directory Specification](https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html), so it will look for an `$XDG_CONFIG_HOME` environmental variable and create a directory named `taskell` inside it. If this variable is not found it will create the `taskell` directory in `~/.config/`. (If you've been using Taskell since <= 1.3.5 then it will be in a `~/.taskell` directory, feel free to move this to the XDG directory.) +Taskell has a `config.ini` file: + ```ini [general] ; the default filename to create/look for @@ -241,7 +253,7 @@ ### Theming -You can edit Taskell's colour-scheme by editing `~/.taskell/theme.ini`: +You can edit Taskell's colour-scheme by editing `theme.ini`: ```ini [other] diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -15,6 +15,6 @@ config <- setup next <- runReaderT load config case next of - Exit -> return () + Exit -> pure () Output text -> putStrLn text Load path lists -> go config $ create path lists diff --git a/src/App.hs b/src/App.hs --- a/src/App.hs +++ b/src/App.hs @@ -56,7 +56,7 @@ } Debounce.def let send = Debounce.send trigger - return (send, trigger) + pure (send, trigger) -- cache clearing clearCache :: State -> EventM ResourceName () @@ -88,19 +88,19 @@ Search _ _ -> invalidateCache (Modal MoveTo) -> clearAllTitles previousState (Insert ITask ICreate _) -> clearList previousState - _ -> return () + _ -> pure () case state ^. mode of - Shutdown -> liftIO (Debounce.close trigger) >> Brick.halt state - (Modal MoveTo) -> clearAllTitles state >> next send state - (Insert ITask ICreate _) -> clearList state >> next send state - _ -> clearCache previousState >> clearCache state >> next send state + Shutdown -> liftIO (Debounce.close trigger) *> Brick.halt state + (Modal MoveTo) -> clearAllTitles state *> next send state + (Insert ITask ICreate _) -> clearList state *> next send state + _ -> clearCache previousState *> clearCache state *> next send state handleEvent :: (DebouncedWrite, Trigger) -> State -> BrickEvent ResourceName e -> EventM ResourceName (Next State) -handleEvent _ state (VtyEvent (EvResize _ _)) = invalidateCache >> Brick.continue state +handleEvent _ state (VtyEvent (EvResize _ _)) = invalidateCache *> Brick.continue state handleEvent db state (VtyEvent ev) = handleVtyEvent db state ev handleEvent _ state _ = Brick.continue state @@ -111,7 +111,7 @@ vty <- getVtyHandle let output = outputIface vty when (supportsMode output BracketedPaste) $ liftIO $ setMode output BracketedPaste True - return state + pure state -- | Sets up Brick go :: Config -> State -> IO () diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -9,7 +9,7 @@ import Data.FileEmbed (embedFile) version :: Text -version = "1.3.5" +version = "1.3.6" usage :: Text usage = decodeUtf8 $(embedFile "templates/usage.txt") diff --git a/src/Data/Taskell/List/Internal.hs b/src/Data/Taskell/List/Internal.hs --- a/src/Data/Taskell/List/Internal.hs +++ b/src/Data/Taskell/List/Internal.hs @@ -44,7 +44,7 @@ extract :: Int -> List -> Maybe (List, T.Task) extract idx list = do (xs, x) <- S.extract idx (list ^. tasks) - return (list & tasks .~ xs, x) + pure (list & tasks .~ xs, x) updateFn :: Int -> T.Update -> Update updateFn idx fn = tasks %~ adjust' fn idx diff --git a/src/Data/Taskell/Lists/Internal.hs b/src/Data/Taskell/Lists/Internal.hs --- a/src/Data/Taskell/Lists/Internal.hs +++ b/src/Data/Taskell/Lists/Internal.hs @@ -32,7 +32,7 @@ let next = list + dir (from, task) <- extract idx =<< tasks !? list -- extract current task to <- append task <$> tasks !? next -- get next list and append task - return . updateLists next to $ updateLists list from tasks -- update lists + pure . updateLists next to $ updateLists list from tasks -- update lists newList :: Text -> Update newList title = (|> empty title) @@ -54,7 +54,7 @@ fromMaybe lists $ do let idx = length lists - 1 list <- append task <$> lists !? idx - return $ updateLists idx list lists + pure $ updateLists idx list lists analyse :: Text -> Lists -> Text analyse filepath lists = diff --git a/src/Data/Taskell/Seq.hs b/src/Data/Taskell/Seq.hs --- a/src/Data/Taskell/Seq.hs +++ b/src/Data/Taskell/Seq.hs @@ -12,4 +12,4 @@ shiftBy :: Int -> Int -> Seq a -> Maybe (Seq a) shiftBy idx dir xs = do (a, current) <- extract idx xs - return $ insertAt (idx + dir) current a + pure $ insertAt (idx + dir) current a diff --git a/src/Events/Actions.hs b/src/Events/Actions.hs --- a/src/Events/Actions.hs +++ b/src/Events/Actions.hs @@ -27,7 +27,7 @@ Search {} -> Search.event e state Insert {} -> Insert.event e state Modal {} -> Modal.event e state - _ -> return state + _ -> pure state -- returns new state if successful event :: Event -> State -> State diff --git a/src/Events/Actions/Insert.hs b/src/Events/Actions/Insert.hs --- a/src/Events/Actions/Insert.hs +++ b/src/Events/Actions/Insert.hs @@ -24,15 +24,15 @@ (write =<<) . (below =<<) . (removeBlank =<<) . (store =<<) $ finishTask state Insert ITask IEdit _ -> (write =<<) . (removeBlank =<<) . (normalMode =<<) $ finishTask state - _ -> return state + _ -> pure state event (EvKey KEsc _) state = case state ^. mode of Insert IList ICreate _ -> (normalMode =<<) . (write =<<) $ createList state Insert IList IEdit _ -> (write =<<) . (normalMode =<<) $ finishListTitle state Insert ITask _ _ -> (write =<<) . (removeBlank =<<) . (normalMode =<<) $ finishTask state - _ -> return state + _ -> pure state event e state = - return $ + pure $ case state ^. mode of Insert iType iMode field -> state & mode .~ Insert iType iMode (F.event e field) _ -> state diff --git a/src/Events/Actions/Modal.hs b/src/Events/Actions/Modal.hs --- a/src/Events/Actions/Modal.hs +++ b/src/Events/Actions/Modal.hs @@ -22,4 +22,4 @@ Modal Help -> Help.event e s Modal (Detail _ _) -> Detail.event e s Modal MoveTo -> MoveTo.event e s - _ -> return s + _ -> pure s diff --git a/src/Events/Actions/Modal/Detail.hs b/src/Events/Actions/Modal/Detail.hs --- a/src/Events/Actions/Modal/Detail.hs +++ b/src/Events/Actions/Modal/Detail.hs @@ -26,7 +26,7 @@ normal (EvKey (KChar 'D') _) = (write =<<) . (Detail.remove =<<) . store normal (EvKey (KChar 'u') _) = (write =<<) . undo normal (EvKey (KChar '@') _) = (editDue =<<) . store -normal _ = return +normal _ = pure insert :: Event -> Stateful insert (EvKey KEsc _) s = do diff --git a/src/Events/Actions/Modal/Help.hs b/src/Events/Actions/Modal/Help.hs --- a/src/Events/Actions/Modal/Help.hs +++ b/src/Events/Actions/Modal/Help.hs @@ -12,4 +12,4 @@ event :: Event -> Stateful event (EvKey (KChar 'q') _) = quit event (EvKey _ _) = normalMode -event _ = return +event _ = pure diff --git a/src/Events/Actions/Modal/MoveTo.hs b/src/Events/Actions/Modal/MoveTo.hs --- a/src/Events/Actions/Modal/MoveTo.hs +++ b/src/Events/Actions/Modal/MoveTo.hs @@ -13,4 +13,4 @@ event (EvKey KEsc _) = normalMode event (EvKey KEnter _) = normalMode event (EvKey (KChar c) _) = (normalMode =<<) . (write =<<) . (moveTo c =<<) . store -event _ = return +event _ = pure diff --git a/src/Events/Actions/Normal.hs b/src/Events/Actions/Normal.hs --- a/src/Events/Actions/Normal.hs +++ b/src/Events/Actions/Normal.hs @@ -58,6 +58,6 @@ -- selecting lists event (EvKey (KChar n) _) | isDigit n = selectList n - | otherwise = return + | otherwise = pure -- fallback -event _ = return +event _ = pure diff --git a/src/Events/Actions/Search.hs b/src/Events/Actions/Search.hs --- a/src/Events/Actions/Search.hs +++ b/src/Events/Actions/Search.hs @@ -19,7 +19,7 @@ search :: Event -> Stateful search (EvKey KEnter _) s = searchEntered s search e s = - return $ + pure $ case s ^. mode of Search ent field -> s & mode .~ Search ent (F.event e field) _ -> s @@ -34,4 +34,4 @@ else Normal.event) e s - _ -> return s + _ -> pure s diff --git a/src/Events/State.hs b/src/Events/State.hs --- a/src/Events/State.hs +++ b/src/Events/State.hs @@ -113,7 +113,7 @@ editListStart :: Stateful editListStart state = do f <- textToField . (^. title) <$> getList state - return $ state & mode .~ Insert IList IEdit f + pure $ state & mode .~ Insert IList IEdit f deleteCurrentList :: Stateful deleteCurrentList state = @@ -136,7 +136,7 @@ startEdit :: Stateful startEdit state = do field <- textToField . (^. name) <$> getCurrentTask state - return $ state & mode .~ Insert ITask IEdit field + pure $ state & mode .~ Insert ITask IEdit field finishTask :: Stateful finishTask state = @@ -173,7 +173,7 @@ clearItem = setCurrentTaskText "" bottom :: Stateful -bottom = return . selectLast +bottom = pure . selectLast selectLast :: InternalStateful selectLast state = setIndex state (countCurrent state - 1) @@ -183,7 +183,7 @@ currentTask <- getCurrentTask state (if isBlank currentTask then delete - else return) + else pure) state -- moving @@ -311,7 +311,7 @@ then Nothing else do s <- move' (li - cur) state - return . selectLast $ setCurrentList s li + pure . selectLast $ setCurrentList s li -- move lists listMove :: Int -> Stateful diff --git a/src/Events/State/Modal/Detail.hs b/src/Events/State/Modal/Detail.hs --- a/src/Events/State/Modal/Detail.hs +++ b/src/Events/State/Modal/Detail.hs @@ -38,7 +38,7 @@ updateField :: (Field -> Field) -> Stateful updateField fieldEvent s = - return $ + pure $ case s ^. mode of Modal (Detail detailItem (DetailInsert field)) -> s & mode .~ Modal (Detail detailItem (DetailInsert (fieldEvent field))) @@ -67,7 +67,7 @@ showDetail s = do _ <- getCurrentTask s let i = fromMaybe 0 $ getCurrentSubtask s - return $ s & mode .~ Modal (Detail (DetailItem i) DetailNormal) + pure $ s & mode .~ Modal (Detail (DetailItem i) DetailNormal) getCurrentSubtask :: State -> Maybe Int getCurrentSubtask state = @@ -120,13 +120,13 @@ editDescription state = do summ <- (^. description) <$> getCurrentTask state let summ' = fromMaybe "" summ - return $ state & mode .~ Modal (Detail DetailDescription (DetailInsert (textToField summ'))) + pure $ state & mode .~ Modal (Detail DetailDescription (DetailInsert (textToField summ'))) editDue :: Stateful editDue state = do day <- (^. due) <$> getCurrentTask state let day' = maybe "" dayToOutput day - return $ state & mode .~ Modal (Detail DetailDate (DetailInsert (textToField day'))) + pure $ state & mode .~ Modal (Detail DetailDate (DetailInsert (textToField day'))) newItem :: Stateful newItem state = do @@ -159,4 +159,4 @@ | i > lst = lst | i < 0 = 0 | otherwise = i - return $ state & mode .~ Modal (Detail (DetailItem newIndex) m) + pure $ state & mode .~ Modal (Detail (DetailItem newIndex) m) diff --git a/src/IO/Config.hs b/src/IO/Config.hs --- a/src/IO/Config.hs +++ b/src/IO/Config.hs @@ -6,8 +6,10 @@ import ClassyPrelude -import qualified Data.Text.IO as T (readFile) -import System.Directory (createDirectoryIfMissing, doesFileExist, getHomeDirectory) +import qualified Data.Text.IO as T (readFile) +import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, + getHomeDirectory) +import System.Environment (lookupEnv) import Brick (AttrMap) import Brick.Themes (loadCustomizations, themeToAttrMap) @@ -33,21 +35,32 @@ defaultConfig :: Config defaultConfig = Config - { general = General.defaultConfig - , layout = Layout.defaultConfig - , markdown = Markdown.defaultConfig - , trello = Trello.defaultConfig - , github = GitHub.defaultConfig - } + General.defaultConfig + Layout.defaultConfig + Markdown.defaultConfig + Trello.defaultConfig + GitHub.defaultConfig +directoryName :: FilePath +directoryName = "taskell" + +legacyConfigPath :: IO FilePath +legacyConfigPath = ( "." <> directoryName) <$> getHomeDirectory + +xdgDefaultConfig :: IO FilePath +xdgDefaultConfig = ( ".config" directoryName) <$> getHomeDirectory + +xdgConfigPath :: IO FilePath +xdgConfigPath = fromMaybe <$> xdgDefaultConfig <*> lookupEnv "XDG_CONFIG_HOME" + getDir :: IO FilePath -getDir = (++ "/.taskell") <$> getHomeDirectory +getDir = legacyConfigPath >>= doesDirectoryExist >>= bool xdgConfigPath legacyConfigPath getThemePath :: IO FilePath -getThemePath = (++ "/theme.ini") <$> getDir +getThemePath = (<> "/theme.ini") <$> getDir getConfigPath :: IO FilePath -getConfigPath = (++ "/config.ini") <$> getDir +getConfigPath = (<> "/config.ini") <$> getDir setup :: IO Config setup = do @@ -75,36 +88,21 @@ createConfig = create getConfigPath writeConfig configParser :: IniParser Config -configParser = do - generalCf <- General.parser - layoutCf <- Layout.parser - markdownCf <- Markdown.parser - trelloCf <- Trello.parser - githubCf <- GitHub.parser - return - Config - { general = generalCf - , layout = layoutCf - , markdown = markdownCf - , trello = trelloCf - , github = githubCf - } +configParser = + Config <$> General.parser <*> Layout.parser <*> Markdown.parser <*> Trello.parser <*> + GitHub.parser getConfig :: IO Config getConfig = do content <- getConfigPath >>= T.readFile - let config = parseIniFile content configParser - case config of - Right c -> return c - Left s -> putStrLn (pack $ "config.ini: " ++ s) >> return defaultConfig + case parseIniFile content configParser of + Right config -> pure config + Left s -> putStrLn (pack $ "config.ini: " <> s) *> pure defaultConfig -- generate theme generateAttrMap :: IO AttrMap generateAttrMap = do - path <- getThemePath - customizedTheme <- loadCustomizations path defaultTheme + customizedTheme <- flip loadCustomizations defaultTheme =<< getThemePath case customizedTheme of - Right theme -> return $ themeToAttrMap theme - Left s -> do - putStrLn (pack $ "theme.ini: " ++ s) - return $ themeToAttrMap defaultTheme + Right theme -> pure $ themeToAttrMap theme + Left s -> putStrLn (pack $ "theme.ini: " <> s) $> themeToAttrMap defaultTheme diff --git a/src/IO/Config/General.hs b/src/IO/Config/General.hs --- a/src/IO/Config/General.hs +++ b/src/IO/Config/General.hs @@ -20,4 +20,4 @@ "general" (do filenameCf <- maybe (filename defaultConfig) unpack . (noEmpty =<<) <$> fieldMb "filename" - return Config {filename = filenameCf}) + pure Config {filename = filenameCf}) diff --git a/src/IO/Config/GitHub.hs b/src/IO/Config/GitHub.hs --- a/src/IO/Config/GitHub.hs +++ b/src/IO/Config/GitHub.hs @@ -19,4 +19,4 @@ sectionMb "github" (do tokenCf <- fieldMb "token" - return Config {token = tokenCf}) + pure Config {token = tokenCf}) diff --git a/src/IO/Config/Layout.hs b/src/IO/Config/Layout.hs --- a/src/IO/Config/Layout.hs +++ b/src/IO/Config/Layout.hs @@ -27,7 +27,7 @@ descriptionIndicatorCf <- fromMaybe (descriptionIndicator defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "description_indicator" - return + pure Config { columnWidth = columnWidthCf , columnPadding = columnPaddingCf diff --git a/src/IO/Config/Markdown.hs b/src/IO/Config/Markdown.hs --- a/src/IO/Config/Markdown.hs +++ b/src/IO/Config/Markdown.hs @@ -42,7 +42,7 @@ subtaskOutputCf <- fromMaybe (subtaskOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "subtask" - return + pure Config { titleOutput = titleOutputCf , taskOutput = taskOutputCf diff --git a/src/IO/Config/Trello.hs b/src/IO/Config/Trello.hs --- a/src/IO/Config/Trello.hs +++ b/src/IO/Config/Trello.hs @@ -19,4 +19,4 @@ sectionMb "trello" (do tokenCf <- fieldMb "token" - return Config {token = tokenCf}) + pure Config {token = tokenCf}) diff --git a/src/IO/HTTP/Aeson.hs b/src/IO/HTTP/Aeson.hs --- a/src/IO/HTTP/Aeson.hs +++ b/src/IO/HTTP/Aeson.hs @@ -15,4 +15,4 @@ deriveFromJSON = TH.deriveFromJSON defaultOptions {fieldLabelModifier = drop 1} parseError :: String -> Text -parseError err = decodeUtf8 $(embedFile "templates/api-error.txt") ++ "\n\n" ++ pack err +parseError err = decodeUtf8 $(embedFile "templates/api-error.txt") <> "\n\n" <> pack err diff --git a/src/IO/HTTP/GitHub.hs b/src/IO/HTTP/GitHub.hs --- a/src/IO/HTTP/GitHub.hs +++ b/src/IO/HTTP/GitHub.hs @@ -51,10 +51,10 @@ headers :: ReaderGitHubToken [(HeaderName, ByteString)] headers = do token <- ask - return + pure [ ("User-Agent", "smallhadroncollider/taskell") , ("Accept", "application/vnd.github.inertia-preview+json") - , ("Authorization", encodeUtf8 ("token " ++ token)) + , ("Authorization", encodeUtf8 ("token " <> token)) ] getNextLink :: [ByteString] -> Maybe Text @@ -62,7 +62,7 @@ lnks <- splitOn "," . decodeUtf8 <$> headMay bs let rel = "rel=\"next\"" next <- find (isSuffixOf rel) lnks - stripPrefix "<" =<< stripSuffix (">; " ++ rel) (strip next) + stripPrefix "<" =<< stripSuffix (">; " <> rel) (strip next) fetch' :: [ByteString] -> Text -> ReaderGitHubToken (Int, [ByteString]) fetch' bs url = do @@ -70,9 +70,9 @@ rHeaders <- headers let request = initialRequest {requestHeaders = rHeaders} response <- lift $ httpBS request - let responses = bs ++ [getResponseBody response] + let responses = bs <> [getResponseBody response] case getNextLink (getResponseHeader "Link" response) of - Nothing -> return (getResponseStatusCode response, responses) + Nothing -> pure (getResponseStatusCode response, responses) Just lnk -> fetch' responses lnk fetch :: Text -> ReaderGitHubToken (Int, [ByteString]) @@ -81,24 +81,24 @@ getCards :: Text -> ReaderGitHubToken (Either Text [Card]) getCards url = do (status, body) <- fetch url - return $ + pure $ case status of 200 -> case concatEithers (eitherDecodeStrict <$> body) of Right cards -> Right cards Left err -> Left (parseError err) 429 -> Left "Too many cards" - _ -> Left $ tshow status ++ " error while fetching " ++ url + _ -> Left $ tshow status <> " error while fetching " <> url addCard :: Column -> ReaderGitHubToken (Either Text List) addCard column = do cards <- getCards $ column ^. cardsURL - return $ columnToList column <$> cards + pure $ columnToList column <$> cards addCards :: [Column] -> ReaderGitHubToken (Either Text Lists) addCards columns = do cols <- sequence (addCard <$> columns) - return $ fromList <$> sequence cols + pure $ fromList <$> sequence cols getColumns :: Text -> ReaderGitHubToken (Either Text Lists) getColumns url = do @@ -108,10 +108,10 @@ 200 -> case concatEithers (eitherDecodeStrict <$> body) of Right columns -> addCards columns - Left err -> return $ Left (parseError err) - 404 -> return . Left $ "Could not find GitHub project ." - 401 -> return . Left $ "You do not have permission to view GitHub project " ++ url - _ -> return . Left $ tshow status ++ " error. Cannot fetch columns from GitHub." + Left err -> pure $ Left (parseError err) + 404 -> pure . Left $ "Could not find GitHub project ." + 401 -> pure . Left $ "You do not have permission to view GitHub project " <> url + _ -> pure . Left $ tshow status <> " error. Cannot fetch columns from GitHub." printProjects :: Seq Project -> Text printProjects projects = unlines $ toList display @@ -127,7 +127,7 @@ chosen <- lift $ prompt "Import project" let project = (projects' !?) =<< (-) 1 <$> readMay chosen case project of - Nothing -> return $ Left "Invalid project selected" + Nothing -> pure $ Left "Invalid project selected" Just proj -> getColumns (proj ^. columnsURL) getLists :: GitHubIdentifier -> ReaderGitHubToken (Either Text Lists) @@ -140,13 +140,13 @@ case concatEithers (eitherDecodeStrict <$> body) of Right projects -> if null projects - then return . Left $ concat ["\nNo projects found for ", identifier, "\n"] + then pure . Left $ concat ["\nNo projects found for ", identifier, "\n"] else chooseProject projects - Left err -> return $ Left (parseError err) + Left err -> pure $ Left (parseError err) 404 -> - return . Left $ + pure . Left $ "Could not find GitHub org/repo. For organisation make sure you use 'orgs/' and for repos use 'repos//'" 401 -> - return . Left $ - "You do not have permission to view the GitHub projects for " ++ identifier - _ -> return . Left $ tshow status ++ " error. Cannot fetch projects from GitHub." + pure . Left $ + "You do not have permission to view the GitHub projects for " <> identifier + _ -> pure . Left $ tshow status <> " error. Cannot fetch projects from GitHub." diff --git a/src/IO/HTTP/Trello.hs b/src/IO/HTTP/Trello.hs --- a/src/IO/HTTP/Trello.hs +++ b/src/IO/HTTP/Trello.hs @@ -39,7 +39,7 @@ fullURL :: Text -> ReaderTrelloToken String fullURL uri = do token <- ask - return . unpack $ concat [root, uri, "&key=", key, "&token=", token] + pure . unpack $ concat [root, uri, "&key=", key, "&token=", token] boardURL :: TrelloBoardID -> ReaderTrelloToken String boardURL board = @@ -64,20 +64,20 @@ fetch url = do request <- parseRequest url response <- httpBS request - return (getResponseStatusCode response, getResponseBody response) + pure (getResponseStatusCode response, getResponseBody response) getChecklist :: TrelloChecklistID -> ReaderTrelloToken (Either Text [ChecklistItem]) getChecklist checklist = do url <- checklistURL checklist (status, body) <- lift $ fetch url - return $ + pure $ case status of 200 -> case (^. checkItems) <$> eitherDecodeStrict body of Right ls -> Right ls Left err -> Left $ parseError err 429 -> Left "Too many checklists" - _ -> Left $ tshow status ++ " error while fetching checklist " ++ checklist + _ -> Left $ tshow status <> " error while fetching checklist " <> checklist updateCard :: Card -> ReaderTrelloToken (Either Text Card) updateCard card = (setChecklists card . concat <$>) . sequence <$> checklists @@ -100,9 +100,9 @@ 200 -> case eitherDecodeStrict body of Right raw -> fmap (trelloListsToLists timezone) <$> getChecklists raw - Left err -> return . Left $ parseError err + Left err -> pure . Left $ parseError err 404 -> - return . Left $ - "Could not find Trello board " ++ board ++ ". Make sure the ID is correct" - 401 -> return . Left $ "You do not have permission to view Trello board " ++ board - _ -> return . Left $ tshow status ++ " error. Cannot fetch from Trello." + pure . Left $ + "Could not find Trello board " <> board <> ". Make sure the ID is correct" + 401 -> pure . Left $ "You do not have permission to view Trello board " <> board + _ -> pure . Left $ tshow status <> " error. Cannot fetch from Trello." diff --git a/src/IO/Markdown/Internal.hs b/src/IO/Markdown/Internal.hs --- a/src/IO/Markdown/Internal.hs +++ b/src/IO/Markdown/Internal.hs @@ -77,7 +77,7 @@ Just (Just set) -> (set current, errs) _ -> if not (null (strip text)) - then (current, errs ++ [line]) + then (current, errs <> [line]) else (current, errs) decodeError :: String -> Maybe Word8 -> Maybe Char @@ -91,12 +91,12 @@ let (lists, errs) = foldl' fn acc $ zip lns [1 ..] if null errs then Right lists - else Left $ "could not parse line(s) " ++ intercalate ", " (tshow <$> errs) + else Left $ "could not parse line(s) " <> intercalate ", " (tshow <$> errs) -- stringify code subtaskStringify :: Config -> Text -> ST.Subtask -> Text subtaskStringify config t st = - foldl' (++) t [subtaskOutput config, " ", pre, " ", st ^. ST.name, "\n"] + foldl' (<>) t [subtaskOutput config, " ", pre, " ", st ^. ST.name, "\n"] where pre = if st ^. ST.complete @@ -117,7 +117,7 @@ taskStringify :: Config -> Text -> T.Task -> Text taskStringify config s t = foldl' - (++) + (<>) s [ nameStringify config (t ^. T.name) , maybe "" (dueStringify config) (t ^. T.due) @@ -128,7 +128,7 @@ listStringify :: Config -> Text -> List -> Text listStringify config text list = foldl' - (++) + (<>) text [ if null text then "" diff --git a/src/IO/Taskell.hs b/src/IO/Taskell.hs --- a/src/IO/Taskell.hs +++ b/src/IO/Taskell.hs @@ -33,14 +33,14 @@ | Exit parseArgs :: [Text] -> ReaderConfig Next -parseArgs ["-v"] = return $ Output version -parseArgs ["-h"] = return $ Output usage +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 <$> ask) >>= loadFile -parseArgs _ = return $ Output (unlines ["Invalid options", "", usage]) +parseArgs _ = pure $ Output (unlines ["Invalid options", "", usage]) load :: ReaderConfig Next load = getArgs >>= parseArgs @@ -49,20 +49,20 @@ loadFile filepath = do mPath <- exists filepath case mPath of - Nothing -> return Exit + Nothing -> pure Exit Just path -> do content <- readData path - return $ + pure $ case content of Right lists -> Load path lists - Left err -> Output $ pack path ++ ": " ++ err + Left err -> Output $ pack path <> ": " <> err loadRemote :: (token -> FilePath -> ReaderConfig Next) -> token -> Text -> ReaderConfig Next loadRemote createFn identifier filepath = do let path = unpack filepath exists' <- fileExists path if exists' - then return $ Output (filepath ++ " already exists") + then pure $ Output (filepath <> " already exists") else createFn identifier path loadTrello :: Trello.TrelloBoardID -> Text -> ReaderConfig Next @@ -78,11 +78,11 @@ if exists' then do content <- readData path - return $ + pure $ case content of Right lists -> Output $ analyse filepath lists - Left err -> Output $ pack path ++ ": " ++ err - else return Exit + Left err -> Output $ pack path <> ": " <> err + else pure Exit createRemote :: (Config -> Maybe token) @@ -95,18 +95,18 @@ config <- ask let maybeToken = tokenFn config case maybeToken of - Nothing -> return $ Output missingToken + Nothing -> pure $ Output missingToken Just token -> do lists <- lift $ runReaderT (getFn identifier) token case lists of - Left txt -> return $ Output txt + Left txt -> pure $ Output txt Right ls -> do create <- promptCreate path if create then do lift $ writeData config ls path - return $ Load path ls - else return Exit + pure $ Load path ls + else pure Exit createTrello :: Trello.TrelloBoardID -> FilePath -> ReaderConfig Next createTrello = @@ -127,14 +127,14 @@ let path = unpack filepath exists' <- fileExists path if exists' - then return $ Just path + then pure $ Just path else do create <- promptCreate path if create then do createPath path - return $ Just path - else return Nothing + pure $ Just path + else pure Nothing fileExists :: FilePath -> ReaderConfig Bool fileExists path = lift $ doesFileExist path @@ -159,4 +159,4 @@ readData path = do config <- ask content <- readFile path - return $ parse config content + pure $ parse config content diff --git a/src/UI/CLI.hs b/src/UI/CLI.hs --- a/src/UI/CLI.hs +++ b/src/UI/CLI.hs @@ -2,22 +2,17 @@ {-# LANGUAGE OverloadedStrings #-} module UI.CLI - ( prompt - , promptYN - ) where + ( prompt + , promptYN + ) where -import ClassyPrelude -import Data.Text.IO (hPutStrLn) -import System.Exit (exitFailure) +import ClassyPrelude prompt :: Text -> IO Text prompt s = do - putStr $ s ++ ": " - hFlush stdout -- prevents buffering - getLine + putStr $ s <> ": " + hFlush stdout -- prevents buffering + getLine promptYN :: Text -> IO Bool -promptYN s = (==) "y" <$> prompt (s ++ " (y/n)") - -exitWithErrorMessage :: Text -> IO () -exitWithErrorMessage str = hPutStrLn stderr str >> void exitFailure +promptYN s = (==) "y" <$> prompt (s <> " (y/n)") diff --git a/src/UI/Draw.hs b/src/UI/Draw.hs --- a/src/UI/Draw.hs +++ b/src/UI/Draw.hs @@ -51,7 +51,7 @@ today <- dsToday <$> ask -- get the value of `today` from DrawState let attr = withAttr . dlToAttr . deadline today <$> dueDay -- create a `Maybe (Widget -> Widget)` attribute function widget = txt . dayToText today <$> dueDay -- get the formatted due date `Maybe Text` - return $ attr <*> widget + pure $ attr <*> widget -- | Renders the appropriate completed sub task count e.g. "[2/3]" renderSubtaskCount :: T.Task -> Widget ResourceName @@ -63,7 +63,7 @@ indicators task = do dateWidget <- renderDate (task ^. T.due) -- get the due date widget descIndicator <- descriptionIndicator . dsLayout <$> ask - return . hBox $ + pure . hBox $ padRight (Pad 1) <$> catMaybes [ const (txt descIndicator) <$> task ^. T.description -- show the description indicator if one is set @@ -82,7 +82,7 @@ name = RNTask (listIndex, taskIndex) widget = textField text widget' = widgetFromMaybe widget taskField - return $ + pure $ cached name . (if selected && not eTitle then visible @@ -104,15 +104,15 @@ if moveTo m then do let col = chr (i + ord 'a') - return $ + pure $ if i /= selectedList && i >= 0 && i <= 26 - then singleton col ++ ". " + then singleton col <> ". " else "" else do let col = i + 1 - return $ + pure $ if col >= 1 && col <= 9 - then tshow col ++ ". " + then tshow col <> ". " else "" -- | Renders the title for a list @@ -134,7 +134,7 @@ if editing then widget' else widget - return $ + pure $ if editing || selectedList /= listIndex || selectedTask == 0 then visible title' else title' @@ -155,7 +155,7 @@ hLimit (columnWidth layout) . viewport (RNList listIndex) Vertical . vBox . (titleWidget :) $ toList taskWidgets - return $ + pure $ if currentList == listIndex then visible widget else widget @@ -173,8 +173,8 @@ then taskCurrentAttr else taskAttr let widget = attr . padTopBottom 1 . padLeftRight colPad $ txt "/" <+> field searchField - return $ mainWidget <=> widget - _ -> return mainWidget + pure $ mainWidget <=> widget + _ -> pure mainWidget -- | Renders the main widget main :: ReaderDrawState (Widget ResourceName) diff --git a/src/UI/Field.hs b/src/UI/Field.hs --- a/src/UI/Field.hs +++ b/src/UI/Field.hs @@ -48,13 +48,13 @@ let (start, end) = T.splitAt cursor text in case fromNullable start of Nothing -> Field end cursor - Just start' -> Field (init start' ++ end) (cursor - 1) + Just start' -> Field (init start' <> end) (cursor - 1) insertCharacter :: Char -> Field -> Field insertCharacter char (Field text cursor) = Field newText newCursor where (start, end) = T.splitAt cursor text - newText = snoc start char ++ end + newText = snoc start char <> end newCursor = cursor + 1 insertText :: Text -> Field -> Field @@ -112,10 +112,10 @@ spl' :: [Text] -> Char -> [Text] spl' ts c - | c == ' ' = ts ++ [" "] ++ [""] + | c == ' ' = ts <> [" "] <> [""] | otherwise = case fromNullable ts of - Just ts' -> init ts' ++ [snoc (last ts') c] + Just ts' -> init ts' <> [snoc (last ts') c] Nothing -> [singleton c] spl :: Text -> [Text] @@ -125,8 +125,8 @@ combine width (acc, offset) s | newline && s == " " = (acc, offset + 1) | T.takeEnd 1 l == " " && s == " " = (acc, offset + 1) - | newline = (acc ++ [s], offset) - | otherwise = (append (l ++ s) acc, offset) + | newline = (acc <> [s], offset) + | otherwise = (append (l <> s) acc, offset) where l = maybe "" last (fromNullable acc) newline = B.textWidth l + B.textWidth s > width @@ -134,5 +134,5 @@ append :: Text -> [Text] -> [Text] append s l = case fromNullable l of - Just l' -> init l' ++ [s] - Nothing -> l ++ [s] + Just l' -> init l' <> [s] + Nothing -> l <> [s] diff --git a/src/UI/Modal/Detail.hs b/src/UI/Modal/Detail.hs --- a/src/UI/Modal/Detail.hs +++ b/src/UI/Modal/Detail.hs @@ -81,4 +81,4 @@ w | null sts = withAttr disabledAttr $ txt "No sub-tasks" | otherwise = vBox . toList $ renderSubtask f i `mapWithIndex` sts - return (task ^. name, renderDate today f i task <=> renderSummary f i task <=> w) + pure (task ^. name, renderDate today f i task <=> renderSummary f i task <=> w) diff --git a/src/UI/Modal/MoveTo.hs b/src/UI/Modal/MoveTo.hs --- a/src/UI/Modal/MoveTo.hs +++ b/src/UI/Modal/MoveTo.hs @@ -27,6 +27,6 @@ letter a = padRight (Pad 1) . hBox $ [txt "[", withAttr taskCurrentAttr $ txt (singleton a), txt "]"] letters = letter <$> ['a' ..] - remove i l = take i l ++ drop (i + 1) l + remove i l = take i l <> drop (i + 1) l output (l, t) = l <+> t widget = vBox $ output <$> remove skip (zip letters titles) diff --git a/taskell.cabal b/taskell.cabal --- a/taskell.cabal +++ b/taskell.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: taskell -version: 1.3.5.0 +version: 1.3.6.0 license: BSD3 license-file: LICENSE copyright: 2019 Mark Wales