Add Map to app

This commit is contained in:
s464968 2024-05-25 21:09:43 +02:00
parent a24b69796c
commit 0f41cc33c3
3 changed files with 38 additions and 12 deletions

View File

@ -4,16 +4,20 @@ module Main where
import System.IO
import System.Directory
import Data.Text (Text, pack, unpack, isInfixOf, lines, unlines)
import Data.Text (Text, pack, unpack, isInfixOf, lines, unlines, strip, splitOn)
import qualified Data.Text.IO as TIO
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)
todoFile :: FilePath
todoFile = "todo.txt"
type TaskMap = Map.Map Int Text
main :: IO ()
main = do
putStrLn "Welcome to the Haskell Todo App"
@ -39,8 +43,9 @@ displayTasks = do
if exists
then do
contents <- TIO.readFile todoFile
let taskMap = parseTasks contents
putStrLn "Tasks:"
TIO.putStrLn contents
mapM_ (putStrLn . showTask) (Map.toList taskMap)
else putStrLn "No tasks found."
main
@ -49,23 +54,31 @@ addTask = do
putStr "Enter the task: "
hFlush stdout
task <- getLine
TIO.appendFile todoFile (pack task <> "\n")
exists <- doesFileExist todoFile
if exists
then do
contents <- TIO.readFile todoFile
let taskMap = parseTasks contents
newId = if Map.null taskMap then 1 else fst (Map.findMax taskMap) + 1
newTaskMap = Map.insert newId (pack task) taskMap
TIO.writeFile todoFile (serializeTasks newTaskMap)
else TIO.writeFile todoFile (pack task <> "\n")
putStrLn "Task added."
main
filterTasksByTag :: IO ()
filterTasksByTag = do
putStr "Enter the tag to filter by (e.g., +chapelShelving): "
putStr "Enter the tag to filter by (e.g., +GarageSale): "
hFlush stdout
tag <- getLine
exists <- doesFileExist todoFile
if exists
then do
contents <- TIO.readFile todoFile
let tasks = Data.Text.lines contents
filteredTasks = filter (isInfixOf (pack tag)) tasks
let taskMap = parseTasks contents
filteredTasks = Map.filter (isInfixOf (pack tag)) taskMap
putStrLn "Filtered tasks:"
TIO.putStrLn (Data.Text.unlines filteredTasks)
mapM_ (putStrLn . showTask) (Map.toList filteredTasks)
else putStrLn "No tasks found."
main
@ -75,10 +88,10 @@ sortTasksByPriority = do
if exists
then do
contents <- TIO.readFile todoFile
let tasks = Data.Text.lines contents
sortedTasks = sortBy comparePriority tasks
let taskMap = parseTasks contents
sortedTasks = sortBy (comparePriority `on` snd) (Map.toList taskMap)
putStrLn "Sorted tasks by priority:"
TIO.putStrLn (Data.Text.unlines sortedTasks)
mapM_ (putStrLn . showTask) sortedTasks
else putStrLn "No tasks found."
main
@ -86,6 +99,15 @@ comparePriority :: Text -> Text -> Ordering
comparePriority t1 t2 = comparing getPriority t1 t2
getPriority :: Text -> Maybe Char
getPriority t = case unpack t of
getPriority t = case unpack (strip t) of
('(':p:')':_) | isAlpha p -> Just p
_ -> Nothing
_ -> Nothing
parseTasks :: Text -> TaskMap
parseTasks = Map.fromList . zip [1..] . Data.Text.lines
serializeTasks :: TaskMap -> Text
serializeTasks = Data.Text.unlines . map snd . Map.toList
showTask :: (Int, Text) -> String
showTask (_, task) = unpack task

View File

@ -23,6 +23,7 @@ dependencies:
- base >= 4.7 && < 5
- text
- directory
- containers
ghc-options:
- -Wall

View File

@ -35,6 +35,7 @@ library
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
build-depends:
base >=4.7 && <5
, containers
, directory
, text
default-language: Haskell2010
@ -50,6 +51,7 @@ executable todo-app
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends:
base >=4.7 && <5
, containers
, directory
, text
, todo-app
@ -67,6 +69,7 @@ test-suite todo-app-test
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends:
base >=4.7 && <5
, containers
, directory
, text
, todo-app