-abort status headers
- = liftIO ∘ throwIO ∘ Abortion status (toHeaders headers)
-
--- |This is similar to 'abort' but computes it with
--- 'System.IO.Unsafe.unsafePerformIO'.
-abortPurely :: StatusCode → [ (CIAscii, Ascii) ] → Maybe Text → a
-{-# INLINE abortPurely #-}
-abortPurely status headers
- = throw ∘ Abortion status (toHeaders headers)
-
--- |Computation of @'abortSTM' status headers msg@ just computes
--- 'abort' in a 'Control.Monad.STM.STM' monad.
-abortSTM :: StatusCode → [ (CIAscii, Ascii) ] → Maybe Text → STM a
-{-# INLINE abortSTM #-}
-abortSTM status headers
- = throwSTM ∘ Abortion status (toHeaders headers)
-
--- | Computation of @'abortA' -< (status, (headers, msg))@ just
--- computes 'abort' in an 'Control.Arrow.ArrowIO.ArrowIO'.
-abortA :: Arrow (⇝) ⇒ (StatusCode, ([ (CIAscii, Ascii) ], Maybe Text)) ⇝ c
-{-# INLINE abortA #-}
-abortA = proc (status, (headers, msg)) →
- returnA ⤙ abortPurely status headers msg
-
--- aboMessage が Just なら單に mkDefaultPage に渡すだけで良いので樂だが、
--- Nothing の場合は getDefaultPage を使ってデフォルトのメッセージを得な
--- ければならない。
-abortPage :: Config → Maybe Request → Response → Abortion → Lazy.Text
-abortPage conf reqM res abo
- = case aboMessage abo of
- Just msg
- → let [html] = runLA ( mkDefaultPage conf (aboStatus abo) (txt $ T.unpack msg)
- ⋙
- writeDocumentToString [ withIndent True ]
- ) ()
- in
- Lazy.pack html
- Nothing
- → let res' = res { resStatus = aboStatus abo }
- res'' = foldl (∘) id [setHeader name value
- | (name, value) ← fromHeaders $ aboHeaders abo] res'
- in
- getDefaultPage conf reqM res''