X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FAbortion.hs;h=3dc94c2c52a281876b9e7fdff3241184107c00c9;hb=243b99439640480fc148d2e175247dacce04a222;hp=40a8cb5ab0b276103a5cf9e8f4231be7d0e2e20c;hpb=3eb69879d3b336c7c3e613c0ce4bfb3c67989ff3;p=Lucu.git diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs index 40a8cb5..3dc94c2 100644 --- a/Network/HTTP/Lucu/Abortion.hs +++ b/Network/HTTP/Lucu/Abortion.hs @@ -1,8 +1,9 @@ {-# LANGUAGE - UnicodeSyntax + FlexibleContexts + , UnicodeSyntax #-} --- |Aborting the computation of 'Network.HTTP.Lucu.Resource.Resource' --- in any 'Prelude.IO' monads or arrows. +-- |Aborting the computation of 'Network.HTTP.Lucu.Rsrc' in any 'IO' +-- monads. module Network.HTTP.Lucu.Abortion ( Abortion , mkAbortion @@ -14,37 +15,41 @@ module Network.HTTP.Lucu.Abortion 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.Headers -import Network.HTTP.Lucu.Response +import Network.HTTP.Lucu.Response.StatusCode import Prelude.Unicode -- |Construct an 'Abortion' with additional headers and an optional -- message text. -mkAbortion ∷ StatusCode → [(CIAscii, Ascii)] → Maybe Text → Abortion +mkAbortion ∷ (StatusCode sc, Foldable f (CIAscii, Ascii)) + ⇒ sc + → f + → Maybe Text + → Abortion {-# INLINE mkAbortion #-} -mkAbortion sc hdr msg +mkAbortion sc hdrs msg = Abortion { - aboStatus = sc - , aboHeaders = toHeaders hdr + aboStatus = fromStatusCode sc + , aboHeaders = fromFoldable hdrs , aboMessage = msg } -- |Construct an 'Abortion' without any additional headers but with a -- message text. -mkAbortion' ∷ StatusCode → Text → Abortion +mkAbortion' ∷ StatusCode sc ⇒ sc → Text → Abortion {-# INLINE mkAbortion' #-} mkAbortion' sc msg = Abortion { - aboStatus = sc + aboStatus = fromStatusCode sc , aboHeaders = (∅) , aboMessage = Just msg } -- |Throw an 'Abortion' in a 'MonadIO', including the very --- 'Network.HTTP.Lucu.Resource.Resource' monad. +-- 'Network.HTTP.Lucu.Rsrc' monad. abort ∷ MonadIO m ⇒ Abortion → m a {-# INLINE abort #-} abort = liftIO ∘ throwIO