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. 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