eventloop-0.2.1.1: src/Eventloop/Module/StdIn/StdIn.hs

module Eventloop.Module.StdIn.StdIn
    ( defaultStdInModuleConfiguration
    , defaultStdInModuleIOState
    , stdInModuleIdentifier
    , stdInEventRetriever
    , stdInEventSender
    ) where

import System.IO
import Data.String

import Eventloop.Types.EventTypes
import Eventloop.Module.StdIn.Types

defaultStdInModuleConfiguration :: EventloopModuleConfiguration
defaultStdInModuleConfiguration = ( EventloopModuleConfiguration 
                                    stdInModuleIdentifier
                                    defaultStdInModuleIOState
                                    Nothing
                                    (Just stdInEventRetriever)
                                    Nothing
                                    Nothing
                                    Nothing
                                    (Just stdInEventSender)
                                  )

defaultStdInModuleIOState :: IOState
defaultStdInModuleIOState = StdInState []

stdInModuleIdentifier :: EventloopModuleIdentifier
stdInModuleIdentifier = "stdin"


stdInEventRetriever :: EventRetriever
stdInEventRetriever sharedIO (StdInState events) = return (sharedIO, StdInState [], inEvents)
                                                where
                                                    inEvents = map InStdIn events

stdInEventSender :: EventSender
stdInEventSender sharedIO stdInState (OutStdIn a) = do
                                                        stdInState' <- stdInEventSender' stdInState a
                                                        return (sharedIO, stdInState')
                                            
stdInEventSender' :: IOState -> StdInOut -> IO IOState
stdInEventSender' stdInState StdInReceiveContents = doStdInGet stdInState linedGetContents StdInReceivedContents
                                                where
                                                    linedGetContents = (getContents >>= (\strContents -> return $ lines strContents))
                  
stdInEventSender' stdInState StdInReceiveLine = doStdInGet stdInState getLine StdInReceivedLine
stdInEventSender' stdInState StdInReceiveChar = doStdInGet stdInState getChar StdInReceivedChar
                                                
                                                
doStdInGet :: IOState -> (IO a) -> (a -> StdInIn) -> IO IOState
doStdInGet stdInState source typeEvent = do
                                            let
                                                events = newStdInInEvents stdInState
                                            content <- source
                                            let
                                                event = typeEvent content
                                                events' = events ++ [event]
                                            return (stdInState {newStdInInEvents = events'})