@@ -10,11 +10,13 @@ module Yoga.Fetch.Om.ParseResponse
1010import Prelude
1111
1212import Control.Monad.Error.Class (throwError)
13+import Data.Either (Either(..))
1314import Data.Symbol (class IsSymbol)
1415import Data.Variant (Variant)
1516import Data.Variant as Variant
1617import Effect.Aff (Aff)
1718import Effect.Aff as Aff
19+import Effect.Class (liftEffect)
1820import Effect.Exception as Exception
1921import JS.Fetch.Response (Response) as FetchResponse
2022import JS.Fetch.Response as Fetch
@@ -23,12 +25,16 @@ import Prim.RowList (class RowToList, RowList)
2325import Prim.RowList as RL
2426import Promise.Aff as Promise
2527import 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)
2631import Yoga.HTTP.API.Route.StatusCode (class StatusCodeMap, statusCodeFor, StatusCode(..))
27−import Data.Either (Either(..))
2832import Yoga.JSON (class ReadForeign, readJSON)
2933import Yoga.JSON.Error (withStringErrors)
30−import Yoga.Om (Om, fromAff)
34+import Yoga.Om (class ToOm, Om, toOm)
3135import Yoga.Om.Error (Exception)
36+import Yoga.Om.Strom (Strom)
37+import Yoga.Om.Strom.WebStream as WebStream
3238
3339class ParseResponse (errorRow :: Row Type) (successRow :: Row Type) where
3440 parseResponse :: FetchResponse.Response -> Om {} errorRow (Variant successRow)
@@ -42,21 +48,55 @@ instance
4248 ParseResponse errorRow successRow where
4349 parseResponse fetchResp = do
4450 let status = Fetch.status fetchResp
45− jsonText <- Promise.toAffE (Fetch.text fetchResp) # fromAff
4651 if status >= 200 && status < 300 then
47− parseSuccessRL (Proxy :: _ successRL) status jsonText # fromAff
48− else if status >= 400 then
49− parseErrorRL (Proxy :: _ errorRL) (Proxy :: _ errorRow) status jsonText
52+ parseSuccessRL (Proxy :: _ successRL) status fetchResp # toOm
53+ else if status >= 400 then do
54+ errorText <- Promise.toAffE (Fetch.text fetchResp) # toOm
55+ parseErrorRL (Proxy :: _ errorRL) (Proxy :: _ errorRow) status errorText
5056 else
5157 throwError (Variant.inj (Proxy :: _ "exception") (Exception.error ("Unexpected HTTP status code: " <> show status)))
5258
5359class 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)
5561
5662instance ParseSuccessRL RL.Nil successRow where
5763 parseSuccessRL _ status _ =
5864 Aff.throwError (Exception.error ("Unexpected success status code: " <> show status))
5965
66+else instance
67+ ( IsSymbol label
68+ , StatusCodeMap label
69+ , Row.Cons label PlainText tailRow successRow
70+ , Row.Lacks label tailRow
71+ , ParseSuccessRL tailRL successRow
72+ ) =>
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))
79+ else
80+ parseSuccessRL (Proxy :: _ tailRL) actualStatus fetchResp
81+
82+else instance
83+ ( IsSymbol label
84+ , StatusCodeMap label
85+ , StreamDecode a
86+ , Row.Cons label (Streaming a) tailRow successRow
87+ , Row.Lacks label tailRow
88+ , ParseSuccessRL tailRL successRow
89+ ) =>
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))
97+ else
98+ parseSuccessRL (Proxy :: _ tailRL) actualStatus fetchResp
99+
60100else instance
61101 ( IsSymbol label
62102 , StatusCodeMap label
@@ -66,13 +106,15 @@ else instance
66106 , ParseSuccessRL tailRL successRow
67107 ) =>
68108 ParseSuccessRL (RL.Cons label body tailRL) successRow where
69− parseSuccessRL _ actualStatus jsonText = do
109+ parseSuccessRL _ actualStatus fetchResp = do
70110 let StatusCode expected = statusCodeFor (Proxy :: _ label)
71− if actualStatus == expected then case withStringErrors (readJSON jsonText) of
72− Left errs -> Aff.throwError (Exception.error ("Failed to parse response (status " <> show actualStatus <> "):\n" <> errs))
73− Right parsed -> pure (Variant.inj (Proxy :: _ label) parsed)
111+ if actualStatus == expected then do
112+ jsonText <- liftEffect (Fetch.text fetchResp) >>= Promise.toAff
113+ case withStringErrors (readJSON jsonText) of
114+ Left errs -> Aff.throwError (Exception.error ("Failed to parse response (status " <> show actualStatus <> "):\n" <> errs))
115+ Right parsed -> pure (Variant.inj (Proxy :: _ label) parsed)
74116 else
75− parseSuccessRL (Proxy :: _ tailRL) actualStatus jsonText
117+ parseSuccessRL (Proxy :: _ tailRL) actualStatus fetchResp
76118
77119class ParseErrorRL (rl :: RowList Type) (errorRow :: Row Type) | rl -> errorRow where
78120 parseErrorRL
@@ -87,6 +129,22 @@ instance ParseErrorRL RL.Nil errorRow where
87129 parseErrorRL _ _ status _ =
88130 throwError (Variant.inj (Proxy :: _ "exception") (Exception.error ("Unexpected error status code: " <> show status)))
89131
132+else instance
133+ ( IsSymbol label
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
139+ ) =>
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))
145+ else
146+ parseErrorRL (Proxy :: _ tailRL) errorProxy actualStatus text
147+
90148else instance
91149 ( IsSymbol label
92150 , StatusCodeMap label