yesod-angular (empty) → 0.1.0.0
raw patch · 4 files changed
+226/−0 lines, 4 filesdep +aesondep +basedep +containerssetup-changed
Dependencies added: aeson, base, containers, shakespeare, template-haskell, text, transformers, yesod
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Yesod/Angular.hs +161/−0
- yesod-angular.cabal +33/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Christopher Reichert++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Christopher Reichert nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Yesod/Angular.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++-- | Yesod Angular JS Integration.+--+-- This module is based on Michael Snoyman's original work+-- in the <https://github.com/snoyberg/yesod-js> repository.+--+-- * This module currently defaults to Angular 1.2.18. Use+-- `urlAngularJs_` specify your own Angular location.+-- * Example can be found at:+-- <https://github.com/snoyberg/yesod-js/tree/master/yesod-angular>+-- * Currently, this module looks for controllers in the+-- `templates/angular` directory.+module Yesod.Angular+ ( YesodAngular (..)+ , runAngular+ , addCommand+ , addCtrl+ , addCtrlRaw+ , setDefaultRoute+ , AngularT+ ) where++import Control.Applicative ((<$>))+import Control.Monad.Trans.Writer (WriterT(..), tell)+import Data.Aeson (FromJSON, ToJSON)+import Data.Char (isAlpha)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe (fromMaybe)+import Data.Monoid (Monoid, First(..), (<>), mempty, mappend)+import Data.Text (Text)+import qualified Data.Text as T+import Language.Haskell.TH.Syntax (Q, Exp (AppE, LitE),+ Lit (StringL))+import Text.Hamlet (hamletFile)+import Text.Julius (JavascriptUrl, juliusFile, rawJS)+import Yesod+++-- | YesodAngular wraps a widget in ng-app named @modname.+class Yesod site => YesodAngular site where+ -- | Default instance loads `angular.min.js` and `angular-route.min.js`.+ urlAngularJs :: site -> [Either (Route site) Text]+ urlAngularJs _ = [Right "//cdnjs.cloudflare.com/ajax/libs/angular.js/1.2.18/angular.min.js",+ Right "//cdnjs.cloudflare.com/ajax/libs/angular.js/1.2.18/angular-route.min.js"]++ -- | 'wrapAngular' wraps @widget in an ng-app named @modname.+ 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+ }+++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)+++runAngular :: YesodAngular site+ => AngularT site ()+ -> HandlerT site IO Html+runAngular ga = do+ 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 -> do+ ps <- getUrlRenderParams+ let rep = toTypedContent . htmlurl $ ps+ sendResponse rep++ modname <- newIdent++ let defaultRoute =+ case awDefaultRoute of+ First (Just x) -> [julius|.otherwise({redirectTo:"#{rawJS x}"})|]+ First Nothing -> mempty++ wrapAngular modname $ do+ mapM_ addScriptEither $ urlAngularJs site+ [whamlet| <div ng-view> |]+ toWidget [julius|+ angular.module("#{rawJS modname}", ['ngRoute']).config(["$routeProvider",+ function($routeProvider, $locationProvider) {+ $routeProvider ^{awRoutes} ^{defaultRoute};+ }]);+ ^{awControllers}+ |]+++addCommand :: (FromJSON input, ToJSON output)+ => (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 <- requireJsonBody+ output <- f input+ 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+addCtrl route name = do+ let name' = T.filter isAlpha name+ [|addCtrlRaw $(liftT name') $(liftT route) $(hamletFile $ fn "hamlet") $(juliusFile $ fn "julius")|]+ where+ liftT t = do+ p <- [|T.pack|]+ 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 site) -- ^ template+ -> JavascriptUrl (Route site) -- ^ controller+ -> AngularT site ()+addCtrlRaw name' route template controller = do+ name <- mappend (mappend name' "__") <$> lift newIdent+ tell mempty+ { awPartials = Map.singleton name template+ , awRoutes = [julius| .when("#{rawJS route}",+ { "controller": #{rawJS name}+ , "templateUrl": "?partial=#{rawJS name}"+ })+ |]+ , awControllers = [julius| var #{rawJS name} = ^{controller} |]+ }
+ yesod-angular.cabal view
@@ -0,0 +1,33 @@+name: yesod-angular+version: 0.1.0.0+synopsis: Yesod AngularJS integration.+description:+ Yesod AngularJS integration.++ This module is based on Michael Snoyman's original work+ in the <https://github.com/snoyberg/yesod-js> repository.+license: BSD3+license-file: LICENSE+author: Christopher Reichert <creichert07@gmail.com>+maintainer: Christopher Reichert <creichert07@gmail.com>+category: Web+build-type: Simple+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Yesod.Angular+ default-language: Haskell2010+ build-depends:+ aeson >= 0.6 && < 0.8+ , base == 4.*+ , containers == 0.5.*+ , shakespeare == 2.*+ , template-haskell+ , text >= 0.11 && < 2.0+ , transformers >= 0.2+ , yesod >= 1.2.5 && < 1.3++source-repository head+ type: git+ location: https://github.com/creichert/yesod-angular