mirror of
https://github.com/ilyakooo0/servant-reflex.git
synced 2024-09-11 07:15:29 +03:00
fanReqResult
(and tagged alternative)
This commit is contained in:
parent
9a3b58cdc7
commit
f6d2b36f06
@ -12,6 +12,7 @@ module Servant.Common.Req where
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
import Control.Applicative (liftA2, liftA3)
|
||||
import Control.Arrow ((&&&))
|
||||
import Control.Concurrent
|
||||
import Control.Monad (join)
|
||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||
@ -91,6 +92,13 @@ reqFailure (ResponseFailure _ s _) = Just s
|
||||
reqFailure (RequestFailure _ s) = Just s
|
||||
reqFailure _ = Nothing
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Simple filter/accessor like 'reqFailure', but keeping the request tag
|
||||
reqFailure' :: ReqResult tag a -> Maybe (tag,Text)
|
||||
reqFailure' (ResponseFailure tag s _) = Just (tag,s)
|
||||
reqFailure' (RequestFailure tag s) = Just (tag,s)
|
||||
reqFailure' _ = Nothing
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Simple filter/accessor for the raw XHR response
|
||||
@ -394,6 +402,18 @@ evalResponse decode (tag, xhr) =
|
||||
else ResponseFailure tag errMsg xhr
|
||||
in respPayld
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Utility for simultaneously accessing/filtering Success and Failure
|
||||
-- response 'Event's,
|
||||
fanReqResult :: Reflex t => Event t (ReqResult tag a) -> (Event t Text, Event t a)
|
||||
fanReqResult = fmapMaybe reqFailure &&& fmapMaybe reqSuccess
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Utility for simultaneously accessing/filtering Success and Failure
|
||||
-- response 'Event's, but keeping the request tag
|
||||
fanReqResult' :: Reflex t => Event t (ReqResult tag a) -> (Event t (tag, Text), Event t (tag, a))
|
||||
fanReqResult' = fmapMaybe reqFailure' &&& fmapMaybe reqSuccess'
|
||||
|
||||
|
||||
note :: e -> Maybe a -> Either e a
|
||||
note e = maybe (Left e) Right
|
||||
@ -407,3 +427,4 @@ builderToText = TE.decodeUtf8 . BL.toStrict . Builder.toLazyByteString
|
||||
|
||||
escape :: T.Text -> T.Text
|
||||
escape = T.pack . N.escapeURIString (not . N.isReserved) . T.unpack . TE.decodeUtf8 . BL.toStrict . Builder.toLazyByteString . toEncodedUrlPiece
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user