haskell_todo_app/app/Main.hs

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