X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource%2FInternal.hs;h=e066fa9074e8eaf4173ce60f715dc2b2bbdb3bdd;hp=9df36a601cf7dc460dd8b98f92ed084054719504;hb=51eda5b;hpb=ece223c516e66223ef1d5d8e6bbe4054a235d983

diff --git a/Network/HTTP/Lucu/Resource/Internal.hs b/Network/HTTP/Lucu/Resource/Internal.hs
index 9df36a6..e066fa9 100644
--- a/Network/HTTP/Lucu/Resource/Internal.hs
+++ b/Network/HTTP/Lucu/Resource/Internal.hs
@@ -304,7 +304,7 @@ getChunk' n
 
 -- |Declare the response status code. If you don't call this function,
 -- the status code will be defaulted to \"200 OK\".
-setStatus ∷ StatusCode → Resource ()
+setStatus ∷ StatusCode sc ⇒ sc → Resource ()
 setStatus sc
     = do ni ← getInteraction
          liftIO $ atomically
@@ -329,9 +329,7 @@ setStatus sc
 -- body and thinks that the residual 10 bytes is a part of the header
 -- of the next response.
 setHeader ∷ CIAscii → Ascii → Resource ()
-setHeader name value
-    = do ni ← getInteraction
-         liftIO $ atomically $ go ni
+setHeader name value = liftIO ∘ atomically ∘ go =≪ getInteraction
     where
       go ∷ NormalInteraction → STM ()
       go (NI {..})
@@ -346,9 +344,7 @@ setHeader name value
 -- |@'deleteHeader' name@ deletes a response header @name@ if
 -- any. This function is not intended to be used so frequently.
 deleteHeader ∷ CIAscii → Resource ()
-deleteHeader name
-    = do ni ← getInteraction
-         liftIO $ atomically $ go ni
+deleteHeader name = liftIO ∘ atomically ∘ go =≪ getInteraction
     where
       go ∷ NormalInteraction → STM ()
       go (NI {..})
@@ -365,12 +361,10 @@ deleteHeader name
 -- infinitely long stream of octets.
 --
 -- Note that you must first declare the response header
--- \"Content-Type\" before applying this function. See
--- 'setContentType'.
+-- \"Content-Type\" before applying this function. See:
+-- 'setContentType'
 putBuilder ∷ Builder → Resource ()
-putBuilder b
-    = do ni ← getInteraction
-         liftIO $ atomically $ go ni
+putBuilder b = liftIO ∘ atomically ∘ go =≪ getInteraction
     where
       go ∷ NormalInteraction → STM ()
       go ni@(NI {..})
@@ -383,9 +377,7 @@ putBuilder b
                putTMVar niBodyToSend b
 
 driftTo ∷ InteractionState → Resource ()
-driftTo newState
-    = do ni ← getInteraction
-         liftIO $ atomically $ driftTo' ni newState
+driftTo = (getInteraction ≫=) ∘ ((liftIO ∘ atomically) ∘) ∘ flip driftTo'
 
 driftTo' ∷ NormalInteraction → InteractionState → STM ()
 driftTo' ni@(NI {..}) newState