a5a5804 · obelisk · git.iko.soy

examples/url-shortener/.gitignore+1

compare with master

unifiedsplit

@@ -1,3 +1,4 @@

1+db

1dist-newstyle

2dist-newstyle

2result

3result

3result-android

4result-android

examples/url-shortener/.obelisk/impl/github.json+3−3

@@ -1,7 +1,7 @@

1{

2 "owner": "obsidiansystems",

3 "repo": "obelisk",

4− "branch": "master",

4+ "branch": "develop",

5− "rev": "a98ad63b88846412f73a43367e496fa58f77c785",

5+ "rev": "acc5e6db09462d76c7e7eaff3aa3634a7ce0c371",

6− "sha256": "0k5d6687s64ml2yg21c8bjnddgk86fcaq0k25cs41ip5x396akdj"

6+ "sha256": "1q14gmn9152sc7v2pc1wblhyhy2hj5rn7nvrwj5hx8xkmxj68r20"

7}

examples/url-shortener/backend/backend.cabal+2

@@ -12,6 +12,8 @@ library

12 , frontend

13 , obelisk-backend

14 , obelisk-route

15+ , gargoyle-postgresql-connect

16+ , resource-pool

15 exposed-modules:

17 exposed-modules:

16 Backend

18 Backend

17 ghc-options: -Wall

19 ghc-options: -Wall

examples/url-shortener/backend/src/Backend.hs+16−7

@@ -6,20 +6,29 @@

