lattest-lib-0.1.0.0: src/Lattest/Adapter/Adapter.hs
module Lattest.Adapter.Adapter (
-- * Definition
Adapter(..),
-- * Interaction
send,
observe,
tryObserve,
-- * Transformations
map,
mapTestChoices,
mapActionsFromSut,
parseActionsFromSut
)
where
import Prelude hiding (map)
import Control.Monad.STM(atomically)
import Data.Attoparsec.ByteString(Parser)
import Data.ByteString(ByteString)
import System.IO.Streams (OutputStream)
import System.IO.Streams.Combinators(contramap)
import Lattest.Streams.Synchronized(TInputStream, tryReadIO, Streamed)
import Lattest.Streams.Synchronized.Attoparsec (parserToInputStream)
import qualified System.IO.Streams as Streams (write)
import qualified Lattest.Streams.Synchronized as Streams (map,read)
-- | An adapter to a (usually external) system. Uses two channels for interaction: one to send input commands, and one to receive outputs.
data Adapter act i = Adapter {
inputCommandsToSut :: OutputStream i, -- ^ Channel for sending input commands.
actionsFromSut :: TInputStream act, -- ^ Channel for receiving outputs.
-- TODO should calling close somehow also automatically send a Nothing to the inputCommandsToSut?
close :: IO () -- ^ Close the (channels of this) adapter.
}
{-instance AbstractAdapter BlockingAdapter where
inputCommandsToSut = blockingTestChoicesToSut
actionsFromSut = blockingActionsFromSut
unblockedActionsFromSut adap = do
unblockedActions <- forkEagerInputStream $ blockingActionsFromSut adap
return $ Adapter {
readyTestChoicesToSut = blockingTestChoicesToSut adap,
readyActionsFromSut = unblockedActions,
readyClose = close adap
}
close = blockingClose
-}
{-|
Try to observe, without blocking, with three possible outcomes:
* An observation is made,
* no observation was ready, so no observation was made but another attempt may make an observation,
* The stream has closed, and any further attempts will give the same result.
-}
tryObserve :: Adapter act i -> IO (Streamed act)
tryObserve = tryReadIO . actionsFromSut
-- | Send an input to the adapter.
send :: i -> Adapter act i -> IO ()
send i adap = Streams.write (Just i) (inputCommandsToSut adap)
{-|
Observe in a blocking manner, with two possible outcomes:
* An observation is made,
* The stream has closed, and any further attempts will give the same result.
-}
observe :: Adapter act i -> IO (Maybe act) -- TODO get rid of the maybe
observe = atomically . Streams.read . actionsFromSut
--------------------
-- transformations --
---------------------
-- | Map a function over the inputs sent to the adapter.
mapTestChoices :: (i' -> i) -> Adapter act i -> IO (Adapter act i')
mapTestChoices f adapter = do
inputCommandsToSut' <- contramap f $ inputCommandsToSut adapter
return $ Adapter {
inputCommandsToSut = inputCommandsToSut',
actionsFromSut = actionsFromSut adapter,
close = close adapter
}
-- | Map a function over the outputs received from the adapter.
mapActionsFromSut :: (act -> act') -> Adapter act i -> IO (Adapter act' i)
mapActionsFromSut f adapter = do
actionsFromSut' <- Streams.map f $ actionsFromSut adapter
return $ Adapter {
inputCommandsToSut = inputCommandsToSut adapter,
actionsFromSut = actionsFromSut',
close = close adapter
}
-- | Map function over both the inputs sent to, and the outputs received from, the adapter.
map :: (i' -> i) -> (act -> act') -> Adapter act i -> IO (Adapter act' i')
map f1 f2 adapter = do
inputCommandsToSut' <- contramap f1 $ inputCommandsToSut adapter
actionsFromSut' <- Streams.map f2 $ actionsFromSut adapter
return $ Adapter {
inputCommandsToSut = inputCommandsToSut',
actionsFromSut = actionsFromSut',
close = close adapter
}
-- | Transform a raw adapter which receives ByteStrings to an adapter which receives objects, parsing the bytestrings with the given parser.
parseActionsFromSut :: Parser act -> Adapter ByteString i -> IO (Adapter act i)
parseActionsFromSut parser adapter = do
actionStream <- parserToInputStream (Just <$> parser) (actionsFromSut adapter)
return $ adapter { actionsFromSut = actionStream }