{-# LANGUAGE
    FlexibleContexts
  , UnicodeSyntax
  #-}
-- |Aborting the computation of 'Network.HTTP.Lucu.Rsrc' in any 'IO'
-- monads.
module Network.HTTP.Lucu.Abortion
    ( Abortion
    , mkAbortion
    , mkAbortion'

    , abort
    )
    where
import Control.Exception
import Control.Monad.Trans
import Data.Ascii (Ascii, CIAscii)
import Data.Collections
import Data.Monoid.Unicode
import Data.Text (Text)
import Network.HTTP.Lucu.Abortion.Internal
import Network.HTTP.Lucu.Response.StatusCode
import Prelude.Unicode

-- |Construct an 'Abortion' with additional headers and an optional
-- message text.
mkAbortion ∷ (StatusCode sc, Foldable f (CIAscii, Ascii))
           ⇒ sc
           → f
           → Maybe Text
           → Abortion
{-# INLINE mkAbortion #-}
mkAbortion sc hdrs msg
    = Abortion {
        aboStatus  = fromStatusCode sc
      , aboHeaders = fromFoldable hdrs
      , aboMessage = msg
      }

-- |Construct an 'Abortion' without any additional headers but with a
-- message text.
mkAbortion' ∷ StatusCode sc ⇒ sc → Text → Abortion
{-# INLINE mkAbortion' #-}
mkAbortion' sc msg
    = Abortion {
        aboStatus  = fromStatusCode sc
      , aboHeaders = (∅)
      , aboMessage = Just msg
      }

-- |Throw an 'Abortion' in a 'MonadIO', including the very
-- 'Network.HTTP.Lucu.Rsrc' monad.
abort ∷ MonadIO m ⇒ Abortion → m a
{-# INLINE abort #-}
abort = liftIO ∘ throwIO