snaplet-fay 0.3.2.0 → 0.3.3
raw patch · 10 files changed
+71/−54 lines, 10 filesdep ~aesondep ~basedep ~bytestring
Dependency ranges changed: aeson, base, bytestring, configurator, data-default, directory, fay, filepath, mtl, snap, snap-core, transformers
Files
- README.md +13/−0
- example/example.cabal +9/−8
- example/snaplets/fay/devel.cfg +1/−1
- example/snaplets/fay/src/Application/SharedTypes.hs +6/−5
- example/snaplets/fay/src/BrokenFile.hs +1/−2
- example/snaplets/fay/src/Index.hs +16/−13
- example/src/Site.hs +7/−8
- snaplet-fay.cabal +12/−12
- src/Snap/Snaplet/Fay.hs +1/−1
- src/Snap/Snaplet/Fay/Internal.hs +5/−4
README.md view
@@ -28,6 +28,19 @@ Changelog --------- +0.3.3.0:++* Format Fay compile errors using Fay's builtin (doesn't break on apostrophes)+* Only treat compile errors as Success in development mode (for in browser error reporting)+* Fixes a bug where error strings would be encoded twice+* Requires fay 0.18+* Update example for fay-jquery 0.4+* Upper bounds for dependencies++0.3.2.0:++* Expose Snap.Snaplet.Fay.Internal+ 0.3.1.1.: * Hackage version now includes the example application
example/example.cabal view
@@ -24,18 +24,19 @@ , aeson >= 0.6 , bytestring >= 0.9 , fay- , fay-jquery- , heist >= 0.8- , lens >= 3.7+ , fay-text == 0.2.*+ , fay-jquery == 0.4.*+ , heist >= 0.8 && < 0.14+ , lens >= 3.7 && < 3.11 , mtl >= 2 , snap >= 0.9 , snap-core >= 0.9- , snap-loader-static >= 0.9- , snap-server >= 0.9- , snaplet-fay >= 0.3.1.1- , text >= 0.11+ , snap-loader-static == 0.9.*+ , snap-server == 0.9.*+ , snaplet-fay == 0.3.3+ , text == 0.11.* , time >= 1.1 && < 1.5- , xmlhtml >= 0.1+ , xmlhtml >= 0.1 && < 0.3 if flag(development) build-depends:
example/snaplets/fay/devel.cfg view
@@ -22,4 +22,4 @@ # This gives the same result as using includeDirs, # except Fay figures out the paths for you. # Default is "" meaning no other Fay packages will be used.-packages = "fay-jquery"+packages = "fay-text,fay-jquery"
@@ -1,24 +1,25 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE CPP #-} module Application.SharedTypes where -import Prelude import Data.Data+import Fay.Text (Text)+import Prelude #ifdef FAY import FFI #endif -data Time = Time { time :: String }+data Time = Time { time :: Text } deriving (Read,Data,Typeable,Show) -data UserRegister = UserRegister { user :: String, password :: String, passwordConfirmation :: String }+data UserRegister = UserRegister { user :: Text, password :: Text, passwordConfirmation :: Text } deriving (Read,Data,Typeable,Show) -data UserLogin = UserLogin { ul_user :: String, ul_password :: String, remember :: Bool }+data UserLogin = UserLogin { ul_user :: Text, ul_password :: Text, remember :: Bool } deriving (Read,Data,Typeable,Show) data UserRegisterResponse = Fail | OK
example/snaplets/fay/src/BrokenFile.hs view
@@ -1,2 +1,1 @@--broken:(+main = f ":("
example/snaplets/fay/src/Index.hs view
@@ -1,19 +1,22 @@ {-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-} {-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-} module Index where -import FFI-import Prelude+import Fay.Text (Text, fromString)+import FFI+import Prelude -- | Time is shared between Snap and Fay -- | Location: snaplets/fay/src/Application/SharedTypes.hs-import Application.SharedTypes+import Application.SharedTypes -- | Dom is a Fay only module -- | Location: snaplets/fay/src-import Dom+import Dom -- | The fay-jquery package-import JQuery+import JQuery void :: Fay f -> Fay () void f = f >> return ()@@ -38,7 +41,7 @@ currentTime = ajaxJson "/ajax/current-time" (\(Time time) -> void $ select "#current-time" >>= setHtml time) -formOnload :: String -> Fay () -> Fay ()+formOnload :: Text -> Fay () -> Fay () formOnload buttonSel getForm = void $ select buttonSel >>= click (const getForm) registrationOnload :: Fay ()@@ -47,7 +50,7 @@ loginOnload :: Fay () loginOnload = formOnload "#viewLoginForm" requestLoginHtml -requestHtml :: String -> Fay () -> Fay ()+requestHtml :: Text -> Fay () -> Fay () requestHtml url submitAction = do formContainer <- select "#formContainer" hide Slow formContainer@@ -57,7 +60,7 @@ jshow Slow formContainer return ()) -typeof :: f -> String+typeof :: f -> Text typeof = ffi "typeof %1" requestRegisterHtml :: Fay ()@@ -90,11 +93,11 @@ data Status = Error | Notice -statusClass :: Status -> String+statusClass :: Status -> Text statusClass Error = "error" statusClass Notice = "notice" -showStatus :: Status -> String -> JQuery -> Fay ()+showStatus :: Status -> Text -> JQuery -> Fay () showStatus status msg el = void $ return el >>= hide Fast >>= removeClass (statusClass Error) >>= removeClass (statusClass Notice) >>=@@ -107,11 +110,11 @@ -- jQuery additions -jPost :: String -> Automatic f -> (Automatic g -> Fay ()) -> Fay ()+jPost :: Text -> Automatic f -> (Automatic g -> Fay ()) -> Fay () jPost = ffi "jQuery.ajax(%1, { data: JSON.stringify(%2), type: 'POST', processData: false, contentType: 'text/json', success: %3 })" -ajaxHtml :: String -> (String -> Fay()) -> Fay ()+ajaxHtml :: Text -> (Text -> Fay()) -> Fay () ajaxHtml = ffi "jQuery.ajax(%1, { success : %2 })" -ajaxJson :: String -> (Automatic f -> Fay ()) -> Fay ()+ajaxJson :: Text -> (Automatic f -> Fay ()) -> Fay () ajaxJson = ffi "jQuery.ajax(%1, { success : %2 })"
example/src/Site.hs view
@@ -8,8 +8,8 @@ import Control.Applicative import Control.Monad.Trans import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BS import qualified Data.Text as T+import qualified Data.Text.Encoding as T import Data.Time.Clock import Snap.Snaplet import Snap.Snaplet.Auth hiding (session)@@ -24,7 +24,7 @@ currentTimeAjax :: AppHandler Time-currentTimeAjax = Time . show <$> liftIO getCurrentTime+currentTimeAjax = Time . T.pack . show <$> liftIO getCurrentTime -- TODO this can be handled automatically by heistServe registerForm :: AppHandler ()@@ -34,16 +34,15 @@ register :: UserRegister -> Handler App (AuthManager App) UserRegisterResponse register (UserRegister u p pc)- | length u < 4 || length p < 4 || p /= pc = return Fail+ | T.length u < 4 || T.length p < 4 || p /= pc = return Fail | otherwise = do- let u' = T.pack u- exists <- usernameExists u'- if exists then return Fail else (createUser u' (BS.pack p) >> return OK)+ exists <- usernameExists u+ if exists then return Fail else (createUser u (T.encodeUtf8 p) >> return OK) login :: UserLogin -> Handler App (AuthManager App) UserLoginResponse login (UserLogin u p r) = either (return BadLogin) (return LoggedIn) <$>- loginByUsername (BS.pack u) (ClearText $ BS.pack p) r+ loginByUsername u (ClearText $ T.encodeUtf8 p) r ------------------------------------------------------------------------------ -- | The application's routes.@@ -69,6 +68,6 @@ h <- nestSnaplet "" heist $ heistInit "templates" f <- nestSnaplet "fay" fay $ initFay a <- nestSnaplet "auth" auth $ initJsonFileAuthManager defAuthSettings session "users.json"- addAuthSplices auth+ addAuthSplices h auth addRoutes routes return $ App h f s a
snaplet-fay.cabal view
@@ -5,7 +5,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.3.2.0+version: 0.3.3 synopsis: Fay integration for Snap with request- and pre-compilation. description: Fay integration for Snap with request based compilation during development and precompilation in production. For more information, please see <https://github.com/bergmark/snaplet-fay>.@@ -41,14 +41,14 @@ build-depends: base >= 4 && < 5- , aeson >= 0.6- , bytestring >= 0.9- , configurator >= 0.2- , data-default >= 0.5- , directory >= 1.1- , fay >= 0.14.2.0- , filepath >= 1.3- , mtl >= 2.1- , snap >= 0.11.1- , snap-core >= 0.9.3.1- , transformers >= 0.3+ , aeson == 0.6.*+ , bytestring >= 0.9 && < 0.11+ , configurator == 0.2.*+ , data-default == 0.5.*+ , directory >= 1.1 && < 1.3+ , fay >= 0.18.0.2 && < 0.19+ , filepath == 1.3.*+ , mtl == 2.1.*+ , snap >= 0.11.1 && < 0.14+ , snap-core >= 0.9.3.1 && < 0.10+ , transformers == 0.3.*
src/Snap/Snaplet/Fay.hs view
@@ -151,7 +151,7 @@ case res of Success s -> writeBS $ fromString s NotFound -> send404 Nothing- Error err -> send500 . Just . BS.pack $ err+ Error err -> writeBS $ fromString err -- Production compilation has already been done. compileWithMode Production = get >>= serveDirectory . destDir
src/Snap/Snaplet/Fay/Internal.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-} module Snap.Snaplet.Fay.Internal where @@ -59,16 +60,16 @@ , F.configFilePath = Just f' } case res of- Right out -> do+ Right (out, _sourceMap) -> do verbosePut config $ "Compiled " ++ hsRelativePath f writeFile (jsPath config f) out return $ Success out Left err -> do- let errString = "snaplet-fay: Error compiling " ++ hsRelativePath f ++ ":\n" ++ show err+ let errString = C.unpack . A.encode $ "snaplet-fay: Error compiling " ++ hsRelativePath f ++ ":\n" ++ F.showCompileError err putStrLn errString -- return Success so the browser will treat this as a normal JavaScript file. -- As of writing this, this means that Error is not used.- return $ Success $ "console.error('" ++ (C.unpack . A.encode) errString ++ "');"+ return $ Error $ "console.error(" ++ errString ++ ");" -- | Checks the specified source folder and compiles all new and modified scripts. -- Also removes any js files whose Fay source has been deleted.