Update AngularJS example to work with Yesod 1.2.

.gitignore

@@ -4,5 +4,8 @@ cabal-dev
 *.hi
 *.chi
 *.chs.h
-*.swp
+*~
 client_session_key.aes
+cabal.sandbox.config
+.cabal-sandbox/
+*.swp

yesod-angular/Yesod/Angular.hs

@@ -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 }

yesod-angular/angular.hs

@@ -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

yesod-angular/angular/add-person.julius

@@ -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]);
         });
     };

yesod-angular/angular/people.julius

@@ -1,5 +1,5 @@
 function($scope, $http) {
-    $http.post("#{cmdGetPeople}", []).success(function(data) {
+    $http.post("#{rawJS cmdGetPeople}", []).success(function(data) {
         $scope.people = data;
     });
 }

yesod-angular/angular/person-detail.julius

@@ -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");