@@ -0,0 +1,90 @@
1+{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE LambdaCase #-}
5+{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE RecursiveDo #-}
7+{-# LANGUAGE TypeApplications #-}
8+module Frontend where
9+
10+import qualified Data.Map as M
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+ deriving (Eq)
41+
42+submitAttrs :: State -> M.Map Text Text
43+submitAttrs = \case
44+ Loading -> ("disabled" =: "true")
45+ _ -> mempty
46+
47+urlInput :: AppWidget js t m => m (Dynamic t State)
48+urlInput = do
49+ rec
50+ inputEl <- inputElement $ def
51+ (submitBtn,_) <- elAttr "span" ("id" =: "submit") $
52+ elDynAttr' "button" (submitAttrs <$> state) $ text "shorten"
53+ let click = domEvent Click submitBtn
54+ let url = tagPromptlyDyn (_inputElement_value inputEl) click
55+ request <- prerender
56+ (pure never)
57+ ((decodeXhrResponse <$>) <$> performRequestAsync (shortenRequest <$> url))
58+ state <- holdDyn NotStarted $
59+ leftmost [Loading <$ click, Loaded <$> switchDyn request]
60+ _ <- pure state
61+ pure state
62+
63+createShortLinkRoute :: Text
64+createShortLinkRoute = renderBackendRoute checkedFullRouteEncoder $ BackendRoute_Shorten :/ ()
65+
66+shortenRequest :: Text -> XhrRequest Text
67+shortenRequest s = postJson createShortLinkRoute (ShortenRequest s)
68+
69+createdLink :: AppWidget js t m => State -> m ()
70+createdLink = \case
71+ NotStarted -> blank
72+ Loading -> text "shortening..."
73+ Loaded a -> case a of
74+ Nothing -> text "Error"
75+ Just url -> elAttr "a" ("href" =: url) $ text url
76+
77+app :: AppWidget js t m => m ()
78+app = do
79+ state <- el "div" $ urlInput
80+ _ <- dyn $ createdLink <$> state
81+ blank
82+
83+frontend :: Frontend (R FrontendRoute)
84+frontend = Frontend
85+ { _frontend_head = do
86+ el "title" $ text "Url Shortener"
87+ elAttr "link" ("rel" =: "stylesheet" <> "href" =: static @"style.css") blank
88+ elAttr "link" ("rel" =: "stylesheet" <> "href" =: "https://cdnjs.cloudflare.com/ajax/libs/normalize/8.0.1/normalize.css") blank
89+ , _frontend_body = app
90+ }