master...a5a5804 · obelisk

git.iko.soy/obelisk

on a5a5804 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+34

@@ -0,0 +1,34 @@

1+{-# LANGUAGE EmptyCase #-}

2+{-# LANGUAGE FlexibleContexts #-}

3+{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE LambdaCase #-}

5+{-# LANGUAGE RankNTypes #-}

6+{-# LANGUAGE TypeFamilies #-}

7+module Backend where

9+import Prelude hiding (id)

10+import Common.Route

11+import Obelisk.Backend

12+import Obelisk.Route

13+import Snap.Core

14+import Gargoyle.PostgreSQL.Connect

15+

16+backend :: Backend BackendRoute FrontendRoute

17+backend = Backend

18+ { _backend_run = \serve -> do

19+ withDb "db" $ \pool ->

20+ serve $ \case

21+ BackendRoute_Missing :/ () -> do

22+ modifyResponse $ setResponseStatus 400 "Malformed Request"

23+ writeBS "400 Malformed Request"

24+ r <- getResponse

25+ finishWith r

26+ BackendRoute_Shorten :/ () -> do

27+ modifyResponse $ setResponseStatus 200 "OK"

28+ writeBS $ "\"OK\""

29+ r <- getResponse

30+ finishWith r

31+ _ -> error "no"

32+ return ()

33+ , _backend_routeEncoder = fullRouteEncoder

34+ }

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

@@ -0,0 +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 #-}

9+module Common.Api where

10+

11+import Data.Aeson

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.hsnew file+61

@@ -0,0 +1,61 @@

1+{-# LANGUAGE EmptyCase #-}

2+{-# LANGUAGE FlexibleContexts #-}

3+{-# LANGUAGE GADTs #-}

4+{-# LANGUAGE LambdaCase #-}

5+{-# LANGUAGE RankNTypes #-}

6+{-# LANGUAGE TemplateHaskell #-}

7+{-# LANGUAGE KindSignatures #-}

8+{-# LANGUAGE EmptyCase #-}

9+{-# LANGUAGE MultiParamTypeClasses #-}

10+{-# LANGUAGE FlexibleInstances #-}

11+{-# LANGUAGE OverloadedStrings #-}

12+

13+module Common.Route where

14+

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

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

17+import Control.Category

18+-}

19+

20+import Data.Text (Text)

21+import qualified Data.Text as T

22+import Data.Function

23+import Data.Functor.Identity

24+import Database.Id.Class (Id)

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

26+

27+import Obelisk.Route

28+import Obelisk.Route.TH

29+

30+import Common.Schema

31+

32+data BackendRoute :: * -> * where

33+ BackendRoute_Missing :: BackendRoute ()

34+ BackendRoute_Url_Id :: BackendRoute (Id Url)

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

36+ BackendRoute_Shorten :: BackendRoute ()

37+

38+data FrontendRoute :: * -> * where

39+ FrontendRoute_Main :: FrontendRoute ()

40+

41+checkedFullRouteEncoder

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

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

49+fullRouteEncoder = mkFullRouteEncoder

50+ (FullRoute_Backend BackendRoute_Missing :/ ())

51+ (\case

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

53+ BackendRoute_Url_Id -> PathSegment "s" idPathSegmentEncoder

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

55+ (\case

56+ FrontendRoute_Main -> PathEnd $ unitEncoder mempty)

57+

58+concat <$> mapM deriveRouteComponent

59+ [ ''BackendRoute

60+ , ''FrontendRoute

61+ ]

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+data 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+82

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

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

@@ -0,0 +1,3 @@

1+html {

2+ background-color: #eee;

3+}