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.IO
import System.Directory 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 qualified Data.Text.IO as TIO
import Control.Monad (when) import Control.Monad (when)
import Data.List (sortBy) import Data.List (sortBy)
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Char (isAlpha) import Data.Char (isAlpha)
import qualified Data.Map as Map
import Data.Function (on)
todoFile :: FilePath todoFile :: FilePath
todoFile = "todo.txt" todoFile = "todo.txt"
type TaskMap = Map.Map Int Text
main :: IO () main :: IO ()
main = do main = do
putStrLn "Welcome to the Haskell Todo App" putStrLn "Welcome to the Haskell Todo App"
@ -39,8 +43,9 @@ displayTasks = do
if exists if exists
then do then do
contents <- TIO.readFile todoFile contents <- TIO.readFile todoFile
let taskMap = parseTasks contents
putStrLn "Tasks:" putStrLn "Tasks:"
TIO.putStrLn contents mapM_ (putStrLn . showTask) (Map.toList taskMap)
else putStrLn "No tasks found." else putStrLn "No tasks found."
main main
@ -49,23 +54,31 @@ addTask = do
putStr "Enter the task: " putStr "Enter the task: "
hFlush stdout hFlush stdout
task <- getLine 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." putStrLn "Task added."
main main
filterTasksByTag :: IO () filterTasksByTag :: IO ()
filterTasksByTag = do filterTasksByTag = do
putStr "Enter the tag to filter by (e.g., +chapelShelving): " putStr "Enter the tag to filter by (e.g., +GarageSale): "
hFlush stdout hFlush stdout
tag <- getLine tag <- getLine
exists <- doesFileExist todoFile exists <- doesFileExist todoFile
if exists if exists
then do then do
contents <- TIO.readFile todoFile contents <- TIO.readFile todoFile
let tasks = Data.Text.lines contents let taskMap = parseTasks contents
filteredTasks = filter (isInfixOf (pack tag)) tasks filteredTasks = Map.filter (isInfixOf (pack tag)) taskMap
putStrLn "Filtered tasks:" putStrLn "Filtered tasks:"
TIO.putStrLn (Data.Text.unlines filteredTasks) mapM_ (putStrLn . showTask) (Map.toList filteredTasks)
else putStrLn "No tasks found." else putStrLn "No tasks found."
main main
@ -75,10 +88,10 @@ sortTasksByPriority = do
if exists if exists
then do then do
contents <- TIO.readFile todoFile contents <- TIO.readFile todoFile
let tasks = Data.Text.lines contents let taskMap = parseTasks contents
sortedTasks = sortBy comparePriority tasks sortedTasks = sortBy (comparePriority `on` snd) (Map.toList taskMap)
putStrLn "Sorted tasks by priority:" putStrLn "Sorted tasks by priority:"
TIO.putStrLn (Data.Text.unlines sortedTasks) mapM_ (putStrLn . showTask) sortedTasks
else putStrLn "No tasks found." else putStrLn "No tasks found."
main main
@ -86,6 +99,15 @@ comparePriority :: Text -> Text -> Ordering
comparePriority t1 t2 = comparing getPriority t1 t2 comparePriority t1 t2 = comparing getPriority t1 t2
getPriority :: Text -> Maybe Char getPriority :: Text -> Maybe Char
getPriority t = case unpack t of getPriority t = case unpack (strip t) of
('(':p:')':_) | isAlpha p -> Just p ('(':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 - base >= 4.7 && < 5
- text - text
- directory - directory
- containers
ghc-options: ghc-options:
- -Wall - -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 ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, containers
, directory , directory
, text , text
default-language: Haskell2010 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 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: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, containers
, directory , directory
, text , text
, todo-app , 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 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: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, containers
, directory , directory
, text , text
, todo-app , todo-app