{-|
Module      : DataHandler
Description : Módulo contendo as operações de manipulação de dados e persistência do sistema SIGES.
-}
{-# LANGUAGE OverloadedStrings #-}
module Handlers.DataHandler where

import qualified Data.ByteString.Lazy as BL

import Manager

-- | Esta função tem o valor igual ao caminho para o arquivo json com os dados temporários de usuário.
userTmpJSON :: FilePath
userTmpJSON :: FilePath
userTmpJSON = FilePath
"data/userTemp.json"

-- | Esta função tem o valor igual ao caminho para o arquivo json com os dados de usuário.
userJSON :: FilePath
userJSON :: FilePath
userJSON = FilePath
"data/userData.json"

-- | Dado um FilePath, esta função verifica se ele se refere a um arquivo existente.
fileExists :: FilePath -> IO Bool
fileExists :: FilePath -> IO Bool
fileExists FilePath
path = do FilePath -> IO Bool
doesFileExist FilePath
path

instance FromJSON User where
instance ToJSON User where

instance FromJSON UserFull where
instance ToJSON UserFull where

-- | Esta função verifica os usuários cadastrados no sistema e retornará um valor booleano true caso o sistema não possua nenhum usuário cadastrado ainda, e false em caso contrário.
noUsersYet :: IO Bool
noUsersYet :: IO Bool
noUsersYet = do
   (Just [UserFull]
existingUsers) <- ByteString -> Maybe [UserFull]
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe [UserFull])
-> IO ByteString -> IO (Maybe [UserFull])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BL.readFile FilePath
userJSON :: IO (Maybe [UserFull])
   Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ([UserFull] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UserFull]
existingUsers)

-- | Esta função considera um UserFull, e caso o seu e-mail já não esteja cadastrado no sistema,. ela o incluirá no sistema, retornando um valor booleano indicando se foi possível incluir o novo usuário.
saveUser :: UserFull -> IO Bool
saveUser :: UserFull -> IO Bool
saveUser UserFull
newUser = do
   (Just [UserFull]
allUsers) <- ByteString -> Maybe [UserFull]
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe [UserFull])
-> IO ByteString -> IO (Maybe [UserFull])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BL.readFile FilePath
userJSON :: IO (Maybe [UserFull])
   let correspondingUsers :: [UserFull]
correspondingUsers = (UserFull -> Bool) -> [UserFull] -> [UserFull]
forall a. (a -> Bool) -> [a] -> [a]
filter (\UserFull
user -> UserFull -> FilePath
email UserFull
user FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== UserFull -> FilePath
email UserFull
newUser) [UserFull]
allUsers
   if [UserFull] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UserFull]
correspondingUsers
      then do {FilePath -> ByteString -> IO ()
BL.writeFile FilePath
userJSON (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [UserFull] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([UserFull]
allUsers [UserFull] -> [UserFull] -> [UserFull]
forall a. [a] -> [a] -> [a]
++ [UserFull
newUser]); Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True}
      else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Esta função considera uma String, e caso ela corresponda ao e-mail de um dos usuários, a função eliminará o usuário equivalente do sistema, retornando um valor booleano indicando se a remoção pôde ser feita.
deleteUser :: String -> IO Bool
deleteUser :: FilePath -> IO Bool
deleteUser FilePath
emailStr = do
   (Just [UserFull]
allUsers) <- ByteString -> Maybe [UserFull]
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe [UserFull])
-> IO ByteString -> IO (Maybe [UserFull])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BL.readFile FilePath
userJSON :: IO (Maybe [UserFull])
   let allButOne :: [UserFull]
allButOne = (UserFull -> Bool) -> [UserFull] -> [UserFull]
forall a. (a -> Bool) -> [a] -> [a]
filter (\UserFull
user -> UserFull -> FilePath
email UserFull
user FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
emailStr) [UserFull]
allUsers
   FilePath -> ByteString -> IO ()
