Add Map to app
This commit is contained in:
parent
a24b69796c
commit
0f41cc33c3
44
app/Main.hs
44
app/Main.hs
@ -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
|
@ -23,6 +23,7 @@ dependencies:
|
|||||||
- base >= 4.7 && < 5
|
- base >= 4.7 && < 5
|
||||||
- text
|
- text
|
||||||
- directory
|
- directory
|
||||||
|
- containers
|
||||||
|
|
||||||
ghc-options:
|
ghc-options:
|
||||||
- -Wall
|
- -Wall
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user