]> gitweb @ CieloNegro.org - Lucu.git/blob - Network/HTTP/Lucu/Abortion.hs
Code clean-up using convertible-text.
[Lucu.git] / 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