master...0ec4971 · obelisk

git.iko.soy/obelisk

on 0ec4971 help sign in

examples/url-shortener/.gitignorenew file+8

since splitsnapshots

unifiedsplit

@@ -0,0 +1,8 @@

1+db

2+dist-newstyle

3+result

4+result-android

5+result-ios

6+result-exe

7+.attr-cache

8+ghcid-output.txt

examples/url-shortener/.obelisk/impl/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/.obelisk/impl/github.jsonnew file+7

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

1+{

2+ "owner": "obsidiansystems",

3+ "repo": "obelisk",

4+ "branch": "develop",

5+ "rev": "acc5e6db09462d76c7e7eaff3aa3634a7ce0c371",

6+ "sha256": "1q14gmn9152sc7v2pc1wblhyhy2hj5rn7nvrwj5hx8xkmxj68r20"

7+}

examples/url-shortener/backend/backend.cabalnew file+30

@@ -0,0 +1,30 @@

1+name: backend

2+version: 0.1

3+cabal-version: >= 1.8

4+build-type: Simple

6+library

7+ hs-source-dirs: src

8+ if impl(ghcjs)

9+ buildable: False

10+ build-depends: base

11+ , common

12+ , frontend

13+ , obelisk-backend

14+ , obelisk-route

15+ , gargoyle-postgresql-connect

16+ , resource-pool

17+ exposed-modules:

18+ Backend

19+ ghc-options: -Wall

20+

21+executable backend

22+ main-is: main.hs

23+ hs-source-dirs: src-bin

24+ if impl(ghcjs)

25+ buildable: False

26+ build-depends: base

27+ , backend

28+ , common

29+ , frontend

30+ , obelisk-backend

examples/url-shortener/backend/frontend.jsexenew file+1

@@ -0,0 +1 @@

1+../frontend-js/bin/frontend.jsexe

examples/url-shortener/backend/frontendJs/frontend.jsexenew file+1

@@ -0,0 +1 @@

1+../../frontend-js/bin/frontend.jsexe

examples/url-shortener/backend/src-bin/main.hsnew file+6

@@ -0,0 +1,6 @@

1+import Backend

2+import Frontend

3+import Obelisk.Backend

5+main :: IO ()

6+main = runBackend backend frontend

examples/url-shortener/backend/src/Backend.hsnew file+67

@@ -0,0 +1,67 @@

