Permalink
Browse files

Update AngularJS example to work with Yesod 1.2.

  • Loading branch information...
creichert committed Jun 23, 2014
1 parent edb196a commit 6dd9989c4232dabcd7eae977a2d3722a34605064
View
@@ -4,5 +4,8 @@ cabal-dev
*.hi
*.chi
*.chs.h
-*.swp
+*~
client_session_key.aes
+cabal.sandbox.config
+.cabal-sandbox/
+*.swp
@@ -9,104 +9,115 @@ module Yesod.Angular
, addCtrl
, addCtrlRaw
, setDefaultRoute
- , GAngular
+ , AngularT
) where
-import Control.Applicative ((<$>))
-import Control.Monad.Trans.Writer (WriterT, runWriterT, tell)
-import Data.Aeson (FromJSON, ToJSON)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Maybe (fromMaybe)
-import Data.Monoid (First (..), Monoid (..))
-import Data.Text (Text)
-import Text.Hamlet (HtmlUrl, hamletFile)
-import Text.Julius (JavascriptUrl, julius, juliusFile)
-import Yesod.Core (GHandler, GWidget, RepHtml,
- RepHtml (RepHtml), Route, Yesod,
- addScriptEither, defaultLayout,
- getUrlRenderParams, getYesod, lift,
- lookupGetParam, newIdent,
- sendResponse, toContent,
- toWidget, whamlet)
-import Yesod.Json (jsonToRepJson, parseJsonBody_)
-import Language.Haskell.TH.Syntax (Q, Exp (AppE, LitE), Lit (StringL))
+import Control.Applicative
+import Data.Char (isAlpha)
+import Control.Monad.Trans.Writer
+import Data.Aeson
import qualified Data.Text as T
-import Data.Char (isAlpha)
+import Data.Map
+import qualified Data.Map as Map
+import Data.Maybe
+import Data.Monoid
+import Data.Text
+import Language.Haskell.TH.Syntax (Q, Exp (AppE, LitE), Lit (StringL))
+import Text.Hamlet
+import Text.Julius
+import Yesod
-class Yesod master => YesodAngular master where
- urlAngularJs :: master -> Either (Route master) Text
- urlAngularJs _ = Right "//ajax.googleapis.com/ajax/libs/angularjs/1.0.2/angular.min.js"
- wrapAngular :: Text -> GWidget sub master () -> GHandler sub master RepHtml
- wrapAngular modname widget = defaultLayout [whamlet|<div ng-app=#{modname}>^{widget}|]
+-- | YesodAngular wraps a widget in ng-app named @modname.
+class Yesod site => YesodAngular site where
+ urlAngularJs :: site -> Either (Route site) Text
+ urlAngularJs _ = Right "//cdnjs.cloudflare.com/ajax/libs/angular.js/1.2.16/angular.min.js"
-data AngularWriter sub master = AngularWriter
- { awCommands :: Map Text (GHandler sub master ())
- , awPartials :: Map Text (HtmlUrl (Route master))
- , awRoutes :: JavascriptUrl (Route master)
- , awControllers :: JavascriptUrl (Route master)
+ wrapAngular :: Text -> WidgetT site IO () -> HandlerT site IO Html
+ wrapAngular modname widget = defaultLayout [whamlet| <div ng-app=#{modname}>^{widget} |]
+
+
+data AngularWriter site = AngularWriter
+ { awCommands :: Map Text (HandlerT site IO ())
+ , awPartials :: Map Text (HtmlUrl (Route site))
+ , awRoutes :: JavascriptUrl (Route site)
+ , awControllers :: JavascriptUrl (Route site)
, awDefaultRoute :: First Text
}
-instance Monoid (AngularWriter sub master) where
+
+
+type AngularT site = WriterT (AngularWriter site) (HandlerT site IO)
+
+
+instance Monoid (AngularWriter site) where
mempty = AngularWriter mempty mempty mempty mempty mempty
AngularWriter a1 a2 a3 a4 a5
- `mappend` AngularWriter b1 b2 b3 b4 b5
- = AngularWriter
- (mappend a1 b1)
- (mappend a2 b2)
- (mappend a3 b3)
- (mappend a4 b4)
- (mappend a5 b5)
-
-type GAngular sub master = WriterT (AngularWriter sub master) (GHandler sub master)
-
-runAngular :: YesodAngular master
- => GAngular sub master ()
- -> GHandler sub master RepHtml
+ `mappend` AngularWriter b1 b2 b3 b4 b5 = AngularWriter
+ (mappend a1 b1)
+ (mappend a2 b2)
+ (mappend a3 b3)
+ (mappend a4 b4)
+ (mappend a5 b5)
+
+
+-----------------------------------------------------------------------
+
+
+runAngular :: YesodAngular site
+ => AngularT site ()
+ -> HandlerT site IO Html
runAngular ga = do
- master <- getYesod
+ site <- getYesod
((), AngularWriter{..}) <- runWriterT ga
mc <- lookupGetParam "command"
fromMaybe (return ()) $ mc >>= flip Map.lookup awCommands
mp <- lookupGetParam "partial"
case mp >>= flip Map.lookup awPartials of
Nothing -> return ()
- Just htmlurl -> getUrlRenderParams >>= sendResponse . RepHtml . toContent . htmlurl
+ Just htmlurl -> do
+ ps <- getUrlRenderParams
+ let rep = toTypedContent . htmlurl $ ps
+ sendResponse rep
modname <- newIdent
let defaultRoute =
case awDefaultRoute of
- First (Just x) -> [julius|.otherwise({redirectTo:"#{x}"})|]
+ First (Just x) -> [julius|.otherwise({redirectTo:"#{rawJS x}"})|]
First Nothing -> mempty
wrapAngular modname $ do
- addScriptEither $ urlAngularJs master
- [whamlet|<div ng-view>|]
+ addScriptEither $ urlAngularJs site
+ addScriptRemote "//cdnjs.cloudflare.com/ajax/libs/angular.js/1.2.16/angular-route.min.js"
+ [whamlet| <div ng-view> |]
toWidget [julius|
-angular
- .module("#{modname}", [])
- .config(["$routeProvider", function($routeProvider) {
- $routeProvider ^{awRoutes} ^{defaultRoute} ;
- }]);
-^{awControllers}
-|]
+ angular.module("#{rawJS modname}", ['ngRoute']).config(["$routeProvider",
+ function($routeProvider, $locationProvider) {
+ $routeProvider ^{awRoutes} ^{defaultRoute};
+ }]);
+ ^{awControllers}
+ |]
+
addCommand :: (FromJSON input, ToJSON output)
- => (input -> GHandler sub master output)
- -> GAngular sub master Text
+ => (input -> HandlerT site IO output)
+ -> AngularT site Text
addCommand f = do
name <- lift newIdent
tell mempty { awCommands = Map.singleton name handler }
return $ "?command=" `mappend` name
where
handler = do
- input <- parseJsonBody_
+ input <- requireJsonBody
output <- f input
- repjson <- jsonToRepJson output
+ repjson <- returnJson output
sendResponse repjson
+
+setDefaultRoute :: Text -> AngularT site ()
+setDefaultRoute x = tell mempty { awDefaultRoute = First $ Just x }
+
+
addCtrl :: Text -- ^ route pattern
-> Text -- ^ template name
-> Q Exp
@@ -119,18 +130,20 @@ addCtrl route name = do
return $ AppE p $ LitE $ StringL $ T.unpack t
fn suffix = T.unpack $ T.concat ["angular/", name, ".", suffix]
+
addCtrlRaw :: Text -- ^ user-friendly name
-> Text -- ^ route pattern
- -> HtmlUrl (Route master) -- ^ template
- -> JavascriptUrl (Route master) -- ^ controller
- -> GAngular sub master ()
+ -> HtmlUrl (Route site) -- ^ template
+ -> JavascriptUrl (Route site) -- ^ controller
+ -> AngularT site ()
addCtrlRaw name' route template controller = do
- name <- (mappend $ mappend name' "__") <$> lift newIdent
+ name <- mappend (mappend name' "__") <$> lift newIdent
tell mempty
{ awPartials = Map.singleton name template
- , awRoutes = [julius|.when("#{route}", {controller:#{name}, templateUrl:"?partial=#{name}"})|]
- , awControllers = [julius|var #{name} = ^{controller};|]
+ , awRoutes = [julius| .when("#{rawJS route}",
+ { "controller": #{rawJS name}
+ , "templateUrl": "?partial=#{rawJS name}"
+ })
+ |]
+ , awControllers = [julius| var #{rawJS name} = ^{controller} |]
}
-
-setDefaultRoute :: Text -> GAngular sub master ()
-setDefaultRoute x = tell mempty { awDefaultRoute = First $ Just x }
View
@@ -1,14 +1,17 @@
-{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses, ScopedTypeVariables, GeneralizedNewtypeDeriving, RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes #-}
+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, ScopedTypeVariables #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, RecordWildCards #-}
module Main (main) where
-import Yesod
-import Yesod.Static
-import Yesod.Angular
-import Data.IORef
-import Data.Text (pack)
-import Data.Map (Map)
+import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef)
+import Data.Map (Map)
import qualified Data.Map as Map
-import Types
+import Data.Text (pack)
+import Text.Julius (rawJS)
+import Types
+import Yesod
+import Yesod.Angular
+import Yesod.Static
data App = App
{ getStatic :: Static
@@ -22,12 +25,9 @@ mkYesod "App" [parseRoutes|
|]
instance Yesod App
-instance YesodAngular App where
- urlAngularJs _ = Left $ StaticR $ StaticRoute ["angular", "angular.min.js"] []
+instance YesodAngular App
-type Angular = GAngular App App ()
-
-handleHomeR :: Handler RepHtml
+handleHomeR :: Handler Html
handleHomeR = runAngular $ do
cmdGetPeople <- addCommand $ \() -> do
people' <- getYesod >>= liftIO . readIORef . ipeople
@@ -57,4 +57,4 @@ main = do
s <- static "static"
p <- newIORef Map.empty
ni <- newIORef 1
- warpDebug 3000 $ App s p ni
+ warp 3000 $ App s p ni
@@ -1,6 +1,6 @@
function($scope, $http, $location) {
$scope.addPerson = function(){
- $http.post("#{cmdAddPerson}", $scope.newPerson).success(function(data){
+ $http.post("#{rawJS cmdAddPerson}", $scope.newPerson).success(function(data){
$location.path("/people/" + data[0]);
});
};
@@ -1,5 +1,5 @@
function($scope, $http) {
- $http.post("#{cmdGetPeople}", []).success(function(data) {
+ $http.post("#{rawJS cmdGetPeople}", []).success(function(data) {
$scope.people = data;
});
}
@@ -1,5 +1,5 @@
function($scope, $routeParams, $http, $location) {
- $http.post("#{cmdPersonDetail}", [$routeParams.personId]).success(function(data) {
+ $http.post("#{rawJS cmdPersonDetail}", [$routeParams.personId]).success(function(data) {
$scope.person = data;
}).error(function(){
$location.path("/people");
Oops, something went wrong.

0 comments on commit 6dd9989

Please sign in to comment.