{-# 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. Filter tasks by tag" putStrLn "4. Sort tasks by priority" putStrLn "5. Exit" putStr "Choose an option: " hFlush stdout option <- getLine case option of "1" -> displayTasks "2" -> addTask "3" -> filterTasksByTag "4" -> sortTasksByPriority "5" -> 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." 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." 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." main where handleReadError :: IOException -> IO Text handleReadError e = do putStrLn $ "Error reading file: " ++ show e return "" 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." main where handleReadError :: IOException -> IO Text handleReadError e = do putStrLn $ "Error reading file: " ++ show e return "" 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