Network/HTTP/Lucu/Abortion.hs

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