Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

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

…records automatically)
  • Loading branch information...
commit 5d4c9854d5e0b1ba0021e33f39d0286ed8edc07e 1 parent 1da2450
@bergmark bergmark authored
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
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
Please sign in to comment.
Something went wrong with that request. Please try again.