Skip to content
Browse files

Updated example with an AJAX call (will be prettier once Fay encodes …

…records automatically)
  • Loading branch information...
1 parent 1da2450 commit 5d4c9854d5e0b1ba0021e33f39d0286ed8edc07e @bergmark bergmark committed
View
17 README.md
@@ -11,6 +11,16 @@ sources preventing web server restarts and here we add Fay to this
list as well. This lets us write both front and back-end code in Haskell.
+Features
+--------
+
+* Compile and serve fay files automatically, no need to restart the
+ snap server.
+* Uses Fay's pretty print option (js-beautify) to create JS files that
+ are easier to debug.
+* Writes JS to disk to allow reading the generated source.
+
+
Installation
------------
@@ -29,6 +39,7 @@ Clone this repository and install the package:
cabal install
````
+
Example Usage
-------------
@@ -62,6 +73,7 @@ devel.cfg will not be created if you have already created the fay
directory, if this happens to you move snaplets/fay, start your
application, and then move the files back into snaplets/fay.
+
Development Status
------------------
@@ -76,6 +88,10 @@ Fork on!
Any enhancements are welcome.
+The github master usually requires the latest fay master, available at
+[faylang/fay](https://github.com/faylang/fay/).
+
+
To run the tests, do:
```
cabal configure -ftest
@@ -83,6 +99,7 @@ cabal build
./dist/build/test/test
```
+
Contact
-------
View
1 TODO
@@ -8,3 +8,4 @@
* Why does Paths_snaplet_fay produce a warning?
* TODO has to recompile if dependencies (imports) changed, should perhaps skip compileAll mode?
* Log messages should print relative paths
+* Compile errors should 500 and print compiler error
View
33 example/example.cabal
@@ -19,21 +19,22 @@ Executable example
main-is: Main.hs
Build-depends:
- base >= 4 && < 5,
- bytestring >= 0.9.1 && < 0.10,
- data-lens >= 2.0.1 && < 2.11,
- data-lens-template >= 2.1 && < 2.2,
- heist >= 0.8 && < 0.9,
- MonadCatchIO-transformers >= 0.2.1 && < 0.4,
- mtl >= 2 && < 3,
- snap == 0.9.*,
- snap-core == 0.9.*,
- snap-server == 0.9.*,
- snap-loader-static == 0.9.*,
- snaplet-fay == 0.1.0.0,
- text >= 0.11 && < 0.12,
- time >= 1.1 && < 1.5,
- xmlhtml >= 0.1
+ base >= 4 && < 5
+ , aeson == 0.6.*
+ , bytestring == 0.9.*
+ , data-lens >= 2.0.1 && < 2.11
+ , data-lens-template >= 2.1 && < 2.2
+ , heist == 0.8.*
+ , MonadCatchIO-transformers >= 0.2.1 && < 0.4
+ , mtl == 2.*
+ , snap == 0.9.*
+ , snap-core == 0.9.*
+ , snap-server == 0.9.*
+ , snap-loader-static == 0.9.*
+ , snaplet-fay == 0.1.0.0
+ , text == 0.11.*
+ , time >= 1.1 && < 1.5
+ , xmlhtml >= 0.1
if flag(development)
build-depends:
@@ -44,7 +45,7 @@ Executable example
-- warnings. The hint library doesn't give an option to execute
-- compiled code when there were also warnings, so disabling
-- warnings allows quicker workflow.
- ghc-options: -threaded -w
+ ghc-options: -threaded -w -Wall
else
if impl(ghc >= 6.12.0)
ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
View
30 example/snaplets/fay/src/Index.hs
@@ -11,4 +11,34 @@ onload = do
div <- createElement "div"
setInnerHtml div "This element was created by Fay through an onload handler!"
appendChild contents div
+
+ currentTime
+ button <- byId "current-time-button"
+ addEvent button "click" currentTime
+
return ()
+
+currentTime :: Fay ()
+currentTime =
+ ajaxJson "/ajax/current-time" handleResponse
+ where
+ handleResponse json = do
+ ctr <- jsonToCTR json
+ el <- byId "current-time"
+ setInnerHtml el (time ctr)
+
+data Json
+instance Foreign Json
+
+data CurrentTimeResponse = CTR { time :: String }
+instance Foreign CurrentTimeResponse
+
+jsonToCTR :: Json -> Fay CurrentTimeResponse
+jsonToCTR json = do t <- attrS json "time"
+ return $ CTR t
+
+ajaxJson :: String -> (Json -> Fay ()) -> Fay ()
+ajaxJson = ffi "jQuery.ajax(%1, { success : %2 })"
+
+attrS :: Foreign f => f -> String -> Fay String
+attrS = ffi "%1[%2]"
View
7 example/snaplets/heist/templates/index.tpl
@@ -1,12 +1,17 @@
<html>
<head>
<title>Snaplet Fay Example Application</title>
- <link rel="stylesheet" type="text/css" href="/screen.css"/>
+ <link rel="stylesheet" type="text/css" href="/static/screen.css"/>
+ <script src="/static/jquery.js"></script>
<script src="/fay/Index.js"></script>
</head>
<body>
<div id="content">
<h1>Snaplet Fay Example Application</h1>
+
+ <div>Current time:</div>
+ <div id="current-time"><current-time/></div>
+ <div><input id="current-time-button" type="button" value="Update current time"></div>
</div>
</body>
</html>
View
20 example/src/Site.hs
@@ -9,25 +9,33 @@ module Site
) where
------------------------------------------------------------------------------
-import Control.Applicative
+import Control.Monad.Trans
+import Data.Aeson
import Data.ByteString (ByteString)
-import Data.Maybe
-import qualified Data.Text as T
+import Data.Time.Clock
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.Heist
import Snap.Snaplet.Fay
import Snap.Util.FileServe
-import Text.Templating.Heist
------------------------------------------------------------------------------
import Application
+currentTimeAjax :: AppHandler ()
+currentTimeAjax = do
+ time <- liftIO getCurrentTime
+ modifyResponse . setContentType $ "text/json;charset=utf-8"
+ writeLBS $ encode . toJSON $ object ["time" .= show time]
+
+
------------------------------------------------------------------------------
-- | The application's routes.
routes :: [(ByteString, Handler App App ())]
-routes = [ ("fay", with fay fayServe)
- , ("", serveDirectory "static")
+routes = [
+ ("/ajax/current-time", currentTimeAjax)
+ , ("/fay", with fay fayServe)
+ , ("/static", serveDirectory "static")
]
View
9,404 example/static/jquery.js
9,404 additions, 0 deletions not shown because the diff is too large. Please use a local Git client to view these changes.
View
5 src/Snap/Snaplet/Fay/Internal.hs
@@ -44,8 +44,9 @@ compileFile config f = do
putStrLn $ "snaplet-fay: Could not find: " ++ hsRelativePath f
return Nothing
else do
- res <- F.compileFile def { F.configDirectoryIncludes = includeDirs config }
- (prettyPrint config) True f
+ res <- F.compileFile def { F.configDirectoryIncludes = includeDirs config
+ , F.configPrettyPrint = prettyPrint config
+ , F.configAutorun = True } f
case res of
Right out -> do
verbosePut config $ "Compiled " ++ hsRelativePath f

0 comments on commit 5d4c985

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