BL.writeFile FilePath
userJSON (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [UserFull] -> ByteString
forall a. ToJSON a => a -> ByteString
encode [UserFull]
allButOne
   Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ [UserFull]
allUsers [UserFull] -> [UserFull] -> Bool
forall a. Eq a => a -> a -> Bool
/= [UserFull]
allButOne -- If both arrays are equal, then nothing was removed

-- | Esta função considerará uma String, e retornará o usuário cadastrado no sistema com o e-mail igual a esta String, caso exista.
getUser :: String -> IO (Maybe UserFull)
getUser :: FilePath -> IO (Maybe UserFull)
getUser FilePath
emailStr = do
   (Just [UserFull]
allUsers) <- ByteString -> Maybe [UserFull]
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe [UserFull])
-> IO ByteString -> IO (Maybe [UserFull])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BL.readFile FilePath
userJSON :: IO (Maybe [UserFull])
   let correspondingUsers :: [UserFull]
correspondingUsers = (UserFull -> Bool) -> [UserFull] -> [UserFull]
forall a. (a -> Bool) -> [a] -> [a]
filter (\UserFull
user -> UserFull -> FilePath
email UserFull
user FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
emailStr) [UserFull]
allUsers
   if [UserFull] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UserFull]
correspondingUsers
      then Maybe UserFull -> IO (Maybe UserFull)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe UserFull
forall a. Maybe a
Nothing
      else Maybe UserFull -> IO (Maybe UserFull)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe UserFull -> IO (Maybe UserFull))
-> Maybe UserFull -> IO (Maybe UserFull)
forall a b. (a -> b) -> a -> b
$ UserFull -> Maybe UserFull
forall a. a -> Maybe a
Just ([UserFull] -> UserFull
forall a. [a] -> a
head [UserFull]
correspondingUsers)

-- | Esta função considerará uma String, e verificará o sistema para buscar o usuário cadastrado no sistema com o e-mail igual à String. O UserFull será então incluído, como Uswer (Que contém menos informações) nos dados temporários do sistema. Estes dados poderão então ser acessados em tempo de execução do sistema.
signUser :: String -> IO ()
signUser :: FilePath -> IO ()
signUser FilePath
emailStr = do
   (Just UserFull
userfull) <- FilePath -> IO (Maybe UserFull)
getUser FilePath
emailStr
   let user :: User
user = FilePath -> FilePath -> Bool -> User
User (UserFull -> FilePath
name UserFull
userfull) (UserFull -> FilePath
email UserFull
userfull) (UserFull -> Bool
isAdmin UserFull
userfull)
   FilePath -> ByteString -> IO ()
BL.writeFile FilePath
userTmpJSON (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ User -> ByteString
forall a. ToJSON a => a -> ByteString
encode User
user

-- | Esta função decidirá se algum usuário está atualmente logado no sistema.
hasLoggedUser :: IO Bool
hasLoggedUser :: IO Bool
hasLoggedUser = do FilePath -> IO Bool
fileExists FilePath
userTmpJSON

-- | Esta função retornará o Usuário atualmente logado no sistema.
getLoggedUser :: IO User
getLoggedUser :: IO User
getLoggedUser = do
   Maybe User
tmpUser <- ByteString -> Maybe User
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe User) -> IO ByteString -> IO (Maybe User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BL.readFile FilePath
userTmpJSON
   IO User -> (User -> IO User) -> Maybe User -> IO User
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO User
getLoggedUser User -> IO User
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe User
tmpUser

-- | Esta função deslogará um usuário do sistema, destruindo as informações salvas temporariamente.
signOutUser :: IO ()
signOutUser :: IO ()
signOutUser = do
   Bool
existsTmp <- IO Bool
hasLoggedUser
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
existsTmp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
userTmpJSON

-- | Esta função tem o valor igual ao caminho para o arquivo json com os dados das salas.
roomsJSON :: FilePath
roomsJSON :: FilePath
roomsJSON = FilePath
"data/roomsData.json"

instance FromJSON ResourceKind where
instance ToJSON ResourceKind where

instance FromJSON Resource where
instance ToJSON Resource where

instance FromJSON RoomCategory where
instance ToJSON RoomCategory where

instance FromJSON Reservation where
instance ToJSON Reservation where

instance FromJSON Room where
instance ToJSON Room where

-- | Esta função retorna uma lista contendo todas as salas cadastradas no sistema.
fetchRooms :: IO [Room]
fetchRooms :: IO [Room]
fetchRooms = do
   (Just [Room]
allRooms) <- ByteString -> Maybe [Room]
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe [Room]) -> IO ByteString -> IO (Maybe [Room])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BL.readFile FilePath
roomsJSON :: IO (Maybe [Room])
   [Room] -> IO [Room]
forall (m :: * -> *) a. Monad m => a -> m a
return [Room]
allRooms

