@@ -10,11 +10,13 @@ module Yoga.Fetch.Om.ParseResponse
10import Prelude
10import Prelude
12import Control.Monad.Error.Class (throwError)
12import Control.Monad.Error.Class (throwError)
13+import Data.Either (Either(..))
13import Data.Symbol (class IsSymbol)
14import Data.Symbol (class IsSymbol)
14import Data.Variant (Variant)
15import Data.Variant (Variant)
15import Data.Variant as Variant
16import Data.Variant as Variant
16import Effect.Aff (Aff)
17import Effect.Aff (Aff)
17import Effect.Aff as Aff
18import Effect.Aff as Aff
19+import Effect.Class (liftEffect)
18import Effect.Exception as Exception
20import Effect.Exception as Exception
19import JS.Fetch.Response (Response) as FetchResponse
21import JS.Fetch.Response (Response) as FetchResponse
20import JS.Fetch.Response as Fetch
22import JS.Fetch.Response as Fetch
@@ -23,12 +25,16 @@ import Prim.RowList (class RowToList, RowList)
23import Prim.RowList as RL
25import Prim.RowList as RL
24import Promise.Aff as Promise
26import Promise.Aff as Promise
25import Type.Proxy (Proxy(..))
27import Type.Proxy (Proxy(..))
28+import Unsafe.Coerce (unsafeCoerce)
29+import Yoga.Fetch.Om.StreamDecode (class StreamDecode, decodeStream)
30+import Yoga.HTTP.API.Route.Encoding (PlainText, Streaming)
26import Yoga.HTTP.API.Route.StatusCode (class StatusCodeMap, statusCodeFor, StatusCode(..))
31import Yoga.HTTP.API.Route.StatusCode (class StatusCodeMap, statusCodeFor, StatusCode(..))
27−import Data.Either (Either(..))
28import Yoga.JSON (class ReadForeign, readJSON)
32import Yoga.JSON (class ReadForeign, readJSON)
29import Yoga.JSON.Error (withStringErrors)
33import Yoga.JSON.Error (withStringErrors)
30−import Yoga.Om (Om, fromAff)
34+import Yoga.Om (class ToOm, Om, toOm)
31import Yoga.Om.Error (Exception)
35import Yoga.Om.Error (Exception)
36+import Yoga.Om.Strom (Strom)
37+import Yoga.Om.Strom.WebStream as WebStream
33class ParseResponse (errorRow :: Row Type) (successRow :: Row Type) where
39class ParseResponse (errorRow :: Row Type) (successRow :: Row Type) where
34 parseResponse :: FetchResponse.Response -> Om {} errorRow (Variant successRow)
40 parseResponse :: FetchResponse.Response -> Om {} errorRow (Variant successRow)
@@ -42,21 +48,55 @@ instance
42 ParseResponse errorRow successRow where
48 ParseResponse errorRow successRow where
43 parseResponse fetchResp = do
49 parseResponse fetchResp = do
44 let status = Fetch.status fetchResp
50 let status = Fetch.status fetchResp
45− jsonText <- Promise.toAffE (Fetch.text fetchResp) # fromAff
46 if status >= 200 && status < 300 then
51 if status >= 200 && status < 300 then
47− parseSuccessRL (Proxy :: _ successRL) status jsonText # fromAff
52+ parseSuccessRL (Proxy :: _ successRL) status fetchResp # toOm
48− else if status >= 400 then
53+ else if status >= 400 then do
54+ errorText <- Promise.toAffE (Fetch.text fetchResp) # toOm
49− parseErrorRL (Proxy :: _ errorRL) (Proxy :: _ errorRow) status jsonText
55+ parseErrorRL (Proxy :: _ errorRL) (Proxy :: _ errorRow) status errorText
51 throwError (Variant.inj (Proxy :: _ "exception") (Exception.error ("Unexpected HTTP status code: " <> show status)))
57 throwError (Variant.inj (Proxy :: _ "exception") (Exception.error ("Unexpected HTTP status code: " <> show status)))
53class ParseSuccessRL (rl :: RowList Type) (successRow :: Row Type) | rl -> successRow where
59class ParseSuccessRL (rl :: RowList Type) (successRow :: Row Type) | rl -> successRow where
54− parseSuccessRL :: Proxy rl -> Int -> String -> Aff (Variant successRow)
60+ parseSuccessRL :: Proxy rl -> Int -> FetchResponse.Response -> Aff (Variant successRow)
56instance ParseSuccessRL RL.Nil successRow where
62instance ParseSuccessRL RL.Nil successRow where
57 parseSuccessRL _ status _ =
63 parseSuccessRL _ status _ =
58 Aff.throwError (Exception.error ("Unexpected success status code: " <> show status))
64 Aff.throwError (Exception.error ("Unexpected success status code: " <> show status))
68+ , StatusCodeMap label
69+ , Row.Cons label PlainText tailRow successRow
70+ , Row.Lacks label tailRow
71+ , ParseSuccessRL tailRL successRow
73+ ParseSuccessRL (RL.Cons label PlainText tailRL) successRow where
74+ parseSuccessRL _ actualStatus fetchResp = do
75+ let StatusCode expected = statusCodeFor (Proxy :: _ label)
76+ if actualStatus == expected then do
77+ text <- liftEffect (Fetch.text fetchResp) >>= Promise.toAff
78+ pure (Variant.inj (Proxy :: _ label) (unsafeCoerce text))
80+ parseSuccessRL (Proxy :: _ tailRL) actualStatus fetchResp
84+ , StatusCodeMap label
86+ , Row.Cons label (Streaming a) tailRow successRow
87+ , Row.Lacks label tailRow
88+ , ParseSuccessRL tailRL successRow
90+ ParseSuccessRL (RL.Cons label (Streaming a) tailRL) successRow where
91+ parseSuccessRL _ actualStatus fetchResp = do
92+ let StatusCode expected = statusCodeFor (Proxy :: _ label)
93+ if actualStatus == expected then do
94+ webStream <- liftEffect (Fetch.body fetchResp)
95+ let strom = decodeStream (WebStream.fromReadableStream (unsafeCoerce webStream)) :: Strom {} () a
96+ pure (Variant.inj (Proxy :: _ label) (unsafeCoerce strom))
98+ parseSuccessRL (Proxy :: _ tailRL) actualStatus fetchResp
60else instance
100else instance
61 ( IsSymbol label
101 ( IsSymbol label
62 , StatusCodeMap label
102 , StatusCodeMap label
@@ -66,13 +106,15 @@ else instance
66 , ParseSuccessRL tailRL successRow
106 , ParseSuccessRL tailRL successRow
68 ParseSuccessRL (RL.Cons label body tailRL) successRow where
108 ParseSuccessRL (RL.Cons label body tailRL) successRow where
69− parseSuccessRL _ actualStatus jsonText = do
109+ parseSuccessRL _ actualStatus fetchResp = do
70 let StatusCode expected = statusCodeFor (Proxy :: _ label)
110 let StatusCode expected = statusCodeFor (Proxy :: _ label)
111+ if actualStatus == expected then do
112+ jsonText <- liftEffect (Fetch.text fetchResp) >>= Promise.toAff
71− if actualStatus == expected then case withStringErrors (readJSON jsonText) of
113+ case withStringErrors (readJSON jsonText) of
72− Left errs -> Aff.throwError (Exception.error ("Failed to parse response (status " <> show actualStatus <> "):\n" <> errs))
114+ Left errs -> Aff.throwError (Exception.error ("Failed to parse response (status " <> show actualStatus <> "):\n" <> errs))
73− Right parsed -> pure (Variant.inj (Proxy :: _ label) parsed)
115+ Right parsed -> pure (Variant.inj (Proxy :: _ label) parsed)
75− parseSuccessRL (Proxy :: _ tailRL) actualStatus jsonText
117+ parseSuccessRL (Proxy :: _ tailRL) actualStatus fetchResp
77class ParseErrorRL (rl :: RowList Type) (errorRow :: Row Type) | rl -> errorRow where
119class ParseErrorRL (rl :: RowList Type) (errorRow :: Row Type) | rl -> errorRow where
78 parseErrorRL
120 parseErrorRL
@@ -87,6 +129,22 @@ instance ParseErrorRL RL.Nil errorRow where
87 parseErrorRL _ _ status _ =
129 parseErrorRL _ _ status _ =
88 throwError (Variant.inj (Proxy :: _ "exception") (Exception.error ("Unexpected error status code: " <> show status)))
130 throwError (Variant.inj (Proxy :: _ "exception") (Exception.error ("Unexpected error status code: " <> show status)))
134+ , StatusCodeMap label
135+ , Row.Cons label PlainText tailRow errorRow
136+ , Row.Lacks label tailRow
137+ , Row.Cons label PlainText tailExc (Exception errorRow)
138+ , ParseErrorRL tailRL errorRow
140+ ParseErrorRL (RL.Cons label PlainText tailRL) errorRow where
141+ parseErrorRL _ errorProxy actualStatus text = do
142+ let StatusCode expected = statusCodeFor (Proxy :: _ label)
143+ if actualStatus == expected then
144+ throwError (Variant.inj (Proxy :: _ label) (unsafeCoerce text))
146+ parseErrorRL (Proxy :: _ tailRL) errorProxy actualStatus text
90else instance
148else instance
91 ( IsSymbol label
149 ( IsSymbol label
92 , StatusCodeMap label
150 , StatusCodeMap label