Skip to content

Commit 11caf5b

Browse files
amesgenamesgen
committed
Remove Servant functionality from Miso.Fetch 
1 parent ddd3065 commit 11caf5b

File tree

1 file changed

+5
-169
lines changed

1 file changed

+5
-169
lines changed

‎src/Miso/Fetch.hs

Lines changed: 5 additions & 169 deletions
Original file line numberDiff line numberDiff line change
@@ -20,178 +20,14 @@
2020
-- Portability : non-portable
2121
--
2222
-- Module for interacting with the Fetch API <https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API>
23-
-- with a servant-style interface.
23+
-- manually.
2424
--
25-
-- > import Miso (fetch)
26-
-- > import Data.Proxy
27-
-- > import Servant.API
28-
-- >
29-
-- > data Action
30-
-- > = FetchGitHub
31-
-- > | SetGitHub GitHub
32-
-- > | ErrorHandler MisoString
33-
-- > deriving (Show, Eq)
34-
-- >
35-
-- > type GithubAPI = Get '[JSON] GitHub
36-
-- >
37-
-- > getGithubAPI
38-
-- > :: (GitHub -> JSM ())
39-
-- > -- ^ Successful callback
40-
-- > -> (MisoString -> JSM ())
41-
-- > -- ^ Errorful callback
42-
-- > -> JSM ()
43-
-- > getGithubAPI = fetch (Proxy @GithubAPI) "https://api.github.com"
44-
-- >
45-
-- > updateModel :: Action -> Effect Model Action ()
46-
-- > updateModel FetchGitHub =
47-
-- > withSink $ \snk ->
48-
-- > getGithubAPI (snk . SetGitHub) (snk . ErrorHandler)
49-
-- > updateModel (SetGitHub apiInfo) =
50-
-- > info ?= apiInfo
51-
-- > updateModel (ErrorHandler msg) =
52-
-- > io (consoleError msg)
25+
-- Refer to the miso README if you want to automatically interact with a Servant
26+
-- API.
5327
--
5428
----------------------------------------------------------------------------
5529
module Miso.Fetch
56-
( -- * Class
57-
Fetch (..)
58-
-- ** Simple non-Servant API
59-
, fetchJSON
30+
( fetchJSON
6031
) where
61-
-----------------------------------------------------------------------------
62-
import Data.Aeson
63-
import Data.Kind (Type)
64-
import Data.Proxy (Proxy(..))
65-
import GHC.TypeLits
66-
import Language.Javascript.JSaddle (JSM)
67-
import Servant.API
68-
import Servant.API.Modifiers
69-
-----------------------------------------------------------------------------
70-
import Miso.FFI.Internal (fetchJSON)
71-
import Miso.Lens
72-
import Miso.String (MisoString, ms)
73-
import qualified Miso.String as MS
74-
-----------------------------------------------------------------------------
75-
-- | Internal type used to accumulate options during the type-level traversal
76-
data FetchOptions
77-
= FetchOptions
78-
{ _baseUrl :: MisoString
79-
, _currentPath :: MisoString
80-
, _body :: Maybe MisoString
81-
, _headers :: [(MisoString, MisoString)]
82-
, _queryParams :: [(MisoString,MisoString)]
83-
, _queryFlags :: [MisoString]
84-
}
85-
-----------------------------------------------------------------------------
86-
baseUrl :: Lens FetchOptions MisoString
87-
baseUrl = lens _baseUrl $ \record field -> record { _baseUrl = field }
88-
-----------------------------------------------------------------------------
89-
currentPath :: Lens FetchOptions MisoString
90-
currentPath = lens _currentPath $ \record field -> record { _currentPath = field }
91-
-----------------------------------------------------------------------------
92-
body :: Lens FetchOptions (Maybe MisoString)
93-
body = lens _body $ \record field -> record { _body = field }
94-
-----------------------------------------------------------------------------
95-
headers :: Lens FetchOptions [(MisoString,MisoString)]
96-
headers = lens _headers $ \record field -> record { _headers = field }
97-
-----------------------------------------------------------------------------
98-
queryParams :: Lens FetchOptions [(MisoString,MisoString)]
99-
queryParams = lens _queryParams $ \record field -> record { _queryParams = field }
100-
-----------------------------------------------------------------------------
101-
queryFlags :: Lens FetchOptions [MisoString]
102-
queryFlags = lens _queryFlags $ \record field -> record { _queryFlags = field }
103-
-----------------------------------------------------------------------------
104-
defaultFetchOptions :: FetchOptions
105-
defaultFetchOptions
106-
= FetchOptions
107-
{ _headers = []
108-
, _baseUrl = mempty
109-
, _currentPath = mempty
110-
, _queryParams = []
111-
, _queryFlags = []
112-
, _body = Nothing
113-
}
114-
-----------------------------------------------------------------------------
115-
class Fetch (api :: Type) where
116-
type ToFetch api :: Type
117-
fetch :: Proxy api -> MisoString -> ToFetch api
118-
fetch proxy url = fetchWith proxy (defaultFetchOptions & baseUrl .~ url)
119-
fetchWith :: Proxy api -> FetchOptions -> ToFetch api
120-
-----------------------------------------------------------------------------
121-
instance (Fetch left , Fetch right) => Fetch (left :<|> right) where
122-
type ToFetch (left :<|> right) = ToFetch left :<|> ToFetch right
123-
fetchWith Proxy o = fetchWith (Proxy @left) o :<|> fetchWith (Proxy @right) o
124-
-----------------------------------------------------------------------------
125-
instance (Fetch api, KnownSymbol path) => Fetch (path :> api) where
126-
type ToFetch (path :> api) = ToFetch api
127-
fetchWith Proxy options = fetchWith (Proxy @api) options_
128-
where
129-
path :: MisoString
130-
path = ms $ symbolVal (Proxy @path)
13132

132-
options_ :: FetchOptions
133-
options_ = options & currentPath %~ (<> ms "/" <> path)
134-
-----------------------------------------------------------------------------
135-
instance (ToHttpApiData a, Fetch api, KnownSymbol path) => Fetch (Capture path a :> api) where
136-
type ToFetch (Capture path a :> api) = a -> ToFetch api
137-
fetchWith Proxy options arg = fetchWith (Proxy @api) options_
138-
where
139-
options_ :: FetchOptions
140-
options_ = options & currentPath %~ (<> ms "/" <> ms (toEncodedUrlPiece arg))
141-
-----------------------------------------------------------------------------
142-
instance (ToHttpApiData a, Fetch api, SBoolI (FoldRequired mods), KnownSymbol name) => Fetch (QueryParam' mods name a :> api) where
143-
type ToFetch (QueryParam' mods name a :> api) = RequiredArgument mods a -> ToFetch api
144-
fetchWith Proxy options arg = fetchWith (Proxy @api) options_
145-
where
146-
param (x :: a) = [(ms $ symbolVal (Proxy @name), ms (enc x))]
147-
#if MIN_VERSION_http_api_data(0,5,1)
148-
enc = toEncodedQueryParam
149-
#else
150-
enc = toEncodedUrlPiece
151-
#endif
152-
options_ :: FetchOptions
153-
options_ = options & queryParams <>~ foldRequiredArgument (Proxy @mods) param (foldMap param) arg
154-
-----------------------------------------------------------------------------
155-
instance (Fetch api, KnownSymbol name) => Fetch (QueryFlag name :> api) where
156-
type ToFetch (QueryFlag name :> api) = Bool -> ToFetch api
157-
fetchWith Proxy options flag = fetchWith (Proxy @api) options_
158-
where
159-
options_ :: FetchOptions
160-
options_ = options & queryFlags <>~ [ ms $ symbolVal (Proxy @name) | flag ]
161-
-----------------------------------------------------------------------------
162-
instance (ToJSON a, Fetch api) => Fetch (ReqBody '[JSON] a :> api) where
163-
type ToFetch (ReqBody '[JSON] a :> api) = a -> ToFetch api
164-
fetchWith Proxy options body_ = fetchWith (Proxy @api) (options_ (ms (encode body_)))
165-
where
166-
options_ :: MisoString -> FetchOptions
167-
options_ b = options & body ?~ b
168-
-----------------------------------------------------------------------------
169-
instance (KnownSymbol name, ToHttpApiData a, Fetch api) => Fetch (Header name a :> api) where
170-
type ToFetch (Header name a :> api) = a -> ToFetch api
171-
fetchWith Proxy options value = fetchWith (Proxy @api) o
172-
where
173-
headerName :: MisoString
174-
headerName = ms $ symbolVal (Proxy @name)
175-
176-
o :: FetchOptions
177-
o = options & headers <>~ [ (headerName, ms (toHeader value)) ]
178-
-----------------------------------------------------------------------------
179-
instance (ReflectMethod method, FromJSON a) => Fetch (Verb method code content a) where
180-
type ToFetch (Verb method code content a) = (a -> JSM()) -> (MisoString -> JSM ()) -> JSM ()
181-
fetchWith Proxy options success_ error_ =
182-
fetchJSON url method (options ^. body) (options ^. headers) success_ error_
183-
where
184-
method = ms (reflectMethod (Proxy @method))
185-
params = MS.concat
186-
[ mconcat
187-
[ ms "?"
188-
, MS.intercalate (ms "&")
189-
[ k <> ms "=" <> v
190-
| (k,v) <- options ^. queryParams
191-
]
192-
]
193-
| not $ null (options ^. queryParams)
194-
]
195-
flags = MS.mconcat [ ms "?" <> k | k <- options ^. queryFlags ]
196-
url = options ^. baseUrl <> options ^. currentPath <> params <> flags
197-
-----------------------------------------------------------------------------
33+
import Miso.FFI.Internal (fetchJSON)

0 commit comments

Comments
 (0)