import Control.Concurrent.STM
import Control.Exception
import Control.Monad.Trans
-import Data.ByteString.Base (ByteString)
+import qualified Data.ByteString.Char8 as C8
import Data.Dynamic
import GHC.Conc (unsafeIOToSTM)
import Network.HTTP.Lucu.Config
-- > abort MovedPermanently
-- > [("Location", "http://example.net/")]
-- > (Just "It has been moved to example.net")
-abort :: MonadIO m => StatusCode -> [ (ByteString, ByteString) ] -> Maybe String -> m a
+abort :: MonadIO m => StatusCode -> [ (String, String) ] -> Maybe String -> m a
abort status headers msg
= status `seq` headers `seq` msg `seq`
- let abo = Abortion status (toHeaders headers) msg
+ let abo = Abortion status (toHeaders $ map pack headers) msg
exc = DynException (toDyn abo)
in
liftIO $ throwIO exc
+ where
+ pack (x, y) = (C8.pack x, C8.pack y)
-- |This is similar to 'abort' but computes it with
-- 'System.IO.Unsafe.unsafePerformIO'.
-abortPurely :: StatusCode -> [ (ByteString, ByteString) ] -> Maybe String -> a
+abortPurely :: StatusCode -> [ (String, String) ] -> Maybe String -> a
abortPurely = ((unsafePerformIO .) .) . abort
-- |Computation of @'abortSTM' status headers msg@ just computes
-- 'abort' in a 'Control.Monad.STM.STM' monad.
-abortSTM :: StatusCode -> [ (ByteString, ByteString) ] -> Maybe String -> STM a
+abortSTM :: StatusCode -> [ (String, String) ] -> Maybe String -> STM a
abortSTM status headers msg
= status `seq` headers `seq` msg `seq`
unsafeIOToSTM $! abort status headers msg
-- | Computation of @'abortA' -< (status, (headers, msg))@ just
-- computes 'abort' in an 'Control.Arrow.ArrowIO.ArrowIO'.
-abortA :: ArrowIO a => a (StatusCode, ([ (ByteString, ByteString) ], Maybe String)) c
+abortA :: ArrowIO a => a (StatusCode, ([ (String, String) ], Maybe String)) c
abortA
= arrIO3 abort