280 lines
8.9 KiB
Haskell
280 lines
8.9 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Main(main, parseTask, serializeTask, getPriority, comparePriority, TaskMap) where
|
|
|
|
import System.IO
|
|
import System.Directory
|
|
import Data.Text (Text, pack, unpack, isInfixOf, lines, unlines, strip, splitOn)
|
|
import qualified Data.Text.IO as TIO
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Char8 as BSC
|
|
import Control.Monad (when)
|
|
import Data.List (sortBy)
|
|
import Data.Ord (comparing)
|
|
import Data.Char (isAlpha)
|
|
import qualified Data.Map as Map
|
|
import Data.Function (on)
|
|
import Control.Exception (catch, IOException)
|
|
|
|
todoFile :: FilePath
|
|
todoFile = "todo.txt"
|
|
|
|
type TaskMap = Map.Map Int Text
|
|
|
|
main :: IO ()
|
|
main = do
|
|
putStrLn "Welcome to the Haskell Todo App"
|
|
putStrLn "1. Display tasks"
|
|
putStrLn "2. Add task"
|
|
putStrLn "3. Add task (Manual)"
|
|
putStrLn "4. Edit task"
|
|
putStrLn "5. Filter tasks by tag"
|
|
putStrLn "6. Sort tasks by priority"
|
|
putStrLn "7. Remove task"
|
|
putStrLn "8. Exit"
|
|
putStr "Choose an option: "
|
|
hFlush stdout
|
|
option <- getLine
|
|
case option of
|
|
"1" -> displayTasks
|
|
"2" -> addTask
|
|
"3" -> addTaskWithManual
|
|
"4" -> editTask
|
|
"5" -> filterTasksByTag
|
|
"6" -> sortTasksByPriority
|
|
"7" -> removeTask
|
|
"8" -> putStrLn "Goodbye!"
|
|
_ -> putStrLn "Invalid option" >> main
|
|
|
|
|
|
displayTasks :: IO ()
|
|
displayTasks = do
|
|
exists <- doesFileExist todoFile
|
|
if exists
|
|
then do
|
|
contents <- catch (TIO.readFile todoFile) handleReadError
|
|
let taskMap = parseTask contents
|
|
putStrLn "Tasks:"
|
|
mapM_ (putStrLn . showTask) (Map.toList taskMap)
|
|
else putStrLn "No tasks found."
|
|
putStrLn " -------------- "
|
|
putStrLn "Press Enter"
|
|
option <- getLine
|
|
case option of
|
|
_ -> main
|
|
where
|
|
handleReadError :: IOException -> IO Text
|
|
handleReadError e = do
|
|
putStrLn $ "Error reading file: " ++ show e
|
|
return ""
|
|
|
|
addTask :: IO ()
|
|
addTask = do
|
|
putStr "Enter the task: "
|
|
hFlush stdout
|
|
task <- getLine
|
|
exists <- doesFileExist todoFile
|
|
if exists
|
|
then do
|
|
contents <- catch (TIO.readFile todoFile) handleReadError
|
|
let taskMap = parseTask contents
|
|
newId = if Map.null taskMap then 1 else fst (Map.findMax taskMap) + 1
|
|
newTaskMap = Map.insert newId (pack task) taskMap
|
|
catch (TIO.writeFile todoFile (serializeTask newTaskMap)) handleWriteError
|
|
else catch (TIO.writeFile todoFile (pack task <> "\n")) handleWriteError
|
|
putStrLn "Task added."
|
|
putStrLn " -------------- "
|
|
putStrLn "Press Enter"
|
|
option <- getLine
|
|
case option of
|
|
_ -> main
|
|
where
|
|
handleReadError :: IOException -> IO Text
|
|
handleReadError e = do
|
|
putStrLn $ "Error reading file: " ++ show e
|
|
return ""
|
|
|
|
handleWriteError :: IOException -> IO ()
|
|
handleWriteError e = putStrLn $ "Error writing file: " ++ show e
|
|
|
|
addTaskWithManual :: IO ()
|
|
addTaskWithManual = do
|
|
putStrLn "First, optionally you can add priority to the task you want to add. To do so, put letter inside '()'"
|
|
putStrLn "Tasks without priority will be displayed first."
|
|
putStrLn "Second, write your task."
|
|
putStrLn "Third, optionally you can add tags to your task. To do so, put '+'and write your tag."
|
|
putStrLn "Tasks can have more than one tag."
|
|
putStrLn "Example: (C) go shopping +shop +sunday"
|
|
putStrLn " -------------- "
|
|
putStrLn "Press Enter to add your task or x to go back to menu"
|
|
option <- getLine
|
|
case option of
|
|
"x" -> main
|
|
_ -> addTask
|
|
|
|
|
|
editTask :: IO ()
|
|
editTask = do
|
|
exists <- doesFileExist todoFile
|
|
if exists
|
|
then do
|
|
contents <- catch (TIO.readFile todoFile) handleReadError
|
|
let taskMap = parseTask contents
|
|
putStrLn "Existing tasks: "
|
|
mapM_ (putStrLn . showTaskId) (Map.toList taskMap)
|
|
|
|
putStr "Enter the ID of the task you wish to edit: "
|
|
hFlush stdout
|
|
taskIdStr <- getLine
|
|
let taskId = read taskIdStr :: Int
|
|
|
|
putStrLn ""
|
|
|
|
if Map.member taskId taskMap
|
|
then do
|
|
putStrLn "Enter the new task description: "
|
|
newTask <- getLine
|
|
let newTaskMap = Map.insert taskId (pack newTask) taskMap
|
|
catch (TIO.writeFile todoFile (serializeTask newTaskMap)) handleWriteError
|
|
putStrLn "Task edited."
|
|
else do
|
|
putStrLn "Task of this ID doesn't exist"
|
|
putStrLn "Do you wish to try again? Press Enter if yes or x to go back to menu"
|
|
option <- getLine
|
|
case option of
|
|
"x" -> main
|
|
_ -> editTask
|
|
|
|
else putStrLn "No tasks found."
|
|
putStrLn " -------------- "
|
|
putStrLn "Press Enter"
|
|
option <- getLine
|
|
case option of
|
|
_ -> main
|
|
where
|
|
handleReadError :: IOException -> IO Text
|
|
handleReadError e = do
|
|
putStrLn $ "Error reading file: " ++ show e
|
|
return ""
|
|
|
|
handleWriteError :: IOException -> IO ()
|
|
handleWriteError e = putStrLn $ "Error writing file: " ++ show e
|
|
|
|
|
|
filterTasksByTag :: IO ()
|
|
filterTasksByTag = do
|
|
putStr "Enter the tag to filter by (e.g., +GarageSale): "
|
|
hFlush stdout
|
|
tag <- getLine
|
|
exists <- doesFileExist todoFile
|
|
if exists
|
|
then do
|
|
contents <- catch (TIO.readFile todoFile) handleReadError
|
|
let taskMap = parseTask contents
|
|
filteredTasks = Map.filter (isInfixOf (pack tag)) taskMap
|
|
putStrLn "Filtered tasks:"
|
|
mapM_ (putStrLn . showTask) (Map.toList filteredTasks)
|
|
else putStrLn "No tasks found."
|
|
putStrLn " -------------- "
|
|
putStrLn "Press Enter"
|
|
option <- getLine
|
|
case option of
|
|
_ -> main
|
|
where
|
|
handleReadError :: IOException -> IO Text
|
|
handleReadError e = do
|
|
putStrLn $ "Error reading file: " ++ show e
|
|
return ""
|
|
|
|
handleWriteError :: IOException -> IO ()
|
|
handleWriteError e = putStrLn $ "Error writing file: " ++ show e
|
|
|
|
sortTasksByPriority :: IO ()
|
|
sortTasksByPriority = do
|
|
exists <- doesFileExist todoFile
|
|
if exists
|
|
then do
|
|
contents <- catch (TIO.readFile todoFile) handleReadError
|
|
let taskMap = parseTask contents
|
|
sortedTasks = sortBy (comparePriority `on` snd) (Map.toList taskMap)
|
|
putStrLn "Sorted tasks by priority:"
|
|
mapM_ (putStrLn . showTask) sortedTasks
|
|
else putStrLn "No tasks found."
|
|
putStrLn " -------------- "
|
|
putStrLn "Press Enter"
|
|
option <- getLine
|
|
case option of
|
|
_ -> main
|
|
where
|
|
handleReadError :: IOException -> IO Text
|
|
handleReadError e = do
|
|
putStrLn $ "Error reading file: " ++ show e
|
|
return ""
|
|
|
|
removeTask :: IO ()
|
|
removeTask = do
|
|
|
|
exists <- doesFileExist todoFile
|
|
if exists
|
|
then do
|
|
contents <- catch (TIO.readFile todoFile) handleReadError
|
|
let taskMap = parseTask contents
|
|
putStrLn "Existing tasks: "
|
|
mapM_ (putStrLn . showTaskId) (Map.toList taskMap)
|
|
|
|
putStr "Enter the ID of the task you wish to remove: "
|
|
hFlush stdout
|
|
taskIdStr <- getLine
|
|
let taskId = read taskIdStr :: Int
|
|
|
|
putStrLn ""
|
|
|
|
if Map.member taskId taskMap
|
|
then do
|
|
let newTaskMap = Map.delete taskId taskMap
|
|
catch (TIO.writeFile todoFile (serializeTask newTaskMap)) handleWriteError
|
|
putStrLn "Task removed."
|
|
else do
|
|
putStrLn "Task of this ID doesn't exist"
|
|
putStrLn "Do you wish to try again? Press Enter if yes or x to go back to menu"
|
|
option <- getLine
|
|
case option of
|
|
"x" -> main
|
|
_ -> removeTask
|
|
|
|
else putStrLn "No tasks found."
|
|
putStrLn " -------------- "
|
|
putStrLn "Press Enter"
|
|
option <- getLine
|
|
case option of
|
|
_ -> main
|
|
where
|
|
handleReadError :: IOException -> IO Text
|
|
handleReadError e = do
|
|
putStrLn $ "Error reading file: " ++ show e
|
|
return ""
|
|
|
|
handleWriteError :: IOException -> IO ()
|
|
handleWriteError e = putStrLn $ "Error writing file: " ++ show e
|
|
|
|
|
|
|
|
comparePriority :: Text -> Text -> Ordering
|
|
comparePriority t1 t2 = comparing getPriority t1 t2
|
|
|
|
getPriority :: Text -> Maybe Char
|
|
getPriority t = case unpack (strip t) of
|
|
('(':p:')':_) | isAlpha p -> Just p
|
|
_ -> Nothing
|
|
|
|
parseTask :: Text -> TaskMap
|
|
parseTask = Map.fromList . zip [1..] . Data.Text.lines
|
|
|
|
serializeTask :: TaskMap -> Text
|
|
serializeTask = Data.Text.unlines . map snd . Map.toList
|
|
|
|
showTask :: (Int, Text) -> String
|
|
showTask (_, task) = unpack task
|
|
|
|
showTaskId :: (Int, Text) -> String
|
|
showTaskId (taskId, task) = show taskId ++ ": " ++ unpack task |