-- | Esta função verifica as salas cadastradas no sistema e retornará um valor booleano true caso o sistema não possua nenhuma sala cadastrada ainda, e false em caso contrário.
noRoomsYet :: IO Bool
noRoomsYet :: IO Bool
noRoomsYet = [Room] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Room] -> Bool) -> IO [Room] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Room]
fetchRooms

-- | Esta função considera uma sala, e caso ela ainda não exista no sistema, será incluída e um valor booleano true será retornado. Caso contrário, um valor booleano false será retornado.
saveRoom :: Room -> IO Bool
saveRoom :: Room -> IO Bool
saveRoom Room
newRoom = do
   [Room]
allRooms <- IO [Room]
fetchRooms
   let correspondingRooms :: [Room]
correspondingRooms = (Room -> Bool) -> [Room] -> [Room]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Room
room -> Room -> FilePath
code Room
room FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Room -> FilePath
code Room
newRoom) [Room]
allRooms
   if [Room] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Room]
correspondingRooms
      then do {FilePath -> ByteString -> IO ()
BL.writeFile FilePath
roomsJSON (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Room] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([Room]
allRooms [Room] -> [Room] -> [Room]
forall a. [a] -> [a] -> [a]
++ [Room
newRoom]); Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True}
      else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Esta função usa uma String contendo um código de sala e uma sala nova para substituir a sala com o código dado pela versão nova da mesma sala.
updateRoom :: String -> Room -> IO Bool
updateRoom :: FilePath -> Room -> IO Bool
updateRoom FilePath
codeRoom Room
newRoom = do
   Bool
operate <- FilePath -> IO Bool
deleteRoom FilePath
codeRoom
   Room -> IO Bool
saveRoom Room
newRoom

-- | Esta função recebe uma função e atualiza todas as salas do sistema aplicando sobre elas a função determinada.
updateAllRooms :: (Room -> Room) -> IO Bool
updateAllRooms :: (Room -> Room) -> IO Bool
updateAllRooms Room -> Room
function = do
   [Room]
allRooms <- IO [Room]
fetchRooms
   let updated :: [Room]
updated = (Room -> Room) -> [Room] -> [Room]
forall a b. (a -> b) -> [a] -> [b]
map Room -> Room
function [Room]
allRooms
   FilePath -> ByteString -> IO ()
BL.writeFile FilePath
roomsJSON (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Room] -> ByteString
forall a. ToJSON a => a -> ByteString
encode [Room]
updated
   Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Esta função considera uma String, e caso ela corresponda ao código de uma das salas, a função eliminará a sala equivalente do sistema, retornando um valor booleano indicando se a remoção pôde ser feita.
deleteRoom :: String -> IO Bool
deleteRoom :: FilePath -> IO Bool
deleteRoom FilePath
codeStr = do
   [Room]
allRooms <- IO [Room]
fetchRooms
   let removed :: [Room]
removed = (Room -> Bool) -> [Room] -> [Room]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Room
room -> Room -> FilePath
code Room
room FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
codeStr) [Room]
allRooms
   if [Room]
allRooms [Room] -> [Room] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Room]
removed
      then do {FilePath -> ByteString -> IO ()
BL.writeFile FilePath
roomsJSON (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Room] -> ByteString
forall a. ToJSON a => a -> ByteString
encode [Room]
removed; Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True}
      else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Esta função considerará uma String, e retornará a sala cadastrada no sistema com o código igual a esta String, caso exista.
getRoom :: String -> IO (Maybe Room)
getRoom :: FilePath -> IO (Maybe Room)
getRoom FilePath
codeStr = do
   [Room]
allRooms <- IO [Room]
fetchRooms
   let corresponding :: [Room]
corresponding = (Room -> Bool) -> [Room] -> [Room]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Room
room -> Room -> FilePath
code Room
room FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
codeStr) [Room]
allRooms
   if [Room] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Room]
corresponding
      then Maybe Room -> IO (Maybe Room)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Room
forall a. Maybe a
Nothing
      else Maybe Room -> IO (Maybe Room)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Room -> IO (Maybe Room)) -> Maybe Room -> IO (Maybe Room)
forall a b. (a -> b) -> a -> b
$ Room -> Maybe Room
forall a. a -> Maybe a
Just ([Room] -> Room
forall a. [a] -> a
head [Room]
corresponding)