{-# 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