diff options
| -rw-r--r-- | .gitignore | 3 | ||||
| -rw-r--r-- | LICENSE | 20 | ||||
| -rw-r--r-- | app/Main.hs | 399 | ||||
| -rwxr-xr-x | build.sh | 12 | ||||
| -rw-r--r-- | tasker.cabal | 32 | ||||
| -rw-r--r-- | tasker.fish | 54 |
6 files changed, 520 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..deb43cf --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +/CHANGELOG.md +*.*~ +/dist-newstyle/ @@ -0,0 +1,20 @@ +Copyright (c) 2026 David Moc + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..6ec23de --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,399 @@ +module Main where + +import Control.DeepSeq (force) +import Control.Exception (evaluate) +import Data.Char (toLower) +import Data.List (isInfixOf, isPrefixOf, sortOn, stripPrefix) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe) +import Data.Ord (Down (..)) +import Data.Time.Clock (getCurrentTime) +import Data.Time.Format (defaultTimeLocale, formatTime) +import System.Directory +import System.Environment +import System.FilePath ((</>)) +import Text.Read (readMaybe) + +data Status + = CLOSED + | IN_PROGRESS + | OPEN + deriving (Show, Eq, Enum, Bounded, Read, Ord) + +data Task = Task + { priority :: Int + , desc :: String + , status :: Status + } deriving (Show, Eq) + +data AppError + = TaskNotFound FilePath + | InvalidStatus String + | InvalidPriority String + | MissingArgument String + | UnknownOption String + | UnexpectedArgument String + deriving (Eq) + +instance Show AppError where + show (TaskNotFound path) = "Could not find task file: " ++ path </> "Task.md" + show (InvalidStatus s) = "Invalid status: " ++ s ++ ". Use OPEN, IN_PROGRESS, or CLOSED." + show (InvalidPriority p) = "Invalid priority: " ++ p ++ ". Must be an integer." + show (MissingArgument flag) = "Missing value after " ++ flag + show (UnknownOption flag) = "Unknown option: " ++ flag + show (UnexpectedArgument arg) = "Unexpected argument: " ++ arg + +data TaskRecord = TaskRecord + { recordDir :: FilePath + , recordName :: String + , recordTask :: Task + } deriving (Show, Eq) + +recordFile :: TaskRecord -> FilePath +recordFile r = recordDir r </> "Task.md" + +data NewTaskOptions = NewTaskOptions + { optPriority :: Maybe Int + , optDesc :: Maybe String + } deriving (Show, Eq) + +data ListOptions = ListOptions + { filterStatus :: Maybe Status + , filterPriority :: Maybe Int + , filterMinPriority :: Maybe Int + , filterContains :: Maybe String + } deriving (Show, Eq) + +data SetOptions = SetOptions + { setName :: Maybe String + , setPriority :: Maybe Int + , setDesc :: Maybe String + , setStatus :: Maybe Status + } deriving (Show, Eq) + +defaultNewOptions :: NewTaskOptions +defaultNewOptions = NewTaskOptions Nothing Nothing + +parseNewTaskOptions :: [String] -> Either AppError NewTaskOptions +parseNewTaskOptions = go defaultNewOptions + where + go opts [] = Right opts + go opts ("-p" : p : rs) = readPriority p >>= \n -> go opts { optPriority = Just n } rs + go _ ("-p" : []) = Left (MissingArgument "-p") + go opts ("-d" : d : rs) = go opts { optDesc = Just d } rs + go _ ("-d" : []) = Left (MissingArgument "-d") + go _ (f : _) | "-" `isPrefixOf` f = Left (UnknownOption f) + go _ (a : _) = Left (UnexpectedArgument a) + +defaultListOptions :: ListOptions +defaultListOptions = ListOptions Nothing Nothing Nothing Nothing + +parseListOptions :: [String] -> Either AppError ListOptions +parseListOptions = go defaultListOptions + where + go opts [] = Right opts + go opts (flag : val : rs) + | flag `elem` ["--status", "-s"] = readStatus val >>= \s -> go opts { filterStatus = Just s } rs + | flag `elem` ["--priority", "-p"] = readPriority val >>= \n -> go opts { filterPriority = Just n } rs + | flag `elem` ["--min-priority" ] = readPriority val >>= \n -> go opts { filterMinPriority = Just n } rs + | flag `elem` ["--contains", "-c"] = go opts { filterContains = Just val } rs + go _ (flag : []) + | flag `elem` ["--status", "-s", "--priority", "-p", "--min-priority", "--contains", "-c"] = + Left (MissingArgument flag) + go _ (f : _) | "-" `isPrefixOf` f = Left (UnknownOption f) + go _ (a : _) = Left (UnexpectedArgument a) + +defaultSetOptions :: SetOptions +defaultSetOptions = SetOptions Nothing Nothing Nothing Nothing + +parseSetOptions :: [String] -> Either AppError SetOptions +parseSetOptions = go defaultSetOptions + where + go opts [] = Right opts + go opts (flag : val : rs) + | flag `elem` ["--name", "-n"] = go opts { setName = Just val } rs + | flag `elem` ["--priority", "-p"] = readPriority val >>= \n -> go opts { setPriority = Just n } rs + | flag `elem` ["--desc", "-d"] = go opts { setDesc = Just val } rs + | flag `elem` ["--status", "-s"] = readStatus val >>= \s -> go opts { setStatus = Just s } rs + go _ (flag : []) + | flag `elem` ["--name", "-n", "--priority", "-p", "--desc", "-d", "--status", "-s"] = + Left (MissingArgument flag) + go _ (f : _) | "-" `isPrefixOf` f = Left (UnknownOption f) + go _ (a : _) = Left (UnexpectedArgument a) + +readPriority :: String -> Either AppError Int +readPriority s = maybe (Left (InvalidPriority s)) Right (readMaybe s) + +readStatus :: String -> Either AppError Status +readStatus s = maybe (Left (InvalidStatus s)) Right (readMaybe s) + +usage :: String -> String +usage prog = unlines + [ "Usage: " ++ prog ++ " <command> [options]" + , "" + , "Commands:" + , " new TASK_NAME [-p PRIORITY] [-d DESCRIPTION]" + , " list [--status STATUS] [--priority N] [--min-priority N] [--contains TEXT]" + , " set TASK_DIR [--name NAME] [--status STATUS] [--priority N] [--desc DESC]" + , " delete TASK_DIR" + , "" + , "Statuses: OPEN | IN_PROGRESS | CLOSED" + ] + +makeTaskMarkdown :: String -> Task -> String +makeTaskMarkdown taskName task = + unlines + [ "# " ++ taskName + , "" + , "- Description: " ++ desc task + , "- Priority: " ++ show (priority task) + , "- Status: " ++ show (status task) + ] + +parseFields :: [String] -> Map String String +parseFields = Map.fromList . concatMap parseLine + where + parseLine line = + case stripPrefix "- " line of + Nothing -> [] + Just rest -> + case break (== ':') rest of + (key, ':' : ' ' : val) -> [(key, val)] + _ -> [] + +readTaskRecord :: FilePath -> IO (Either AppError TaskRecord) +readTaskRecord taskDir = do + let taskFile = taskDir </> "Task.md" + exists <- doesFileExist taskFile + if not exists + then pure (Left (TaskNotFound taskDir)) + else do + contents <- readFile taskFile >>= evaluate . force + let ls = lines contents + fields = parseFields ls + taskName = case ls of + firstLine : _ -> fromMaybe firstLine (stripPrefix "# " firstLine) + [] -> taskDir + look k = Map.lookup k fields + task = Task + { priority = fromMaybe 0 (look "Priority" >>= readMaybe) + , desc = fromMaybe "" (look "Description") + , status = fromMaybe OPEN (look "Status" >>= readMaybe) + } + pure $ Right $ TaskRecord + { recordDir = taskDir + , recordName = taskName + , recordTask = task + } + +writeTaskRecord :: TaskRecord -> IO () +writeTaskRecord record = + writeFile (recordFile record) (makeTaskMarkdown (recordName record) (recordTask record)) + +matchesListOptions :: ListOptions -> TaskRecord -> Bool +matchesListOptions opts record = + all id + [ maybe True (status task ==) (filterStatus opts) + , maybe True (priority task ==) (filterPriority opts) + , maybe True (priority task >=) (filterMinPriority opts) + , maybe True (\needle -> map toLower needle `isInfixOf` searchableText) (filterContains opts) + ] + where + task = recordTask record + searchableText = map toLower $ unwords + [ recordName record + , desc task + , show (status task) + , show (priority task) + ] + +printTaskRecord :: TaskRecord -> IO () +printTaskRecord record = + putStrLn $ + recordFile record ++ ":1:1: " + ++ "[" ++ show (status task) ++ "] " + ++ "P" ++ show (priority task) ++ " " + ++ recordName record + ++ descPart + where + task = recordTask record + descPart = case desc task of + "" -> "" + d -> " -- " ++ d + +taskDirFormat :: String +taskDirFormat = "%y-%m-%d %H:%M:%S" + +isTask :: FilePath -> Bool +isTask d = isBaseTask base && validSuffix rest + where + (base, rest) = splitAt 17 d + isBaseTask s = + length s == 17 + && isDatePart (take 8 s) + && s !! 8 == ' ' + && isTimePart (drop 9 s) + validSuffix "" = True + validSuffix ('.' : digits) = not (null digits) && allDigits digits + validSuffix _ = False + isDatePart s = + length s == 8 + && allDigits (take 2 s) + && s !! 2 == '-' + && allDigits (take 2 (drop 3 s)) + && s !! 5 == '-' + && allDigits (drop 6 s) + isTimePart s = + length s == 8 + && allDigits (take 2 s) + && s !! 2 == ':' + && allDigits (take 2 (drop 3 s)) + && s !! 5 == ':' + && allDigits (drop 6 s) + allDigits = all (`elem` ['0' .. '9']) + +tasksSubdir :: FilePath +tasksSubdir = "tasks" + +findTasksRoot :: IO FilePath +findTasksRoot = do + hasSub <- doesDirectoryExist tasksSubdir + pure $ if hasSub then tasksSubdir else "." + +newTaskDirName :: FilePath -> IO FilePath +newTaskDirName root = do + now <- getCurrentTime + let base = formatTime defaultTimeLocale taskDirFormat now + findFree base (0 :: Int) + where + findFree base n = do + let name = if n == 0 then base else base ++ "." ++ show n + candidate = root </> name + exists <- doesDirectoryExist candidate + if not exists then pure candidate else findFree base (n + 1) + +loadAllRecords :: IO [TaskRecord] +loadAllRecords = do + root <- findTasksRoot + files <- listDirectory root + results <- mapM (readTaskRecord . (root </>)) (filter isTask files) + pure $ sortOn (Down . priority . recordTask) [r | Right r <- results] + +resolveTaskDir :: FilePath -> IO FilePath +resolveTaskDir d + | isTask d = findTasksRoot >>= \root -> pure (root </> d) + | otherwise = pure d + +printChanges :: TaskRecord -> TaskRecord -> IO () +printChanges old new = mapM_ report3 + [ ("name", recordName old, recordName new) + , ("priority", show . priority . recordTask $ old, show . priority . recordTask $ new) + , ("desc", desc . recordTask $ old, desc . recordTask $ new) + , ("status", show . status . recordTask $ old, show . status . recordTask $ new) + ] + where + report3 (field, oldVal, newVal) + | oldVal /= newVal = putStrLn $ " " ++ field ++ ": " ++ oldVal ++ " -> " ++ newVal + | otherwise = pure () + +newTask :: String -> [String] -> IO () +newTask programName args = + case args of + [] -> do + putStrLn "Error: missing task name." + putStrLn $ usage programName + taskName : rest -> + case parseNewTaskOptions rest of + Left err -> do + putStrLn (show err) + putStrLn $ usage programName + Right opts -> do + root <- findTasksRoot + taskDirName <- newTaskDirName root + let task = Task + { priority = fromMaybe 0 (optPriority opts) + , desc = fromMaybe "" (optDesc opts) + , status = OPEN + } + record = TaskRecord + { recordDir = taskDirName + , recordName = taskName + , recordTask = task + } + createDirectory taskDirName + writeTaskRecord record + putStrLn $ recordFile record ++ ":1:1: Created task: " ++ taskName + +listTasks :: String -> [String] -> IO () +listTasks programName args = + case parseListOptions args of + Left err -> do + putStrLn (show err) + putStrLn $ usage programName + Right opts -> do + records <- loadAllRecords + let filtered = filter (matchesListOptions opts) records + if null filtered + then putStrLn "(no matching tasks)" + else mapM_ printTaskRecord filtered + +setTask :: String -> [String] -> IO () +setTask programName args = + case args of + [] -> putStrLn $ usage programName + taskDir : rest -> + case parseSetOptions rest of + Left err -> do + putStrLn (show err) + putStrLn $ usage programName + Right opts -> do + resolved <- resolveTaskDir taskDir + result <- readTaskRecord resolved + case result of + Left err -> putStrLn (show err) + Right record -> do + let old = recordTask record + updatedTask = old + { priority = fromMaybe (priority old) (setPriority opts) + , desc = fromMaybe (desc old) (setDesc opts) + , status = fromMaybe (status old) (setStatus opts) + } + updatedRecord = record + { recordName = fromMaybe (recordName record) (setName opts) + , recordTask = updatedTask + } + printChanges record updatedRecord + writeTaskRecord updatedRecord + putStrLn $ recordFile updatedRecord ++ ":1:1: Updated task: " ++ recordName updatedRecord + +deleteTask :: String -> [String] -> IO () +deleteTask programName args = + case args of + [] -> putStrLn $ usage programName + taskDir : _ -> do + resolved <- resolveTaskDir taskDir + result <- readTaskRecord resolved + case result of + Left err -> putStrLn (show err) + Right record -> do + removeDirectoryRecursive (recordDir record) + putStrLn $ "Deleted task: " ++ recordName record ++ " (" ++ recordDir record ++ ")" + +handleArgs :: String -> [String] -> IO () +handleArgs prog args = + case args of + "new" : rest -> newTask prog rest + "list" : rest -> listTasks prog rest + "set" : rest -> setTask prog rest + "delete" : rest -> deleteTask prog rest + [] -> listTasks prog [] + cmd : _ -> do + putStrLn $ "Unknown command: " ++ cmd + putStrLn $ usage prog + +main :: IO () +main = do + prog <- getProgName + args <- getArgs + handleArgs prog args diff --git a/build.sh b/build.sh new file mode 100755 index 0000000..6b52919 --- /dev/null +++ b/build.sh @@ -0,0 +1,12 @@ +#!/usr/bin/env sh +set -e + +cabal build exe:tasker + +bin=$(cabal list-bin exe:tasker) + +sudo install -Dm755 "$bin" /usr/local/bin/tasker +sudo install -Dm644 tasker.fish /usr/share/fish/vendor_completions.d/tasker.fish + +echo "Installed $bin -> /usr/local/bin/tasker" +echo "Installed tasker.fish -> /usr/share/fish/vendor_completions.d/tasker.fish" diff --git a/tasker.cabal b/tasker.cabal new file mode 100644 index 0000000..6971f47 --- /dev/null +++ b/tasker.cabal @@ -0,0 +1,32 @@ +cabal-version: 3.0 +name: tasker +version: 0.1.0.0 +-- synopsis: +-- description: +license: MIT +license-file: LICENSE +author: David Moc +maintainer: personal@cdatgoose.org +-- copyright: +category: Development +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +common warnings + ghc-options: -Wall + +executable tasker + import: warnings + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: + base ^>=4.18.2.1, + containers ^>=0.6.7, + deepseq ^>=1.4.8.0, + directory ^>=1.3.8.5, + filepath ^>=1.4.2.2, + time ^>=1.12.2 + hs-source-dirs: app + default-language: GHC2021 diff --git a/tasker.fish b/tasker.fish new file mode 100644 index 0000000..43b6d24 --- /dev/null +++ b/tasker.fish @@ -0,0 +1,54 @@ +function __tasker_no_subcommand + not __fish_seen_subcommand_from new list set delete +end + +function __tasker_task_dirs + if test -d $PWD/tasks + set root $PWD/tasks + else + set root $PWD + end + for d in $root/*/ + set trimmed (string trim -r -c '/' $d) + set parts (string split '/' $trimmed) + set name $parts[-1] + if string match -qr '^\d{2}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}(\.\d+)?$' $name + echo $name + end + end +end + +complete -c tasker -n __tasker_no_subcommand -f -a new -d 'Create a new task' +complete -c tasker -n __tasker_no_subcommand -f -a list -d 'List tasks' +complete -c tasker -n __tasker_no_subcommand -f -a set -d 'Update a task' +complete -c tasker -n __tasker_no_subcommand -f -a delete -d 'Delete a task' + +complete -c tasker -n '__fish_seen_subcommand_from new' \ + -s p -d 'Priority (integer)' -r +complete -c tasker -n '__fish_seen_subcommand_from new' \ + -s d -d 'Description' -r + +complete -c tasker -n '__fish_seen_subcommand_from list' \ + -s s -l status -d 'Filter by status' -r \ + -a 'OPEN\tOpen IN_PROGRESS\tIn-progress CLOSED\tClosed' +complete -c tasker -n '__fish_seen_subcommand_from list' \ + -s p -l priority -d 'Filter by exact priority' -r +complete -c tasker -n '__fish_seen_subcommand_from list' \ + -l min-priority -d 'Filter by minimum priority' -r +complete -c tasker -n '__fish_seen_subcommand_from list' \ + -s c -l contains -d 'Filter by text' -r + +complete -c tasker -n '__fish_seen_subcommand_from set' \ + -f -a '(__tasker_task_dirs)' -d 'Task directory' +complete -c tasker -n '__fish_seen_subcommand_from set' \ + -s n -l name -d 'Rename the task' -r +complete -c tasker -n '__fish_seen_subcommand_from set' \ + -s s -l status -d 'Set status' -r \ + -a 'OPEN\tOpen IN_PROGRESS\tIn\ progress CLOSED\tClosed' +complete -c tasker -n '__fish_seen_subcommand_from set' \ + -s p -l priority -d 'Set priority (integer)' -r +complete -c tasker -n '__fish_seen_subcommand_from set' \ + -s d -l desc -d 'Set description' -r + +complete -c tasker -n '__fish_seen_subcommand_from delete' \ + -f -a '(__tasker_task_dirs)' -d 'Task directory'
\ No newline at end of file |