X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FInteraction.hs;h=52a5e2eea41e76b334015fedcee80089babad881;hp=19faec28fe7a1fb506f42d5416123f17ec52a61d;hb=db4b61223e0d8b34079d3b190fb3e3644b0b4866;hpb=054e36027618944ea45f85ae349e51b76a139270 diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs index 19faec2..52a5e2e 100644 --- a/Network/HTTP/Lucu/Interaction.hs +++ b/Network/HTTP/Lucu/Interaction.hs @@ -11,17 +11,20 @@ module Network.HTTP.Lucu.Interaction , newInteraction , defaultPageContentType + , chunksToLBS + , chunksFromLBS + , writeItr , readItr - , readItrF , updateItr - , updateItrF ) where import Control.Applicative import Control.Concurrent.STM import Data.Ascii (Ascii) import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import Data.Foldable import Data.Sequence (Seq) import qualified Data.Sequence as S import Network.Socket @@ -151,28 +154,26 @@ newInteraction !conf !port !addr !cert !req , itrWroteHeader = wroteHeader } -writeItr ∷ Interaction → (Interaction → TVar a) → a → STM () +chunksToLBS ∷ Seq BS.ByteString → LBS.ByteString +{-# INLINE chunksToLBS #-} +chunksToLBS = LBS.fromChunks ∘ toList + +chunksFromLBS ∷ LBS.ByteString → Seq BS.ByteString +{-# INLINE chunksFromLBS #-} +chunksFromLBS = S.fromList ∘ LBS.toChunks + +writeItr ∷ (Interaction → TVar a) → a → Interaction → STM () {-# INLINE writeItr #-} -writeItr itr accessor - = writeTVar (accessor itr) +writeItr accessor a itr + = writeTVar (accessor itr) a -readItr ∷ Interaction → (Interaction → TVar a) → (a → b) → STM b +readItr ∷ (Interaction → TVar a) → (a → b) → Interaction → STM b {-# INLINE readItr #-} -readItr itr accessor reader +readItr accessor reader itr = reader <$> readTVar (accessor itr) -readItrF ∷ Functor f => Interaction → (Interaction → TVar (f a)) → (a → b) → STM (f b) -{-# INLINE readItrF #-} -readItrF itr accessor reader - = readItr itr accessor (fmap reader) - -updateItr ∷ Interaction → (Interaction → TVar a) → (a → a) → STM () +updateItr ∷ (Interaction → TVar a) → (a → a) → Interaction → STM () {-# INLINE updateItr #-} -updateItr itr accessor updator - = do old ← readItr itr accessor id - writeItr itr accessor (updator old) - -updateItrF ∷ Functor f => Interaction → (Interaction → TVar (f a)) → (a → a) → STM () -{-# INLINE updateItrF #-} -updateItrF itr accessor - = updateItr itr accessor ∘ fmap +updateItr accessor updator itr + = do old ← readItr accessor id itr + writeItr accessor (updator old) itr