6{-# LANGUAGE TypeFamilies #-}

7module Backend where

8

9+import Prelude hiding (id)

9import Common.Route

10import Common.Route

10import Obelisk.Backend

11import Obelisk.Backend

11import Obelisk.Route

12import Obelisk.Route

12import Snap.Core

13import Snap.Core

14+import Gargoyle.PostgreSQL.Connect

13

15

14backend :: Backend BackendRoute FrontendRoute

16backend :: Backend BackendRoute FrontendRoute

15backend = Backend

17backend = Backend

16 { _backend_run = \serve -> do

18 { _backend_run = \serve -> do

19+ withDb "db" $ \pool ->

17− serve $ \case

20+ serve $ \case

18− BackendRoute_Missing :/ () -> do

21+ BackendRoute_Missing :/ () -> do

19− modifyResponse $ setResponseStatus 400 "Malformed Request"

22+ modifyResponse $ setResponseStatus 400 "Malformed Request"

20− writeBS "400 Malformed Request"

23+ writeBS "400 Malformed Request"

21− r <- getResponse

24+ r <- getResponse

25+ finishWith r

26+ BackendRoute_Shorten :/ () -> do

27+ modifyResponse $ setResponseStatus 200 "OK"

28+ writeBS $ "\"OK\""

29+ r <- getResponse

22− finishWith r

30+ finishWith r

31+ _ -> error "no"

23 return ()

32 return ()

24− , _backend_routeEncoder = backendRouteEncoder

33+ , _backend_routeEncoder = fullRouteEncoder

25 }

34 }

examples/url-shortener/common/common.cabal+2

@@ -6,6 +6,8 @@ build-type: Simple

6library

7 hs-source-dirs: src

8 build-depends: base

9+ , aeson-gadt-th

10+ , database-id-obelisk

9 , obelisk-route

11 , obelisk-route

10 , mtl

12 , mtl

11 , text

13 , text

examples/url-shortener/common/src/Common/Api.hs+13−2

@@ -1,4 +1,15 @@

1+{-# LANGUAGE DeriveGeneric #-}

2+{-# language DeriveAnyClass #-}

3+{-# LANGUAGE ConstraintKinds #-}

4+{-# LANGUAGE GADTs #-}

5+{-# LANGUAGE FlexibleContexts #-}

6+{-# LANGUAGE TemplateHaskell #-}

7+{-# LANGUAGE FlexibleInstances #-}

8+{-# LANGUAGE MultiParamTypeClasses #-}

1module Common.Api where

9module Common.Api where

2

10

3−commonStuff :: String

11+import Data.Aeson

4−commonStuff = "Here is a string defined in Common.Api"

12+import Data.Text (Text)

13+import GHC.Generics (Generic)

14+

15+data ShortenRequest = ShortenRequest Text deriving (Generic, ToJSON, FromJSON)

examples/url-shortener/common/src/Common/Route.hs+26−16

@@ -18,32 +18,42 @@ import Control.Category

18-}

19

20import Data.Text (Text)

21+import qualified Data.Text as T

22+import Data.Function

21import Data.Functor.Identity

23import Data.Functor.Identity

22−import Data.Functor.Sum

24+import Database.Id.Class (Id)

25+import Database.Id.Obelisk.Route (idPathSegmentEncoder)

23

26

24import Obelisk.Route

27import Obelisk.Route

25import Obelisk.Route.TH

28import Obelisk.Route.TH

26

29

30+import Common.Schema

31+

27data BackendRoute :: * -> * where

32data BackendRoute :: * -> * where

28− -- | Used to handle unparseable routes.

29 BackendRoute_Missing :: BackendRoute ()

33 BackendRoute_Missing :: BackendRoute ()

30− -- You can define any routes that will be handled specially by the backend here.

34+ BackendRoute_Url_Id :: BackendRoute (Id Url)

31− -- i.e. These do not serve the frontend, but do something different, such as serving static files.

35+ -- TODO validate this or use a URL type

36+ BackendRoute_Shorten :: BackendRoute ()

32

37

33data FrontendRoute :: * -> * where

38data FrontendRoute :: * -> * where

34 FrontendRoute_Main :: FrontendRoute ()

39 FrontendRoute_Main :: FrontendRoute ()

35− -- This type is used to define frontend routes, i.e. ones for which the backend will serve the frontend.

40+

36−

41+checkedFullRouteEncoder

37−backendRouteEncoder

42+ :: Encoder Identity Identity (R (FullRoute BackendRoute FrontendRoute)) PageName

43+checkedFullRouteEncoder = checkEncoder fullRouteEncoder & \case

44+ Left err -> error $ T.unpack err

45+ Right encoder -> encoder

46+

47+fullRouteEncoder

38− :: Encoder (Either Text) Identity (R (Sum BackendRoute (ObeliskRoute FrontendRoute))) PageName

48+ :: Encoder (Either Text) Identity (R (FullRoute BackendRoute FrontendRoute)) PageName

49+fullRouteEncoder = mkFullRouteEncoder

39−backendRouteEncoder = handleEncoder (const (InL BackendRoute_Missing :/ ())) $

50+ (FullRoute_Backend BackendRoute_Missing :/ ())

40− pathComponentEncoder $ \case

51+ (\case

41− InL backendRoute -> case backendRoute of

52+ BackendRoute_Shorten -> PathSegment "create" $ unitEncoder mempty

53+ BackendRoute_Url_Id -> PathSegment "s" idPathSegmentEncoder

42− BackendRoute_Missing -> PathSegment "missing" $ unitEncoder mempty

54+ BackendRoute_Missing -> PathSegment "missing" $ unitEncoder mempty)

43− InR obeliskRoute -> obeliskRouteSegment obeliskRoute $ \case

55+ (\case

44− -- The encoder given to PathEnd determines how to parse query parameters,

45− -- in this example, we have none, so we insist on it.

46− FrontendRoute_Main -> PathEnd $ unitEncoder mempty

56+ FrontendRoute_Main -> PathEnd $ unitEncoder mempty)

47

57

48concat <$> mapM deriveRouteComponent

58concat <$> mapM deriveRouteComponent

49 [ ''BackendRoute

59 [ ''BackendRoute

examples/url-shortener/common/src/Common/Schema.hsnew file+11

@@ -0,0 +1,11 @@

1+{-# LANGUAGE DeriveGeneric #-}

2+module Common.Schema where

3+

4+import Data.Text (Text)

5+import Database.Id.Class

6+import GHC.Generics

7+

8+data Url = Url { unUrl :: Text }

9+ deriving Generic

10+

11+instance HasId Url

examples/url-shortener/default.nix+13−1

@@ -7,8 +7,20 @@

7 # config.android_sdk.accept_license = false;

8 }

9}:

10+let deps = obelisk.nixpkgs.thunkSet ./dep;

11+ haskellLib = obelisk.nixpkgs.haskell.lib;

10−with obelisk;

12+in with obelisk;

11project ./. ({ ... }: {

13project ./. ({ ... }: {

14+ packages = {

15+ database-id-class = deps.database-id + /class;

16+ database-id-groundhog = deps.database-id + /groundhog;

17+ database-id-obelisk = deps.database-id + /obelisk;

18+ };

19+ overrides = self: super: import dep/gargoyle self // {

20+ aeson-gadt-th = (self.callCabal2nix "aeson-gadt-th" deps.aeson-gadt-th {}).overrideAttrs (drv: {

21+ configureFlags = drv.configureFlags or [] ++ ["-f-build-readme"]; # Upstream issue: readme doesn't build on ios.

22+ });

23+ };

12 android.applicationId = "systems.obsidian.obelisk.examples.minimal";

24 android.applicationId = "systems.obsidian.obelisk.examples.minimal";

13 android.displayName = "Obelisk Minimal Example";

25 android.displayName = "Obelisk Minimal Example";

14 ios.bundleIdentifier = "systems.obsidian.obelisk.examples.minimal";

26 ios.bundleIdentifier = "systems.obsidian.obelisk.examples.minimal";

examples/url-shortener/dep/aeson-gadt-th/default.nixnew file+7

@@ -0,0 +1,7 @@

1+# DO NOT HAND-EDIT THIS FILE

2+import ((import <nixpkgs> {}).fetchFromGitHub (

3+ let json = builtins.fromJSON (builtins.readFile ./github.json);

4+ in { inherit (json) owner repo rev sha256;

5+ private = json.private or false;

6+ }

7+))

examples/url-shortener/dep/aeson-gadt-th/github.jsonnew file+7

@@ -0,0 +1,7 @@

1+{

2+ "owner": "obsidiansystems",

3+ "repo": "aeson-gadt-th",

4+ "branch": "develop",

5+ "rev": "65df0b070dd21e4c2285fc485e5b9857dbc8ad5b",

6+ "sha256": "1h6wkag38r9xmf3yd0f64h0mfzb7cfj8cf7n2r5mqdyiqz3a5x4w"

7+}

examples/url-shortener/dep/database-id/default.nixnew file+7

@@ -0,0 +1,7 @@

1+# DO NOT HAND-EDIT THIS FILE

2+import ((import <nixpkgs> {}).fetchFromGitHub (

3+ let json = builtins.fromJSON (builtins.readFile ./github.json);

4+ in { inherit (json) owner repo rev sha256;

5+ private = json.private or false;

6+ }

7+))

examples/url-shortener/dep/database-id/github.jsonnew file+7

@@ -0,0 +1,7 @@

1+{

2+ "owner": "obsidiansystems",

3+ "repo": "database-id",

4+ "branch": "develop",

5+ "rev": "216c23e6e19bfe3330ecba553b551f357bffe119",

6+ "sha256": "17k8dc8j4bddfmlh60d9w6015vb2bi6w0a9sr8kr36hidzrgdy5q"

7+}

examples/url-shortener/dep/gargoyle/default.nixnew file+7

@@ -0,0 +1,7 @@

1+# DO NOT HAND-EDIT THIS FILE

2+import ((import <nixpkgs> {}).fetchFromGitHub (

3+ let json = builtins.fromJSON (builtins.readFile ./github.json);

4+ in { inherit (json) owner repo rev sha256;

5+ private = json.private or false;

6+ }

7+))

examples/url-shortener/dep/gargoyle/github.jsonnew file+7

@@ -0,0 +1,7 @@

1+{

2+ "owner": "obsidiansystems",

3+ "repo": "gargoyle",

4+ "branch": "develop",

5+ "rev": "85d1802d0d511a55703b04e25e27f76fb1744001",

6+ "sha256": "1s06x2a4n0c7rr0r0ldq6nwp9m6mls38kczx5z957cyk9wvciva4"

7+}

examples/url-shortener/frontend/src-bin/main.hs+1−1

@@ -6,5 +6,5 @@ import Reflex.Dom

6

7main :: IO ()

8main = do

9− let Right validFullEncoder = checkEncoder backendRouteEncoder

9+ let validFullEncoder = checkedFullRouteEncoder

10 run $ runFrontend validFullEncoder frontend

examples/url-shortener/frontend/src/Frontend.hs+61−8

@@ -1,29 +1,82 @@

1+{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE FlexibleContexts #-}

1{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DataKinds #-}

4+{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE OverloadedStrings #-}

5{-# LANGUAGE OverloadedStrings #-}

6+{-# LANGUAGE RecursiveDo #-}

3{-# LANGUAGE TemplateHaskell #-}

7{-# LANGUAGE TemplateHaskell #-}

4{-# LANGUAGE TypeApplications #-}

8{-# LANGUAGE TypeApplications #-}

5module Frontend where

9module Frontend where

6

10

7−import qualified Data.Text as T

11+import Data.Text (Text)

8−import qualified Data.Text.Encoding as T

9import Obelisk.Frontend

12import Obelisk.Frontend

10−import Obelisk.Configs

11import Obelisk.Route

13import Obelisk.Route

12import Reflex.Dom.Core

14import Reflex.Dom.Core

15+import Control.Monad.Fix (MonadFix)

16+import Language.Javascript.JSaddle (MonadJSM)

13

17

14import Common.Api

18import Common.Api

15import Common.Route

19import Common.Route

16import Obelisk.Generated.Static

20import Obelisk.Generated.Static

17

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+

18frontend :: Frontend (R FrontendRoute)

75frontend :: Frontend (R FrontendRoute)

19frontend = Frontend

76frontend = Frontend

20 { _frontend_head = do

77 { _frontend_head = do

21 el "title" $ text "Url Shortener"

78 el "title" $ text "Url Shortener"

22 elAttr "link" ("rel" =: "stylesheet" <> "href" =: static @"style.css") blank

79 elAttr "link" ("rel" =: "stylesheet" <> "href" =: static @"style.css") blank

23 , _frontend_body = do

80 , _frontend_body = do

24− url <- el "label" $ do

81+ app

25− text "url: "

26− inputElement def

27− shorten <- button "shorten"

28− return ()

29 }

82 }