Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Support shared data types & (ad-hoc) polymorphic serialization.

  • Loading branch information...
commit e47590e826341af848fd1fc7fbfaeea07eeed50c 1 parent 7468efe
Chris Done chrisdone authored
1  .gitignore
@@ -5,3 +5,4 @@ example/snaplets/fay/js
5 5 *.hi
6 6 *.o
7 7 cabal-dev
  8 +TAGS
2  example/example.cabal
@@ -15,7 +15,7 @@ Flag development
15 15 Default: False
16 16
17 17 Executable example
18   - hs-source-dirs: src
  18 + hs-source-dirs: src snaplets/fay/src
19 19 main-is: Main.hs
20 20
21 21 Build-depends:
10 example/snaplets/fay/src/Application/SharedTypes.hs
... ... @@ -0,0 +1,10 @@
  1 +{-# LANGUAGE NoImplicitPrelude #-}
  2 +
  3 +module Application.SharedTypes where
  4 +
  5 +import Language.Fay.Prelude
  6 +import Language.Fay.FFI
  7 +
  8 +data CTR = CTR { time :: String }
  9 + deriving (Show)
  10 +instance Foreign CTR
15 example/snaplets/fay/src/Index.hs
@@ -7,6 +7,7 @@ module Index where
7 7 import Language.Fay.FFI
8 8 import Language.Fay.Prelude
9 9
  10 +import Application.SharedTypes
10 11 import Dom
11 12
12 13 main :: Fay ()
@@ -25,17 +26,11 @@ onload = do
25 26
26 27 return ()
27 28
28   -data CTR = CTR { time :: String }
29   -instance Foreign CTR
30   -
31 29 currentTime :: Fay ()
32 30 currentTime = do
33   - ajaxJson "/ajax/current-time" handleResponse
34   -
35   -handleResponse :: CTR -> Fay ()
36   -handleResponse (CTR time) = do
37   - el <- byId "current-time"
38   - setInnerHtml el time
  31 + ajaxJson "/ajax/current-time" $ \(CTR time) -> do
  32 + el <- byId "current-time"
  33 + setInnerHtml el time
39 34
40   -ajaxJson :: String -> (CTR -> Fay ()) -> Fay ()
  35 +ajaxJson :: Foreign a => String -> (a -> Fay ()) -> Fay ()
41 36 ajaxJson = ffi "jQuery.ajax(%1, { success : %2 })"
24 example/src/Site.hs
@@ -9,24 +9,26 @@ module Site
9 9 ) where
10 10
11 11 ------------------------------------------------------------------------------
12   -import Control.Monad.Trans
13   -import Data.Aeson
14   -import Data.ByteString (ByteString)
15   -import Data.Time.Clock
16   -import Snap.Core
17   -import Snap.Snaplet
18   -import Snap.Snaplet.Heist
19   -import Snap.Snaplet.Fay
20   -import Snap.Util.FileServe
  12 +import Control.Monad.Trans
  13 +import Data.Aeson
  14 +import Data.ByteString (ByteString)
  15 +import Data.Time.Clock
  16 +import Language.Fay.Show
  17 +import Snap.Core
  18 +import Snap.Snaplet
  19 +import Snap.Snaplet.Fay
  20 +import Snap.Snaplet.Heist
  21 +import Snap.Util.FileServe
21 22 ------------------------------------------------------------------------------
22   -import Application
  23 +import Application
  24 +import Application.SharedTypes
23 25
24 26
25 27 currentTimeAjax :: AppHandler ()
26 28 currentTimeAjax = do
27 29 time <- liftIO getCurrentTime
28 30 modifyResponse . setContentType $ "text/json;charset=utf-8"
29   - writeLBS $ encode . toJSON $ object ["instance" .= ("CTR" :: ByteString), "time" .= show time]
  31 + writeLBS $ encode $ showToFay (CTR (show time))
30 32
31 33
32 34 ------------------------------------------------------------------------------
2  snaplet-fay.cabal
@@ -46,7 +46,7 @@ library
46 46 configurator == 0.2.*,
47 47 data-default == 0.5.*,
48 48 directory == 1.1.*,
49   - fay == 0.6.*,
  49 + fay == 0.6.1.*,
50 50 filepath == 1.3.*,
51 51 mtl == 2.1.*,
52 52 snap == 0.9.*,

0 comments on commit e47590e

Please sign in to comment.
Something went wrong with that request. Please try again.