SaveFragment.hs

{-# LANGUAGE ExistentialQuantification, TemplateHaskell, DeriveDataTypeable #-}
module SecondTransfer.IOCallbacks.SaveFragment (
                 SaveReadFragment
               , newSaveReadFragment
       ) where

import           Control.Lens
import           Control.Concurrent

--import           Data.IORef
--import           Data.Typeable

import qualified Data.ByteString                              as B
import qualified Data.ByteString.Lazy                         as LB
--import qualified Data.ByteString.Builder                      as Bu

import           SecondTransfer.IOCallbacks.Types


data SaveReadFragment = SaveReadFragment {
    _inner_SRF          :: IOCallbacks
  , _fragment_SRF       :: MVar B.ByteString
    }

makeLenses ''SaveReadFragment


pushAction :: SaveReadFragment -> LB.ByteString -> IO ()
pushAction srf what = (srf ^.  inner_SRF . pushAction_IOC ) what


bestEffortPullAction :: SaveReadFragment -> Bool -> IO B.ByteString
bestEffortPullAction srf can_block  = do
    maybe_fragment <- tryTakeMVar (srf ^. fragment_SRF )
    case maybe_fragment of
        Nothing -> (srf ^. inner_SRF . bestEffortPullAction_IOC ) can_block
        Just fragment -> return fragment


closeAction :: SaveReadFragment -> IO ()
closeAction srf = do
    _ <- tryTakeMVar (srf ^. fragment_SRF)
    srf ^. inner_SRF . closeAction_IOC


newSaveReadFragment :: IOCallbacks ->  B.ByteString -> IO SaveReadFragment
newSaveReadFragment io_callbacks fragment = do
    fragment_mvar <- newMVar fragment
    return SaveReadFragment {
        _inner_SRF = io_callbacks
      , _fragment_SRF = fragment_mvar
        }


instance IOChannels SaveReadFragment where

    handshake srf = do
        pull_action_wrapping <- newPullActionWrapping $ bestEffortPullAction srf

        return $ IOCallbacks {
            _pushAction_IOC = pushAction srf
          , _pullAction_IOC = pullFromWrapping' pull_action_wrapping
          , _bestEffortPullAction_IOC = bestEffortPullFromWrapping pull_action_wrapping
          , _closeAction_IOC = closeAction srf
            }