@@ -0,0 +1,82 @@
1+{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE LambdaCase #-}
5+{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE RecursiveDo #-}
7+{-# LANGUAGE TemplateHaskell #-}
8+{-# LANGUAGE TypeApplications #-}
9+module Frontend where
10+
11+import Data.Text (Text)
12+import Obelisk.Frontend
13+import Obelisk.Route
14+import Reflex.Dom.Core
15+import Control.Monad.Fix (MonadFix)
16+import Language.Javascript.JSaddle (MonadJSM)
17+
18+import Common.Api
19+import Common.Route
20+import Obelisk.Generated.Static
21+
22+type AppWidget js t m =
23+ ( DomBuilder t m
24+ , MonadFix m
25+ , MonadHold t m
26+ , TriggerEvent t m
27+ , PostBuild t m
28+ , PerformEvent t m
29+ , Prerender js t m
30+ )
31+
32+type FrontendWidget js t m =
33+ ( AppWidget js t m
34+ , MonadJSM m
35+ , MonadJSM (Performable m)
36+ , HasJSContext (Performable m)
37+ )
38+
39+data State = NotStarted | Loading | Loaded (Maybe Text)
40+
41+urlInput :: AppWidget js t m => m (Dynamic t State)
42+urlInput = do
43+ inputEl <- el "label" $ do
44+ text "url: "
45+ inputElement def
46+ click <- button "shorten"
47+ let url = tagPromptlyDyn (_inputElement_value inputEl) click
48+ request <- prerender
49+ (pure never)
50+ ((decodeXhrResponse <$>) <$> (performRequestAsync $ shortenRequest <$> url))
51+ let requestEv = switchDyn request
52+ holdDyn NotStarted $
53+ leftmost [Loading <$ click, Loaded <$> requestEv]
54+
55+createShortLinkRoute :: Text
56+createShortLinkRoute = renderBackendRoute checkedFullRouteEncoder $ BackendRoute_Shorten :/ ()
57+
58+shortenRequest :: Text -> XhrRequest Text
59+shortenRequest s = postJson createShortLinkRoute (ShortenRequest s)
60+
61+createdLink :: AppWidget js t m => State -> m ()
62+createdLink = \case
63+ NotStarted -> blank
64+ Loading -> text "loading"
65+ Loaded a -> case a of
66+ Nothing -> text "Error"
67+ Just url -> text url
68+
69+app :: AppWidget js t m => m ()
70+app = do
71+ state <- urlInput
72+ _ <- dyn $ createdLink <$> state
73+ blank
74+
75+frontend :: Frontend (R FrontendRoute)
76+frontend = Frontend
77+ { _frontend_head = do
78+ el "title" $ text "Url Shortener"
79+ elAttr "link" ("rel" =: "stylesheet" <> "href" =: static @"style.css") blank
80+ , _frontend_body = do
81+ app
82+ }