module Eventloop.Module.File.File
( setupFileModuleConfiguration
, fileModuleIdentifier
, fileEventRetriever
, fileEventSender
, fileTeardown
) where
import Data.Maybe
import Control.Concurrent.Datastructures.BlockingConcurrentQueue
import Control.Concurrent.STM
import System.IO
import Eventloop.Module.File.Types
import Eventloop.Types.Common
import Eventloop.Types.Events
import Eventloop.Types.System
setupFileModuleConfiguration :: EventloopSetupModuleConfiguration
setupFileModuleConfiguration = ( EventloopSetupModuleConfiguration
fileModuleIdentifier
(Just fileInitializer)
(Just fileEventRetriever)
Nothing
Nothing
(Just fileEventSender)
(Just fileTeardown)
)
fileModuleIdentifier :: EventloopModuleIdentifier
fileModuleIdentifier = "file"
fileInitializer :: Initializer
fileInitializer sharedConst sharedIO
= do
inQueue <- createBlockingConcurrentQueue
return (sharedConst, sharedIO, FileConstants inQueue, FileState [])
fileEventRetriever :: EventRetriever
fileEventRetriever sharedConst sharedIOT ioConst ioStateT
= do
fileInEvents <- takeAllFromBlockingConcurrentQueue queue
return (map InFile fileInEvents)
where
queue = fileInQueue ioConst
fileEventSender :: EventSender
fileEventSender _ _ _ _ Stop = return ()
fileEventSender sharedConst sharedIOT ioConst ioStateT (OutFile out)
= do
(FileState openFiles) <- readTVarIO ioStateT
(openFiles', inEvents) <- fileEventSender' openFiles out
atomically $ writeTVar ioStateT (FileState openFiles')
putAllInBlockingConcurrentQueue inQueue inEvents
where
inQueue = fileInQueue ioConst
fileEventSender' :: [OpenFile] -> FileOut -> IO ([OpenFile], [FileIn])
fileEventSender' openFiles (OpenFile filepath iomode)
= do
handle <- openFile filepath iomode
let
fileOpenedEvent = FileOpened filepath True
openFiles' = openFiles ++ [(filepath, handle, iomode)]
return (openFiles', [fileOpenedEvent])
fileEventSender' openFiles (CloseFile filepath)
| openFileM == Nothing = return ([], [])
| otherwise = do
hClose handle
return (openFiles', [closedFileEvent])
where
openFileM = retrieveOpenedFile openFiles filepath
(fp, handle, iomode) = fromJust openFileM
openFiles' = removeOpenedFile openFiles filepath
closedFileEvent = FileClosed filepath True
fileEventSender' openFiles (RetrieveContents filepath)
= doReadAction filepath openFiles RetrievedContents retrieveContents
fileEventSender' openFiles (RetrieveLine filepath)
= doReadAction filepath openFiles RetrievedLine hGetLine
fileEventSender' openFiles (RetrieveChar filepath)
= doReadAction filepath openFiles RetrievedChar hGetChar
fileEventSender' openFiles (IfEOF filepath)
= getFromFile filepath openFiles fileIsOpened IsEOF hIsEOF
fileEventSender' openFiles (WriteTo filepath contents)
| fileIsWriteable openFiles filepath = do
hPutStr handle contents
return (openFiles, [WroteTo filepath True])
| otherwise = return (openFiles, [])
where
Just (fp, handle, iomode) = retrieveOpenedFile openFiles filepath
doReadAction :: FilePath
-> [OpenFile]
-> (FilePath -> a -> FileIn)
-> (Handle -> IO a)
-> IO ([OpenFile], [FileIn])
doReadAction filepath openFiles inEvent readAction
= getFromFile filepath openFiles fileIsReadable inEvent readAction
getFromFile :: FilePath ->
[OpenFile] ->
([OpenFile] -> FilePath -> Bool) ->
(FilePath -> a -> FileIn) ->
(Handle -> IO a) ->
IO ([OpenFile], [FileIn])
getFromFile filepath openFiles fileCheck inEvent action
| fileCheck openFiles filepath = do
result <- action handle
return (openFiles, [inEvent filepath result])
| otherwise = return (openFiles, [])
where
Just (fp, handle, iomode) = retrieveOpenedFile openFiles filepath
fileIsReadable :: [OpenFile] -> FilePath -> Bool
fileIsReadable opened filepath | fileIsOpened opened filepath = iomode == ReadMode || iomode == ReadWriteMode
| otherwise = False
where
Just (fp, handle, iomode) = retrieveOpenedFile opened filepath
fileIsWriteable :: [OpenFile] -> FilePath -> Bool
fileIsWriteable opened filepath | fileIsOpened opened filepath = iomode == WriteMode || iomode == ReadWriteMode || iomode == AppendMode
| otherwise = False
where
Just (fp, handle, iomode) = retrieveOpenedFile opened filepath
fileIsOpened :: [OpenFile] -> FilePath -> Bool
fileIsOpened opened filepath = not (openedFileM == Nothing)
where
openedFileM = retrieveOpenedFile opened filepath
retrieveContents :: Handle -> IO [[Char]]
retrieveContents handle = do
line <- hGetLine handle
isEOF <- hIsEOF handle
if isEOF
then
return [line]
else do
lines <- retrieveContents handle
return (line:lines)
retrieveOpenedFile :: [OpenFile] -> FilePath -> Maybe OpenFile
retrieveOpenedFile [] _ = Nothing
retrieveOpenedFile (openfile@(fp, h, iom):ofs) ufp | ufp == fp = Just openfile
| otherwise = retrieveOpenedFile ofs ufp
removeOpenedFile :: [OpenFile] -> FilePath -> [OpenFile]
removeOpenedFile [] _ = []
removeOpenedFile (openfile@(fp, h, iom):ofs) ufp | ufp == fp = ofs
| otherwise = openfile:(removeOpenedFile ofs ufp)
fileTeardown :: Teardown
fileTeardown sharedConst sharedIO ioConst ioState
= do
closeAllFiles handles
return (sharedIO)
where
handles = map (\(fp, h, iom) -> h) (opened ioState)
closeAllFiles :: [Handle] -> IO ()
closeAllFiles [] = return ()
closeAllFiles (h:hs) = do
hClose h
closeAllFiles hs