Network/HTTP/Lucu/Abortion.hs

   1 {-# LANGUAGE
   2     UnicodeSyntax
   3   #-}
   4 -- |Aborting the computation of 'Network.HTTP.Lucu.Resource.Resource'
   5 -- in any 'Prelude.IO' monads or arrows.
   6 module Network.HTTP.Lucu.Abortion
   7     ( Abortion
   8     , mkAbortion
   9     , mkAbortion'
  10
  11     , abort
  12     )
  13     where
  14 import Control.Exception
  15 import Control.Monad.Trans
  16 import Data.Ascii (Ascii, CIAscii)
  17 import Data.Monoid.Unicode
  18 import Data.Text (Text)
  19 import Network.HTTP.Lucu.Abortion.Internal
  20 import Network.HTTP.Lucu.Headers
  21 import Network.HTTP.Lucu.Response
  22 import Prelude.Unicode
  23
  24 -- |Construct an 'Abortion' with additional headers and an optional
  25 -- message text.
  26 mkAbortion ∷ StatusCode sc ⇒ sc → [(CIAscii, Ascii)] → Maybe Text → Abortion
  27 {-# INLINE mkAbortion #-}
  28 mkAbortion sc hdr msg
  29     = Abortion {
  30         aboStatus  = fromStatusCode sc
  31       , aboHeaders = toHeaders hdr
  32       , aboMessage = msg
  33       }
  34
  35 -- |Construct an 'Abortion' without any additional headers but with a
  36 -- message text.
  37 mkAbortion' ∷ StatusCode sc ⇒ sc → Text → Abortion
  38 {-# INLINE mkAbortion' #-}
  39 mkAbortion' sc msg
  40     = Abortion {
  41         aboStatus  = fromStatusCode sc
  42       , aboHeaders = (∅)
  43       , aboMessage = Just msg
  44       }
  45
  46 -- |Throw an 'Abortion' in a 'MonadIO', including the very
  47 -- 'Network.HTTP.Lucu.Resource.Resource' monad.
  48 abort ∷ MonadIO m ⇒ Abortion → m a
  49 {-# INLINE abort #-}
  50 abort = liftIO ∘ throwIO