1+{-# LANGUAGE FlexibleContexts #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE LambdaCase #-}

4+{-# LANGUAGE RankNTypes #-}

5+{-# LANGUAGE TypeFamilies #-}

6+module Backend where

8+import Common.Route

9+import Control.Concurrent

10+import Control.Monad.IO.Class

11+import qualified Data.Aeson as A

12+import Data.ByteString.Lazy

13+import Data.Text (Text)

14+import Data.Word

15+import Database.Id.Class

16+import Data.Pool

17+import Database.PostgreSQL.Simple

18+import Gargoyle.PostgreSQL.Connect

19+import Prelude hiding (id)

20+import Obelisk.Backend

21+import Obelisk.Route

22+import Snap.Core

23+

24+maxUrlSize :: Word64

25+maxUrlSize = 2000

26+

27+migration :: Query

28+migration = "CREATE TABLE IF NOT EXISTS urls\

29+ \ (id SERIAL PRIMARY KEY, url VARCHAR(?) NOT NULL);"

30+

31+backend :: Backend BackendRoute FrontendRoute

32+backend = Backend

33+ { _backend_run = \serve -> do

34+ withDb "db" $ \pool -> do

35+ _ <- withResource pool $ \dbcon -> execute dbcon migration [maxUrlSize]

36+ serve $ \case

37+

38+ BackendRoute_Get_Url :/ id -> do

39+ result <- liftIO $ withResource pool $ \dbcon ->

40+ query dbcon "SELECT (url) FROM urls WHERE id = ?;" [unId id]

41+ case result of

42+ [[url]] -> redirect url

43+ _ -> do

44+ modifyResponse $ setResponseStatus 404 "Not Found"

45+ writeText "That shortlink wasn't found ¯\\_(ツ)_/¯"

46+ r <- getResponse

47+ finishWith r

48+

49+ BackendRoute_Shorten :/ () -> do

50+ Just url <- A.decode <$> readRequestBody maxUrlSize

51+ [[id]] <- liftIO $ withResource pool $ \dbcon -> do

52+ _ <- execute dbcon "INSERT INTO urls (url) values (?);" [url :: Text]

53+ query_ dbcon "SELECT last_value FROM urls_id_seq;"

54+ liftIO $ threadDelay 1000000

55+ modifyResponse $ setResponseStatus 200 "OK"

56+ writeBS $ toStrict $ A.encode $ ("/s/" <>) $ show (id :: Int)

57+ r <- getResponse

58+ finishWith r

59+

60+ _ -> do

61+ modifyResponse $ setResponseStatus 400 "Malformed Request"

62+ writeBS "400 Malformed Request"

63+ r <- getResponse

64+ finishWith r

65+ return ()

66+ , _backend_routeEncoder = fullRouteEncoder

67+ }

examples/url-shortener/backend/staticnew file+1

@@ -0,0 +1 @@

1+../static

examples/url-shortener/cabal.projectnew file+2

@@ -0,0 +1,2 @@

1+optional-packages:

2+ *

examples/url-shortener/common/common.cabalnew file+19

@@ -0,0 +1,19 @@

1+name: common

2+version: 0.1

3+cabal-version: >= 1.2

4+build-type: Simple

6+library

7+ hs-source-dirs: src

8+ build-depends: base

9+ , aeson-gadt-th

10+ , database-id-obelisk

11+ , obelisk-route

12+ , mtl

13+ , text

14+ default-extensions:

15+ TypeFamilies

16+ PolyKinds

17+ exposed-modules:

18+ Common.Api

19+ Common.Route

examples/url-shortener/common/src/Common/Api.hsnew file+14

@@ -0,0 +1,14 @@

1+{-# LANGUAGE DeriveGeneric #-}

2+{-# language DeriveAnyClass #-}

3+{-# LANGUAGE ConstraintKinds #-}

4+{-# LANGUAGE GADTs #-}

5+{-# LANGUAGE FlexibleContexts #-}

6+{-# LANGUAGE FlexibleInstances #-}

7+{-# LANGUAGE MultiParamTypeClasses #-}

8+module Common.Api where

10+import Data.Aeson

11+import Data.Text (Text)

12+import GHC.Generics (Generic)

13+

14+newtype ShortenRequest = ShortenRequest Text deriving (Generic, ToJSON, FromJSON)

examples/url-shortener/common/src/Common/Route.hsnew file+60

@@ -0,0 +1,60 @@

1+{-# LANGUAGE EmptyCase #-}

2+{-# LANGUAGE FlexibleContexts #-}

3+{-# LANGUAGE GADTs #-}

4+{-# LANGUAGE LambdaCase #-}

5+{-# LANGUAGE RankNTypes #-}

6+{-# LANGUAGE TemplateHaskell #-}

7+{-# LANGUAGE KindSignatures #-}

8+{-# LANGUAGE MultiParamTypeClasses #-}

9+{-# LANGUAGE FlexibleInstances #-}

10+{-# LANGUAGE OverloadedStrings #-}

11+

12+module Common.Route where

13+

14+{- -- You will probably want these imports for composing Encoders.

15+import Prelude hiding (id, (.))

16+import Control.Category

17+-}

18+

19+import Data.Text (Text)

20+import qualified Data.Text as T

21+import Data.Function

22+import Data.Functor.Identity

23+import Database.Id.Class (Id)

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

25+

26+import Obelisk.Route

27+import Obelisk.Route.TH

28+

29+import Common.Schema

30+

31+data BackendRoute :: * -> * where

32+ BackendRoute_Missing :: BackendRoute ()

33+ BackendRoute_Get_Url :: BackendRoute (Id Url)

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

35+ BackendRoute_Shorten :: BackendRoute ()

36+

37+data FrontendRoute :: * -> * where

38+ FrontendRoute_Main :: FrontendRoute ()

39+

40+checkedFullRouteEncoder

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

42+checkedFullRouteEncoder = checkEncoder fullRouteEncoder & \case

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

44+ Right encoder -> encoder

45+

46+fullRouteEncoder

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

48+fullRouteEncoder = mkFullRouteEncoder

49+ (FullRoute_Backend BackendRoute_Missing :/ ())

50+ (\case

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

52+ BackendRoute_Get_Url -> PathSegment "s" idPathSegmentEncoder

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

54+ (\case

55+ FrontendRoute_Main -> PathEnd $ unitEncoder mempty)

56+

57+concat <$> mapM deriveRouteComponent

58+ [ ''BackendRoute

59+ , ''FrontendRoute

60+ ]

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

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

1+{-# LANGUAGE DeriveGeneric #-}

2+module Common.Schema where

4+import Data.Text (Text)

5+import Database.Id.Class

6+import GHC.Generics

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

9+ deriving Generic

10+

11+instance HasId Url

examples/url-shortener/config/common/examplenew file+1

@@ -0,0 +1 @@

1+This string comes from config/common/example

examples/url-shortener/config/common/routenew file+1

@@ -0,0 +1 @@

1+http://localhost:8000

examples/url-shortener/config/readme.mdnew file+9

@@ -0,0 +1,9 @@

1+### Config

3+Obelisk projects should contain a config folder with the following subfolders: common, frontend, and backend.

5+Things that should never be transmitted to the frontend belong in backend/ (e.g., email credentials)

7+Frontend-only configuration belongs in frontend/.

9+Shared configuration files (e.g., the route config) belong in common/

examples/url-shortener/default.nixnew file+28

@@ -0,0 +1,28 @@

1+{ obelisk ? import ./.obelisk/impl {

2+ system = builtins.currentSystem;

3+ iosSdkVersion = "10.2";

4+ # You must accept the Android Software Development Kit License Agreement at

5+ # https://developer.android.com/studio/terms in order to build Android apps.

6+ # Uncomment and set this to `true` to indicate your acceptance:

7+ # config.android_sdk.accept_license = false;

8+ }

9+}:

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

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

12+in with obelisk;

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

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+ };

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

25+ android.displayName = "Obelisk Minimal Example";

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

27+ ios.bundleName = "Obelisk Minimal Example";

28+})

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/frontend.cabalnew file+33

@@ -0,0 +1,33 @@

1+name: frontend

2+version: 0.1

3+cabal-version: >= 1.8

4+build-type: Simple

6+library

7+ hs-source-dirs: src

8+ build-depends: base

9+ , common

10+ , obelisk-frontend

11+ , obelisk-route

12+ , reflex-dom

13+ , obelisk-executable-config-lookup

14+ , obelisk-generated-static

15+ , text

16+ exposed-modules:

17+ Frontend

18+ ghc-options: -Wall

19+

20+executable frontend

21+ main-is: main.hs

22+ hs-source-dirs: src-bin

23+ build-depends: base

24+ , common

25+ , obelisk-frontend

26+ , obelisk-route

27+ , reflex-dom

28+ , obelisk-generated-static

29+ , frontend

30+ --TODO: Make these ghc-options optional

31+ ghc-options: -threaded

32+ if os(darwin)

33+ ghc-options: -dynamic

examples/url-shortener/frontend/src-bin/main.hsnew file+10

@@ -0,0 +1,10 @@

1+import Frontend

2+import Common.Route

3+import Obelisk.Frontend

4+import Obelisk.Route.Frontend

5+import Reflex.Dom

7+main :: IO ()

8+main = do

9+ let validFullEncoder = checkedFullRouteEncoder

10+ run $ runFrontend validFullEncoder frontend

examples/url-shortener/frontend/src/Frontend.hsnew file+90

@@ -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

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+ }

examples/url-shortener/static/style.cssnew file+15

@@ -0,0 +1,15 @@

1+html {

2+ background-color: #eee;

3+}

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+}