Forgor to upload :skull emoji:

This commit is contained in:
Mirrowel 2024-06-03 17:48:31 +02:00
parent 60ab4cb2ab
commit 68591237c0
5 changed files with 58 additions and 40 deletions

View File

@ -28,6 +28,7 @@ dependencies:
- hspec
- text
- random
- directory
ghc-options:
- -Wall

View File

@ -1 +1,54 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
{-# LANGUAGE OverloadedStrings #-}
import Test.Hspec
import UserManager
import Database.SQLite.Simple
import Control.Exception (bracket_)
import System.Directory (removeFile, doesFileExist)
main :: IO ()
main = hspec $ do
describe "UserManager" $ do
beforeAll_ setupDB $
afterAll_ cleanupDB $ do
it "initializes the database" $ do
conn <- open "test_users.db"
tables <- query_ conn "SELECT name FROM sqlite_master WHERE type='table' AND name='users';" :: IO [Only String]
close conn
tables `shouldBe` [Only "users"]
it "adds a user" $ do
addUser "test_user" "test@example.com" "password"
users <- listUsers
users `shouldBe` [User "test_user" "test@example.com" "password"]
it "lists users" $ do
addUser "test_user1" "test1@example.com" "password1"
addUser "test_user2" "test2@example.com" "password2"
users <- listUsers
users `shouldBe` [User "test_user1" "test1@example.com" "password1", User "test_user2" "test2@example.com" "password2"]
it "finds users by name" $ do
addUser "unique_user" "unique@example.com" "password"
users <- findUsers "unique_user"
users `shouldBe` [User "unique_user" "unique@example.com" "password"]
it "finds users by email" $ do
addUser "another_user" "another@example.com" "password"
users <- findUsers "another@example.com"
users `shouldBe` [User "another_user" "another@example.com" "password"]
it "deletes a user" $ do
addUser "delete_user" "delete@example.com" "password"
deleteUser "delete_user"
users <- listUsers
users `shouldSatisfy` all (\user -> userName user /= "delete_user")
setupDB :: IO ()
setupDB = do
conn <- open "test_users.db"
execute_ conn "CREATE TABLE users (name TEXT PRIMARY KEY, email TEXT, password TEXT)"
close conn
cleanupDB :: IO ()
cleanupDB = removeFile "test_users.db"

View File

@ -1,37 +0,0 @@
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

View File

@ -13,7 +13,6 @@ author: Author name here
maintainer: example@example.com
copyright: 2024 Author name here
license: BSD-3-Clause
license-file: LICENSE.md
build-type: Simple
extra-source-files:
README.md
@ -38,6 +37,7 @@ library
base >=4.7 && <5
, bytestring
, containers
, directory
, exceptions
, hspec
, random
@ -58,6 +58,7 @@ executable user-management-exe
base >=4.7 && <5
, bytestring
, containers
, directory
, exceptions
, hspec
, random
@ -70,7 +71,6 @@ 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
@ -81,6 +81,7 @@ test-suite user-management-test
base >=4.7 && <5
, bytestring
, containers
, directory
, exceptions
, hspec
, random

BIN
users.db

Binary file not shown.