git.iko.soy/obelisk
on master help sign in
some styles
0ec4971Owen Shepherd
examples/url-shortener/backend/src/Backend.hs+8−6
compare with master
unifiedsplit
@@ -5,20 +5,21 @@
5{-# LANGUAGE TypeFamilies #-}
5{-# LANGUAGE TypeFamilies #-}
6module Backend where
6module Backend where
7
7
8+import Common.Route
9+import Control.Concurrent
8import Control.Monad.IO.Class
10import Control.Monad.IO.Class
9−import Data.Word
11+import qualified Data.Aeson as A
10import Data.ByteString.Lazy
12import Data.ByteString.Lazy
11−import Database.PostgreSQL.Simple
12−import Database.Id.Class
13import Data.Text (Text)
13import Data.Text (Text)
14−import qualified Data.Aeson as A
14+import Data.Word
15+import Database.Id.Class
15import Data.Pool
16import Data.Pool
17+import Database.PostgreSQL.Simple
18+import Gargoyle.PostgreSQL.Connect
16import Prelude hiding (id)
19import Prelude hiding (id)
17−import Common.Route
18import Obelisk.Backend
20import Obelisk.Backend
19import Obelisk.Route
21import Obelisk.Route
20import Snap.Core
22import Snap.Core
21−import Gargoyle.PostgreSQL.Connect
22
23
23maxUrlSize :: Word64
24maxUrlSize :: Word64
24maxUrlSize = 2000
25maxUrlSize = 2000
@@ -50,6 +51,7 @@ backend = Backend
50 [[id]] <- liftIO $ withResource pool $ \dbcon -> do
51 [[id]] <- liftIO $ withResource pool $ \dbcon -> do
51 _ <- execute dbcon "INSERT INTO urls (url) values (?);" [url :: Text]
52 _ <- execute dbcon "INSERT INTO urls (url) values (?);" [url :: Text]
52 query_ dbcon "SELECT last_value FROM urls_id_seq;"
53 query_ dbcon "SELECT last_value FROM urls_id_seq;"
54+ liftIO $ threadDelay 1000000
53 modifyResponse $ setResponseStatus 200 "OK"
55 modifyResponse $ setResponseStatus 200 "OK"
54 writeBS $ toStrict $ A.encode $ ("/s/" <>) $ show (id :: Int)
56 writeBS $ toStrict $ A.encode $ ("/s/" <>) $ show (id :: Int)
55 r <- getResponse
57 r <- getResponse
examples/url-shortener/frontend/src/Frontend.hs+25−14
@@ -1,11 +1,13 @@
1{-# LANGUAGE ConstraintKinds #-}
1{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE LambdaCase #-}
4{-# LANGUAGE LambdaCase #-}
5{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE RecursiveDo #-}
6{-# LANGUAGE TypeApplications #-}
7{-# LANGUAGE TypeApplications #-}
7module Frontend where
8module Frontend where
8
9
10+import qualified Data.Map as M
9import Data.Text (Text)
11import Data.Text (Text)
10import Obelisk.Frontend
12import Obelisk.Frontend
11import Obelisk.Route
13import Obelisk.Route
@@ -35,20 +37,28 @@ type FrontendWidget js t m =
35 )
37 )
36
38
37data State = NotStarted | Loading | Loaded (Maybe Text)
39data 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
38
46
39urlInput :: AppWidget js t m => m (Dynamic t State)
47urlInput :: AppWidget js t m => m (Dynamic t State)
40urlInput = do
48urlInput = do
41− inputEl <- el "label" $ do
49+ rec
42− text "url: "
43− inputElement def
50+ inputEl <- inputElement $ def
51+ (submitBtn,_) <- elAttr "span" ("id" =: "submit") $
44− click <- button "shorten"
52+ elDynAttr' "button" (submitAttrs <$> state) $ text "shorten"
53+ let click = domEvent Click submitBtn
45− let url = tagPromptlyDyn (_inputElement_value inputEl) click
54+ let url = tagPromptlyDyn (_inputElement_value inputEl) click
46− request <- prerender
55+ request <- prerender
47− (pure never)
56+ (pure never)
48− ((decodeXhrResponse <$>) <$> performRequestAsync (shortenRequest <$> url))
57+ ((decodeXhrResponse <$>) <$> performRequestAsync (shortenRequest <$> url))
49− let requestEv = switchDyn request
50− holdDyn NotStarted $
58+ state <- holdDyn NotStarted $
51− leftmost [Loading <$ click, Loaded <$> requestEv]
59+ leftmost [Loading <$ click, Loaded <$> switchDyn request]
60+ _ <- pure state
61+ pure state
52
62
53createShortLinkRoute :: Text
63createShortLinkRoute :: Text
54createShortLinkRoute = renderBackendRoute checkedFullRouteEncoder $ BackendRoute_Shorten :/ ()
64createShortLinkRoute = renderBackendRoute checkedFullRouteEncoder $ BackendRoute_Shorten :/ ()
@@ -59,14 +69,14 @@ shortenRequest s = postJson createShortLinkRoute (ShortenRequest s)
59createdLink :: AppWidget js t m => State -> m ()
69createdLink :: AppWidget js t m => State -> m ()
60createdLink = \case
70createdLink = \case
61 NotStarted -> blank
71 NotStarted -> blank
62− Loading -> text "loading"
72+ Loading -> text "shortening..."
63 Loaded a -> case a of
73 Loaded a -> case a of
64 Nothing -> text "Error"
74 Nothing -> text "Error"
65 Just url -> elAttr "a" ("href" =: url) $ text url
75 Just url -> elAttr "a" ("href" =: url) $ text url
66
76
67app :: AppWidget js t m => m ()
77app :: AppWidget js t m => m ()
68app = do
78app = do
69− state <- urlInput
79+ state <- el "div" $ urlInput
70 _ <- dyn $ createdLink <$> state
80 _ <- dyn $ createdLink <$> state
71 blank
81 blank
72
82
@@ -75,5 +85,6 @@ frontend = Frontend
75 { _frontend_head = do
85 { _frontend_head = do
76 el "title" $ text "Url Shortener"
86 el "title" $ text "Url Shortener"
77 elAttr "link" ("rel" =: "stylesheet" <> "href" =: static @"style.css") blank
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
78 , _frontend_body = app
89 , _frontend_body = app
79 }
90 }
examples/url-shortener/static/style.css+12
@@ -1,3 +1,15 @@
1html {
1html {
2 background-color: #eee;
2 background-color: #eee;
3}
3}
4+
5+body {
6+ display: flex;
7+ flex-direction: column;
8+ height: 100vh;
9+ align-items: center;
10+ justify-content: center;
11+}
12+
13+#submit {
14+ margin-left: 8px;
15+}