commit 010abbef60f23efe3bc59b9343f1b05c0296b68b Author: Mirrowel Date: Sat May 25 20:14:01 2024 +0200 First commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c368d45 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +.stack-work/ +*~ \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..8cbbb85 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog for `user-management` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## Unreleased + +## 0.1.0.0 - YYYY-MM-DD diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..9c707ba --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright 2024 Author name here + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..7ab797c --- /dev/null +++ b/README.md @@ -0,0 +1,37 @@ +# User Management System + +This project provides a system for managing users, including adding, listing, finding, and deleting users. + +## Prerequisites + +Before running the project, make sure you have the following installed: + +- [Haskell Stack](https://docs.haskellstack.org/en/stable/README/): a tool for managing Haskell projects +- [SQLite](https://www.sqlite.org/index.html): a lightweight database system + +## Getting Started + +1. Clone the repository: `git clone https://github.com/your-username/user-management.git` + +2. Navigate to the project directory: `cd user-management` + +3. Build the project: `stack build` + +4. Run the application: `stack exec user-management-exe` + +## Usage + +The application provides the following commands: + +- `add-user `: adds a new user to the database +- `list-users`: lists all users in the database +- `find-user `: finds users with a matching name or email +- `delete-user `: deletes a user from the database + +## Contributing + +Contributions are welcome! If you find any issues or have suggestions for improvements, please open an issue or submit a pull request. + +## License + +This project is licensed under the [MIT License](LICENSE). \ No newline at end of file diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..8f30851 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,111 @@ +module Main where + +import UserManager +import Control.Exception +import Text.Printf +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B +import qualified Data.Map as Map + +-- Main entry point of the program +main :: IO () +main = do + putStrLn "Welcome to User Management Console!" -- display a message to the user + initializeDB -- initialize the database + mainMenu -- start the main menu + +-- Main menu of the program +mainMenu :: IO () +mainMenu = do + putStrLn "1. Add User" -- display the options to the user + putStrLn "2. List Users" + putStrLn "3. Find User" + putStrLn "4. Delete User" + putStrLn "5. (DEBUG) Generate and Add Users" + putStrLn "6. Exit" + putStrLn "Choose an option: " -- ask the user to choose an option + option <- getLine + case option of + "1" -> addUserHandler -- handle the option chosen by the user + "2" -> maplistUsersHandler + "3" -> findUserHandler + "4" -> deleteUserHandler + "5" -> do + putStrLn "Enter the number of users to generate and add: " + numUsers <- readLn :: IO Int + generateAndAddUsers numUsers + putStrLn $ "Generated and added " ++ show numUsers ++ " users" + mainMenu + "6" -> putStrLn "Exiting..." -- exit the program + _ -> putStrLn "Invalid option" >> mainMenu + + +formatUser :: User -> ByteString +formatUser user = B.pack $ printf "Name: %s Email: %s Password: %s" (userName user) (userEmail user) (userPassword user) + +-- Handle the addition of a user +addUserHandler :: IO () +addUserHandler = do + putStrLn "Enter user name: " -- ask the user for a name + name <- getLine + putStrLn "Enter user email: " -- ask the user for an email + email <- getLine + putStrLn "Enter user password: " -- ask the user for a password + password <- getLine + addUser name email password `catch` handler -- add the user to the database, handling any errors + mainMenu + +-- Handle the listing of all users +listUsersHandler :: IO () +listUsersHandler = do + putStrLn "" + users <- listUsers -- get the list of all users from the database + let numberedUsers :: [(Int, User)] + numberedUsers = zipWith (\n user -> (n, user)) [1..] users -- add numbering to the users + formattedUsers = map (\(n, user) -> printf "%3d. %-15s %-20s %s" n (userName user) (userEmail user) (userPassword user)) numberedUsers -- format each user as a table row + tableHeader = "No. Name Email Password" -- create the table header + putStrLn tableHeader -- print the table header + putStrLn $ replicate (length tableHeader) '-' -- print a line of dashes under the header + mapM_ putStrLn formattedUsers -- print each user as a table row + putStrLn "" + mainMenu + +-- Handle the listing of all users using Data.Map +maplistUsersHandler :: IO () +maplistUsersHandler = do + putStrLn "" + users <- listUsers -- get the list of all users from the database + let userMap = Map.fromList $ map (\user -> (userName user, user)) users -- create a map with user names as keys + numberedUsers :: [(Int, (UserName, User))] + numberedUsers = zipWith (\n (name, user) -> (n, (name, user))) [1..] (Map.toList userMap) -- add numbering to the users + formattedUsers = map (\(n, (name, user)) -> printf "%3d. %-15s %-20s %s" n name (userEmail user) (userPassword user)) numberedUsers -- format each user as a table row + tableHeader = "No. Name Email Password" -- create the table header + putStrLn tableHeader -- print the table header + putStrLn $ replicate (length tableHeader) '-' -- print a line of dashes under the header + mapM_ putStrLn formattedUsers -- print each user as a table row + putStrLn "" + mainMenu + +-- Handle the finding of a user +findUserHandler :: IO () +findUserHandler = do + putStrLn "Enter user name or email to find: " -- ask the user for a name or email to search for + searchTerm <- getLine + users <- findUsers searchTerm -- search the database for users matching the search term + case users of + [] -> putStrLn "User not found" + _ -> mapM_ (putStrLn . B.unpack . formatUser) users -- print the users to the console using the formatted string + mainMenu + +-- Handle the deletion of a user +deleteUserHandler :: IO () +deleteUserHandler = do + putStrLn "Enter user name to delete: " -- ask the user for a name to delete + name <- getLine + deleteUser name `catch` handler -- delete the user from the database, handling any errors + mainMenu + +-- Handle any exceptions that are thrown by the program +handler :: SomeException -> IO () +handler ex = putStrLn $ "An error occurred: " ++ show ex + diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..823f1d7 --- /dev/null +++ b/package.yaml @@ -0,0 +1,66 @@ +name: user-management +version: 0.1.0.0 +github: "githubuser/user-management" +license: BSD-3-Clause +author: "Author name here" +maintainer: "example@example.com" +copyright: "2024 Author name here" + +extra-source-files: +- README.md +- CHANGELOG.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- bytestring +- containers +- sqlite-simple +- exceptions +- hspec +- text +- random + +ghc-options: +- -Wall +- -Wcompat +- -Widentities +- -Wincomplete-record-updates +- -Wincomplete-uni-patterns +- -Wmissing-export-lists +- -Wmissing-home-modules +- -Wpartial-fields +- -Wredundant-constraints + +library: + source-dirs: src + +executables: + user-management-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - user-management + +tests: + user-management-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - user-management diff --git a/src/Lib.hs b/src/Lib.hs new file mode 100644 index 0000000..d36ff27 --- /dev/null +++ b/src/Lib.hs @@ -0,0 +1,6 @@ +module Lib + ( someFunc + ) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/src/UserManager.hs b/src/UserManager.hs new file mode 100644 index 0000000..2c0a287 --- /dev/null +++ b/src/UserManager.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE OverloadedStrings #-} + +module UserManager ( + -- | Add a user + addUser, + -- | List all users + listUsers, + -- | Find a user by name + findUsers, + -- | Delete a user by name + deleteUser, + -- | Initialize the database + initializeDB, + generateAndAddUsers, + -- | Data type representing a user + User(..), + UserName +) where + +import Data.Map (Map) +import qualified Data.Map as Map +import Control.Exception +import Database.SQLite.Simple +import Database.SQLite.Simple.FromRow +import Control.Monad +import Data.String (fromString) + +-- | Type synonym for a user name +type UserName = String + +-- | Type synonym for a user email +type Email = String + +-- | Type synonym for a Map of user name to email +type UserDB = Map UserName (Email, String) + +-- | Data type representing a user +data User = User { + -- | User name + userName :: UserName, + -- | User email + userEmail :: Email, + -- | User password + userPassword :: String +} deriving (Show, Eq, Ord) + +-- | Instance of FromRow for User +instance FromRow User where + fromRow = User <$> field <*> field <*> field + +-- | Connect to the database +connectDB :: IO Connection +connectDB = open "users.db" + +-- | Initialize the database +initializeDB :: IO () +initializeDB = do + -- Connect to database and create users table if it doesn't exist + conn <- connectDB + execute_ conn (fromString "CREATE TABLE IF NOT EXISTS users (name TEXT PRIMARY KEY, email TEXT, password TEXT)") + close conn + +-- | Add a user +addUser :: UserName -> Email -> String -> IO () +addUser name email password = do + -- Connect to database and add user + conn <- connectDB + execute conn (fromString "INSERT INTO users (name, email, password) VALUES (?, ?, ?)") (name, email, password :: String) + close conn + +-- | List all users +listUsers :: IO [User] +listUsers = do + -- Connect to database and query for all users + conn <- connectDB + users <- query_ conn (fromString "SELECT name, email, password FROM users") :: IO [User] + close conn + return users + +-- | Find users by name or email +findUsers :: String -> IO [User] +findUsers searchTerm = do + -- Connect to database and query for users matching the search term + conn <- connectDB + users <- query conn (fromString "SELECT name, email, password FROM users WHERE name = ? OR email = ?") (searchTerm, searchTerm) :: IO [User] + close conn + return users + +-- | Delete a user by name +deleteUser :: UserName -> IO () +deleteUser name = do + -- Connect to database and delete user + conn <- connectDB + execute conn (fromString "DELETE FROM users WHERE name = ?") (Only name) + close conn + +generateAndAddUsers :: Int -> IO () +generateAndAddUsers numUsers = do + conn <- connectDB + forM_ [1..numUsers] $ \i -> do + let name = "User_" ++ show i + email = name ++ "@example.com" + password = "password" + execute conn (fromString "INSERT INTO users (name, email, password) VALUES (?, ?, ?)") (name, email, password :: String) + close conn \ No newline at end of file diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..8422ae4 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,67 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-22.21 +# resolver: nightly-2024-05-06 +# resolver: ghc-9.6.5 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2023-01-01.yaml +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/23.yaml + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of Stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.15" +# +# Override the architecture used by Stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by Stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..7aa847e --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,13 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + sha256: 73ad581de7c5306278aec7706cafaf3b1c2eb7abf4ab586e4d9dc675c6106c4e + size: 718708 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/23.yaml + original: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/23.yaml diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..a824f8c --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/UserManagerSpec.hs b/test/UserManagerSpec.hs new file mode 100644 index 0000000..89eebd3 --- /dev/null +++ b/test/UserManagerSpec.hs @@ -0,0 +1,37 @@ +module UserManagerSpec (main, spec) where + +-- Main entry point for the specs +main :: IO () +main = hspec spec + +-- Specs for the UserManager module +spec :: Spec +spec = before_ initializeDB $ do + -- Specs for the UserManager functions + describe "UserManager" $ do + -- Specs for the addUser function + it "should add and list users" $ do + -- Create a user and list all users + addUser "testUser" "testUser@example.com" + users <- listUsers + -- Check that the user was added + users `shouldContain` [User "testUser" "testUser@example.com"] + + -- Specs for the findUser function + it "should find a user" $ do + -- Create a user and search for them + addUser "findUser" "findUser@example.com" + user <- findUser "findUser" + -- Check that the user was found + user `shouldBe` Just (User "findUser" "findUser@example.com") + + -- Specs for the deleteUser function + it "should delete a user" $ do + -- Create a user and delete them + addUser "deleteUser" "deleteUser@example.com" + deleteUser "deleteUser" + -- Check that the user was deleted + user <- findUser "deleteUser" + user `shouldBe` Nothing + + diff --git a/user-management.cabal b/user-management.cabal new file mode 100644 index 0000000..8d8d0d4 --- /dev/null +++ b/user-management.cabal @@ -0,0 +1,90 @@ +cabal-version: 2.2 + +-- This file has been generated from package.yaml by hpack version 0.36.0. +-- +-- see: https://github.com/sol/hpack + +name: user-management +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/githubuser/user-management#readme +bug-reports: https://github.com/githubuser/user-management/issues +author: Author name here +maintainer: example@example.com +copyright: 2024 Author name here +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/githubuser/user-management + +library + exposed-modules: + Lib + UserManager + other-modules: + Paths_user_management + autogen-modules: + Paths_user_management + hs-source-dirs: + src + 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 + , bytestring + , containers + , exceptions + , hspec + , random + , sqlite-simple + , text + default-language: Haskell2010 + +executable user-management-exe + main-is: Main.hs + other-modules: + Paths_user_management + autogen-modules: + Paths_user_management + hs-source-dirs: + 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 + , bytestring + , containers + , exceptions + , hspec + , random + , sqlite-simple + , text + , user-management + default-language: Haskell2010 + +test-suite user-management-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + UserManagerSpec + Paths_user_management + autogen-modules: + Paths_user_management + hs-source-dirs: + 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 + , bytestring + , containers + , exceptions + , hspec + , random + , sqlite-simple + , text + , user-management + default-language: Haskell2010 diff --git a/users.db b/users.db new file mode 100644 index 0000000..108a788 Binary files /dev/null and b/users.db differ