StatusCode is now a type class, not an algebraic data type.

[Lucu.git] / Network / HTTP / Lucu / Interaction.hs

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 3be8928bf83a7edf473458c6760b06275b3cf886..df5e2302d21b16da302ce833bd849a2d1a068766 100644 (file)
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -109,7 +109,6 @@ mkSemanticallyInvalidInteraction ∷ Config
                                  → IO SemanticallyInvalidInteraction
 mkSemanticallyInvalidInteraction config@(Config {..}) (AugmentedRequest {..})
     = do date ← getCurrentDate
-         -- FIXME: DRY
          let res  = setHeader "Server"       cnfServerSoftware      $
                     setHeader "Date"         date                   $
                     setHeader "Content-Type" defaultPageContentType $
@@ -217,11 +216,11 @@ type InteractionQueue = TVar (Seq SomeInteraction)
 mkInteractionQueue ∷ IO InteractionQueue
 mkInteractionQueue = newTVarIO (∅)
 
-setResponseStatus ∷ NormalInteraction → StatusCode → STM ()
+setResponseStatus ∷ StatusCode sc ⇒ NormalInteraction → sc → STM ()
 setResponseStatus (NI {..}) sc
     = do res ← readTVar niResponse
          let res' = res {
-                      resStatus = sc
+                      resStatus = fromStatusCode sc
                     }
          writeTVar niResponse res'