yesod-angular-ui (empty) → 0.1.0.0
raw patch · 7 files changed
+876/−0 lines, 7 filesdep +basedep +blaze-htmldep +containerssetup-changed
Dependencies added: base, blaze-html, containers, directory, hjsmin, mtl, resourcet, shakespeare, template-haskell, text, transformers, yesod, yesod-core
Files
- LICENSE +64/−0
- Setup.hs +2/−0
- src/Text/Naked/Coffee.hs +119/−0
- src/Yesod/AngularUI.hs +428/−0
- src/Yesod/AngularUI/Router.hs +77/−0
- src/Yesod/AngularUI/Types.hs +139/−0
- yesod-angular-ui.cabal +47/−0
+ LICENSE view
@@ -0,0 +1,64 @@+Copyright (c) 2014, Marcin Tolysz 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 Marcin Tolysz nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++---+-- snoyberg/yesod-js+Copyright 2010, Michael Snoyman. All rights reserved.++The following license covers this documentation, and the source code, except+where otherwise indicated.+++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.++---+-- yesodweb/shakespeare++Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++--++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "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 HOLDERS 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/Text/Naked/Coffee.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+-- | A Shakespearean module for CoffeeScript, introducing type-safe,+-- compile-time variable and url interpolation. It is exactly the same as+-- "Text.Julius", except that the template is first compiled to Javascript with+-- the system tool @coffee@.+--+-- To use this module, @coffee@ must be installed on your system.+--+-- @#{...}@ is the Shakespearean standard for variable interpolation, but+-- CoffeeScript already uses that sequence for string interpolation. Therefore,+-- Shakespearean interpolation is introduced with @%{...}@.+--+-- If you interpolate variables,+-- the template is first wrapped with a function containing javascript variables representing shakespeare variables,+-- then compiled with @coffee@,+-- and then the value of the variables are applied to the function.+-- This means that in production the template can be compiled+-- once at compile time and there will be no dependency in your production+-- system on @coffee@. +--+-- Your code:+--+-- > b = 1+-- > console.log(#{a} + b)+--+-- Function wrapper added to your coffeescript code:+--+-- > ((shakespeare_var_a) =>+-- > b = 1+-- > console.log(shakespeare_var_a + b)+-- > )+--+-- This is then compiled down to javascript, and the variables are applied:+--+-- > ;(function(shakespeare_var_a){+-- > var b = 1;+-- > console.log(shakespeare_var_a + b);+-- > })(#{a});+--+--+-- Further reading:+--+-- 1. Shakespearean templates: <http://www.yesodweb.com/book/templates>+--+-- 2. CoffeeScript: <http://coffeescript.org/>+module Text.Naked.Coffee+ ( -- * Functions+ -- ** Template-Reading Functions+ -- | These QuasiQuoter and Template Haskell methods return values of+ -- type @'JavascriptUrl' url@. See the Yesod book for details.+ ncoffee+ , ncoffeeFile+ , ncoffeeFileReload+ , ncoffeeFileDebug++#ifdef TEST_EXPORT+ , coffeeSettings+#endif+ ) where++import Language.Haskell.TH.Quote (QuasiQuoter (..))+import Language.Haskell.TH.Syntax+import Text.Shakespeare+import Text.Julius+import Prelude+import qualified Data.Text.Lazy as T+import Data.Text.Lazy.Builder (fromLazyText)++-- just kill the last semipcolon+coffeeSettings :: Q ShakespeareSettings+coffeeSettings = do+ jsettings <- javascriptSettings+ drp <- [| \ex url -> Javascript . fromLazyText . {- T.drop 1 . T.init .-} T.init . T.init . renderJavascript $ ex url |]+ return $ jsettings { varChar = '%'+ , modifyFinalValue = Just drp+ , preConversion = Just PreConvert {+ preConvert = ReadProcess "coffee" ["-spb"]+ , preEscapeIgnoreBalanced = "'\"`" -- don't insert backtacks for variable already inside strings or backticks.+ , preEscapeIgnoreLine = "#" -- ignore commented lines+ , wrapInsertion = Just WrapInsertion { + wrapInsertionIndent = Just " "+ , wrapInsertionStartBegin = "("+ , wrapInsertionSeparator = ", "+ , wrapInsertionStartClose = ") =>"+ , wrapInsertionEnd = ""+ , wrapInsertionAddParens = False+ }+ }+ }++-- | Read inline, quasiquoted CoffeeScript.+ncoffee :: QuasiQuoter+ncoffee = QuasiQuoter { quoteExp = \s -> do+ rs <- coffeeSettings+ quoteExp (shakespeare rs) s+ }++-- | Read in a CoffeeScript template file. This function reads the file once, at+-- compile time.+ncoffeeFile :: FilePath -> Q Exp+ncoffeeFile fp = do+ rs <- coffeeSettings+ shakespeareFile rs fp++-- | Read in a CoffeeScript template file. This impure function uses+-- unsafePerformIO to re-read the file on every call, allowing for rapid+-- iteration.+ncoffeeFileReload :: FilePath -> Q Exp+ncoffeeFileReload fp = do+ rs <- coffeeSettings+ shakespeareFileReload rs fp++-- | Deprecated synonym for 'coffeeFileReload'+ncoffeeFileDebug :: FilePath -> Q Exp+ncoffeeFileDebug = ncoffeeFileReload+{-# DEPRECATED ncoffeeFileDebug "Please use coffeeFileReload instead." #-}
+ src/Yesod/AngularUI.hs view
@@ -0,0 +1,428 @@+{-# Language OverloadedStrings+ , QuasiQuotes+ , RecordWildCards+ , LambdaCase+ , TemplateHaskell+ , BangPatterns+ , FlexibleContexts+ , FlexibleInstances+ , MultiParamTypeClasses+ , UndecidableInstances+ , ScopedTypeVariables+ , RankNTypes+ , TypeFamilies+ , ViewPatterns+ #-}++module Yesod.AngularUI+ ( YesodAngular (..)+ , runAngularUI+ , addCommand+ , addCommandMaybe+ -- ^ mostly internal+ , addModules+ , addDirective+ , addConfig+ , addConfigRaw+ , addService++ , addFactoryStore+ -- ^ naive persistent store+ , addFactory+ , addController+ , addProvide+ , addFilter+ , addConstant+ -- some normal stuff+ , addSetup+ -- ^ before the code, maybe some imports?++ , addWhen+ , setDefaultRoute+ , addREST+ , addRESTRaw+ -- placeholders for some generic rest api/ maybe a subsite?+ , tcFile+ , tcVFile+ , state+ , url+ , name+ , nameA+ , addData+ , GAngular+ ) where+++--- the chaos+import Control.Applicative ((<$>))+import Control.Monad.Trans.Writer (WriterT, runWriterT, tell, execWriter)+-- import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe, catMaybes)+import Data.Monoid (First (..), Monoid (..), (<>))+import Data.Text (Text)+import Text.Hamlet+import Text.Blaze.Html+import Text.Julius+import Text.Lucius+import Yesod.Core (Route,+ getUrlRenderParams, getMessageRender, getYesod, lift,+ lookupGetParam, newIdent,+ sendResponse, notFound)+import Yesod.Core.Widget+import qualified Text.Blaze.Html5 as H+import Text.Jasmine (minify)+import Yesod.Core.Types+import Yesod.Core.Json+import Language.Haskell.TH.Syntax (Q, Exp (..), Lit (..))+import Language.Haskell.TH (listE)+import qualified Data.Text as T++import Prelude hiding (head, init, last, readFile, tail, writeFile)+import Control.Monad.Trans.Resource+import Control.Monad.IO.Class+import Text.Shakespeare.I18N+import qualified Data.Text.Lazy.Encoding as E (encodeUtf8, decodeUtf8)++import Yesod.AngularUI.Router+import Yesod.AngularUI.Types as TS+++renSoMsg :: (SomeMessage master -> Text) -> SomeMessage master -> Html+renSoMsg f = toHtml . f++runAngularUI :: (YesodAngular master)+ => GAngular master IO () -- ^ angular app+ -> (Text -> WidgetT master IO () -> HandlerT master IO Html) -- ^ layout+ -> HandlerT master IO Html+runAngularUI ga dl = do+ master <- getYesod+ mrender <- renSoMsg <$> getMessageRender+ urender <- getUrlRenderParams++ ((), AngularWriter{..}) <- runWriterT ga++ mc <- lookupGetParam "command"+ fromMaybe (return ()) $ mc >>= flip Map.lookup awCommands+ modname <- newIdent+ let defaultRoute =+ case (awDefaultRoute, awStateName) of+ (filter (`elem` awStateName) -> x:_, _) -> [julius|.otherwise("/#{rawJS x}")|]+ (_, x:_) -> [julius|.otherwise("/#{rawJS x}")|]+ (_,[]) -> mempty+ dl modname $ do+ mapM_ (\x -> addScriptEither $ x master) urlAngularJs+ angularUIEntry+ toWidgetHead $ Minify awLook+ toWidget (combined mrender urender)+ toWidgetBody $ Minify [julius|+^{awSetup}++angular+ .module("#{rawJS modname}", #{rawJS $ show awModules }, function($provide) {+ // $provide.constant("menu",# {toJSON awMenu});+ ^{awServices}+ })+ ^{awDirectives}+ ^{awConfigs}+ .config(function($urlRouterProvider, $stateProvider) {+ $urlRouterProvider ^{awRoutes} ^{defaultRoute} ;+ $stateProvider ^{awStates};+ });+ ^{awControllers}+|]++newtype Minify a = Minify a++instance render ~ RY site => ToWidgetHead site (Minify [CssUrl (Route site)]) where+ toWidgetHead (Minify j) = toWidgetHead $ \r -> H.style $ preEscapedLazyText $ mconcat $ map (renderCssUrl r) j++instance render ~ RY site => ToWidgetBody site (Minify (render -> Javascript)) where+ toWidgetBody (Minify j) = toWidget $ \r -> H.script $ preEscapedLazyText $ E.decodeUtf8 $ minify $ E.encodeUtf8 $ renderJavascriptUrl r j++addModules :: (Monad m) => [Text] -> GAngular master m ()+addModules x = tell mempty{ awModules = x } ++addConfig :: (Monad m) => Text+ -> ((Route master -> [(Text, Text)] -> Text) -> Javascript)+ -> GAngular master m ()+addConfig name' funcall = do+ let n = name' `mappend` "Provider"+ tell mempty+ { awConfigs = [julius|.config(["#{rawJS n}", function (#{rawJS n}){+ #{rawJS n}.^{funcall}; }])|]+ }++addConfigRaw :: (Monad m) => ((Route master -> [(Text, Text)] -> Text) -> Javascript)+ -> GAngular master m ()+addConfigRaw funcall = tell mempty { awConfigs = [julius|.config(^{funcall})|] }++addDirective :: (Monad m) => Text+ -> ((Route master -> [(Text, Text)] -> Text) -> Javascript)+ -> GAngular master m ()+addDirective n funcall =+ tell mempty+ { awDirectives = [julius|.directive("#{rawJS n}", ^{funcall} )|]+ }++addController :: (Monad m) => Text+ -> ((Route master -> [(Text, Text)] -> Text) -> Javascript)+ -> GAngular master m ()+addController n funcall =+ tell mempty+ { awDirectives = [julius|.controller("#{rawJS n}", ^{funcall} )|]+ }+++addFilter :: (Monad m) => Text+ -> ((Route master -> [(Text, Text)] -> Text) -> Javascript)+ -> GAngular master m ()+addFilter n funcall =+ tell mempty+ { awDirectives = [julius|.filter("#{rawJS n}", ^{funcall} )|]+ }+++addFactory :: (Monad m) => Text+ -> ((Route master -> [(Text, Text)] -> Text) -> Javascript)+ -> GAngular master m ()+addFactory n funcall = addProvide [js|factory("#{rawJS n}",^{funcall})|]++addREST :: (Monad m) => Text+ -> ((Route master -> [(Text, Text)] -> Text) -> Javascript)+ -> GAngular master m ()+addREST n funcall =+ tell mempty+ { awModules = ["ngResource"]+ , awDirectives = [julius|+ .factory("#{rawJS n}",["$resource", function($resource){+ return $resource(^{funcall}); }])|]+ }++addRESTRaw :: (Monad m) => Text+ -> ((Route master -> [(Text, Text)] -> Text) -> Javascript)+ -> GAngular master m ()+addRESTRaw n funcall =+ tell mempty+ { awModules = ["ngResource"]+ , awDirectives = [julius|+ .factory("#{rawJS n}",["$resource", function($resource){+ ^{funcall}+ }])|]+ }++addService :: (Monad m) =>+ Text+ -> ((Route master -> [(Text, Text)] -> Text) -> Javascript)+ -> GAngular master m ()+-- ^ adds a service+addService n funcall = addProvide [js|service("#{rawJS n}",^{funcall})|]++addProvide :: (Monad m) => ((Route master -> [(Text, Text)] -> Text) -> Javascript) -> GAngular master m ()+addProvide funcall =+ tell mempty+ { awServices = [julius|+ $provide.^{funcall} ;|]+ }++addConstant :: (Monad m) => Text -> ((Route master -> [(Text, Text)] -> Text) -> Javascript) -> GAngular master m ()+-- ^ add constant, remember to quote if raw text+addConstant n funcall = addProvide [julius|constant("#{rawJS n}",^{funcall})|]++addSetup :: (Monad m) => ((Route master -> [(Text, Text)] -> Text) -> Javascript)+ -> GAngular master m ()+-- ^ inject this code befor calling angular+addSetup funcall =+ tell mempty+ { awSetup = [julius|^{funcall};|]+ }++addCommand :: (FromJSON input, ToJSON output)+ => (input -> HandlerT master IO output)+ -> GAngular master IO Text+-- ^ add a command (which is always printed)+addCommand f = addCommandMaybe (fmap (Just <$>) f)++addCommandMaybe :: (FromJSON input, ToJSON output)+ => (input -> HandlerT master IO (Maybe output))+ -> GAngular master IO Text+addCommandMaybe f = do+ n <- lift newIdent+ tell (mempty :: AngularWriter master IO) { awCommands = Map.singleton n handler }+ return $ "?command=" `mappend` n+ where+ handler = requireJsonBody >>= f >>= \case+ Just output -> do repjson <- returnJson output+ sendResponse repjson+ Nothing -> notFound++addWhen :: ( Monad m+ , MonadThrow m+ , MonadBaseControl IO m+ , MonadIO m+ ) => Text -- ^ one route+ -> Text -- ^ the other one+ -> GAngular master m ()+addWhen fro to = tell mempty {awRoutes = [julius|.when("#{rawJS fro}","#{rawJS to}")|] }++setDefaultRoute :: (Monad m) => Text -> GAngular master m()+setDefaultRoute x = tell mempty { awDefaultRoute = [x] }++addFactoryStore :: (Monad m) => Text -> GAngular master m ()+addFactoryStore n = addFactory (n <> "Store") [julius| function(){+ var lc = {};+ return { update: function (s){ _.extend(lc,s)}+ , full: function (s){ return lc; }+ , set: function (e,v) { lc[e] = v; }+ , get: function (e){ return lc[e]; }+ , has: function (e){ return _.has(lc,e); }+ , getD : function (d, e){ return _.has(lc,e) ? lc[e] : d; }+ , isEmpty : function (){ return _.isEmpty(lc) }+ , clear : function(){lc = {}}+ }+ }+ |]++++url :: Monad m => Text -> WriterT (UiState master) m ()+url u = tell mempty {uisUrl = Just u}++name :: Monad m => Text -> WriterT (UiState master) m ()+name n = tell mempty {uisName = First (Just n)}++nameA :: Monad m => Text -> WriterT (UiState master) m ()+nameA n = tell mempty+ { uisName = First (Just n)+ , uiTC = mempty { tcTempl = TmplInl "<ui-view/>" }+ , uiAbstract = True+ }++addData :: Monad m => JavascriptUrl (Route master) -> WriterT (UiState master) m ()+addData d = tell mempty {uiData = [d]}++emptyFunction :: JavascriptUrl url+emptyFunction = [julius| function(){} |]++tcFile :: Text -> Q Exp+tcFile st =+ [|tell mempty { uisName = First (Just $(liftT st))+ , uiTC = UiTC+ (TmplExt $(autoHamlet st ""))+ (CtrlExt $(fromMaybe [| emptyFunction |] $ autoJulius st ""))+ $(listE $ catMaybes [autoLucius st "", autoCassius st ""])+ }|]+ where+ liftT t = do+ p <- [|T.pack|]+ return $ AppE p $ LitE $ StringL $ T.unpack t++tcVFile :: Text -> Text -> Q Exp+tcVFile st view =+ [|tell mempty+ { uisName = First (Just $(liftT st))+ , uiV = [ ( $(liftT view)+ , UiTC+ (TmplExt $(autoHamlet st view))+ (CtrlExt $(fromMaybe [| emptyFunction |] $ autoJulius st view))+ $(listE $ catMaybes [autoLucius st view, autoCassius st view])+ )+ ]+ }|]+ where+ liftT t = do+ p <- [|T.pack|]+ return $ AppE p $ LitE $ StringL $ T.unpack t++state+ :: ( Monad m+ , MonadThrow m+ , MonadBaseControl IO m+ , MonadIO m+ )+ => GUiState master () -> GAngular master m ()+state sa = do+ let a = execWriter sa+ tell mempty {awUiState = [a]}+ addUIState a++renderTemplate+ :: ( Monad m+ , MonadThrow m+ , MonadBaseControl IO m+ , MonadIO m+ )+ => StateTemplate master -> GAngular master m (Maybe (JavascriptUrl (Route master)))+renderTemplate = \case+ TmplExt t -> do+ n <- lift newIdent+ tell mempty { combined = [ihamlet|<script type="text/ng-template" id="?partial=#{n}">^{t} |]+ }+ return $ Just [js|templateUrl:"?partial=#{rawJS n}"|]+ TmplInl t -> return $ Just [js|template:#{toJSON t}|]+ TmplProvider p -> return $ Just [js|templateProvider:^{p}|]+ TmplNone -> return Nothing++renderControler+ :: ( Monad m+ , MonadThrow m+ , MonadBaseControl IO m+ , MonadIO m+ )+ => StateCtrl master -> GAngular master m (Maybe (JavascriptUrl (Route master)))+renderControler = \case+ CtrlName n -> return $ Just [js|controller:#{rawJS n}|]+ CtrlNameAs a n -> return $ Just [js|controller:#{rawJS n}, controllerAs: "#{rawJS a}"|]+ CtrlExt j -> do+ n <- lift newIdent+ tell mempty { awControllers = [julius|var #{rawJS n} = ^{j};|]}+ return $ Just [js|controller:#{rawJS n}|]+ CtrlExtAs a j -> do+ n <- lift newIdent+ tell mempty { awControllers = [julius|var #{rawJS n} = ^{j};|]}+ return $ Just [js|controller:#{rawJS n}, controllerAs: "#{rawJS a}"|]+ CtrlProvider j -> do+ n <- lift newIdent+ tell mempty { awControllers = [julius|var #{rawJS n} = ^{j};|]}+ return $ Just [js|controllerProvider:#{rawJS n}|]+ CtrlNone -> return Nothing++concatJS :: Monoid m => m -> [Maybe m] -> m+concatJS c (catMaybes -> j:rs) = j <> mconcat (map (c <>) rs)+concatJS _ _ = mempty++addUIState+ :: ( Monad m+ , MonadThrow m+ , MonadBaseControl IO m+ , MonadIO m+ )+ => UiState master -> GAngular master m ()+addUIState UiState{..} = do+ let First (Just name'') = uisName+ let UiTC {..} = uiTC+ let c = [js|,|]++ tplBit <- renderTemplate tcTempl+ ctlBit <- renderControler tcCtrl+ let absBit = if uiAbstract then Just [js|abstract: true|] else Nothing+ let urlBit = (\u -> [js|url:"#{rawJS u}"|]) <$> uisUrl+ let resBit = (\u -> [js|resolve:^{u}|]) <$> uiResolve+ let datBit = if null uiData then Nothing else Just [js|data:{^{concatJS c (map Just uiData)}}|]++ viwBit <- case uiV of+ [] -> return Nothing+ a -> do+ vs <- mapM (\(vi,ct) -> do+ c1 <- renderControler (TS.tcCtrl ct)+ t1 <- renderTemplate (TS.tcTempl ct)+ return $ Just [js| "#{rawJS vi}" : { ^{concatJS c [c1, t1]} } |]+ ) a+ return $ Just [js|views:{ ^{concatJS c vs} }|]++ let stateBody = concatJS c [absBit, urlBit, ctlBit, tplBit, resBit, datBit, viwBit]+ tell mempty+ { awStateName = [name'']+ , awStates = [julius|.state("#{rawJS name''}", { ^{stateBody} })|]+ , awLook = tcCss <> concatMap (TS.tcCss . snd) uiV+ }
+ src/Yesod/AngularUI/Router.hs view
@@ -0,0 +1,77 @@++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# Language LambdaCase #-}+{-# LANGUAGE TemplateHaskell #-}+{-# Language ViewPatterns #-}+{-# Language BangPatterns #-}+{-# Language CPP #-}++module Yesod.AngularUI.Router where++import Data.Text (Text)+import Text.Hamlet+import Text.Julius+import Text.Lucius+import Text.Cassius+import Text.Naked.Coffee+import Text.TypeScript++import Language.Haskell.TH.Lib (ExpQ)+import qualified Data.Text as T+import Data.Either+import Prelude+import Control.Monad++import System.Directory (doesFileExist)+import System.IO.Unsafe (unsafePerformIO)++isRight :: Either a b -> Bool+isRight (Right _) = True+isRight _ = False++whenRight :: (Functor f, Monad f) => Either t t1 -> (t1 -> f a) -> f ()+whenRight (Right a) b = void $ b a+whenRight _ _ = return ()++fnCreate :: Text -> Text -> Text -> String+fnCreate (T.null -> True) (T.replace "@" "AT" -> nam) suffix = T.unpack $ T.concat ["angular/", nam , ".", suffix]+fnCreate parent (T.unpack -> "") suffix = T.unpack $ T.concat ["angular/", T.replace "." "/" parent, ".", suffix]+fnCreate parent (T.replace "@" "AT" -> nam) suffix = T.unpack $ T.concat ["angular/", T.replace "." "/" parent, ".", nam, ".", suffix]+++autoMaybe :: (String -> ExpQ) -> Text -> Text -> Text -> Maybe ExpQ+autoMaybe ex ext state view =+ let fn = fnCreate state view ext+ in+ if unsafePerformIO $ doesFileExist fn+ then Just [| $(ex fn) |]+ else Nothing+{-# NOINLINE autoMaybe #-}++autoHamlet :: Text -> Text -> ExpQ+autoHamlet state view = do+ let fn = fnCreate state view "hamlet"+#if DEVELOPMENT+ let !boo = unsafePerformIO $ print fn+#endif+ if unsafePerformIO $ doesFileExist fn+ then [| $(ihamletFile fn) |]+ else [| [ihamlet| <!-- #{fn} --> |] |]+{-# NOINLINE autoHamlet #-}++autoJulius :: Text -> Text -> Maybe ExpQ+autoJulius = autoMaybe juliusFile "julius"++autoCassius :: Text -> Text -> Maybe ExpQ+autoCassius = autoMaybe cassiusFile "cassius"++autoLucius :: Text -> Text -> Maybe ExpQ+autoLucius = autoMaybe luciusFile "lucius"++autoCoffee :: Text -> Text -> Maybe ExpQ+autoCoffee = autoMaybe ncoffeeFile "coffee"++autoTypeScript :: Text -> Text -> Maybe ExpQ+autoTypeScript = autoMaybe typeScriptFile "tsc"
+ src/Yesod/AngularUI/Types.hs view
@@ -0,0 +1,139 @@++{-# Language OverloadedStrings+ , QuasiQuotes+ , LambdaCase+ , FlexibleContexts+ , FlexibleInstances+ , MultiParamTypeClasses+ , UndecidableInstances+ , ScopedTypeVariables+ , RankNTypes+ , TypeFamilies+ #-}++module Yesod.AngularUI.Types where+import Control.Monad.Trans.Writer (Writer, WriterT)+import Data.Map.Strict (Map)+import Data.Monoid (First (..), Monoid (..))+import Data.Text (Text)+import Text.Hamlet+import Text.Julius+import Text.Lucius+import Yesod.Core (Route, Yesod)+import Yesod.Core.Widget+import Yesod.Core.Types+import Data.Either+import Prelude hiding (head, init, last, readFile, tail, writeFile)+import Text.Shakespeare.I18N+import Data.List++class (Yesod master) => YesodAngular master where+ urlAngularJs :: [master -> Either (Route master) Text]+ urlAngularJs = []-- > add bower packages+ angularUIEntry :: WidgetT master IO ()+ angularUIEntry = [whamlet|<div data-ui-view>|]+ wrapAngularUI :: Text -> WidgetT master IO ()+ wrapAngularUI modname = [whamlet|ng-app="#{modname}"|]+++data AngularWriter master m = AngularWriter+ { awCommands :: Map Text (HandlerT master m ())+ , awRoutes :: JavascriptUrl (Route master)+ , awControllers :: JavascriptUrl (Route master)+ , awServices :: JavascriptUrl (Route master)+ , awDirectives :: JavascriptUrl (Route master)+ , awConfigs :: JavascriptUrl (Route master)+ , awSetup :: JavascriptUrl (Route master)+ , awModules :: [Text]+ , awDefaultRoute :: [Text]+ , awLook :: [CssUrl (Route master)]+ , awStates :: JavascriptUrl (Route master)+ -- Template cache+ , combined :: HtmlUrlI18n (SomeMessage master) (Route master)+ -- , bower packages+ , awBower :: [Text]+ , awStateName :: [Text]+ , awUiState :: [UiState master]+ }++instance Monoid (AngularWriter master m) where+ mempty = AngularWriter mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty+ (AngularWriter a1 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16)+ `mappend` (AngularWriter b1 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16)+ = AngularWriter+ (mappend a1 b1)+ (mappend a3 b3)+ (mappend a4 b4)+ (mappend a5 b5)+ (mappend a6 b6)+ (mappend a7 b7)+ (mappend a8 b8)+ (nub $ sort $ mappend a9 b9) -- modules+ (mappend a10 b10)+ (mappend a11 b11)+ (mappend a12 b12)+ (mappend a13 b13)+ (mappend a14 b14)+ (mappend a15 b15)+ (mappend a16 b16)++data UiState master = UiState+ { uisName :: First Text+ , uisUrl :: Maybe Text+ , uiTC :: UiTC master+ , uiV :: [(Text, UiTC master)]+ , uiAbstract :: Bool+ , uiResolve :: Maybe (JavascriptUrl (Route master))+ , uiData :: [ JavascriptUrl (Route master) ]+ }++data StateTemplate master+ = TmplNone+ | TmplInl Text+ | TmplExt (HtmlUrlI18n (SomeMessage master) (Route master))+ | TmplProvider (JavascriptUrl (Route master))++instance Monoid (StateTemplate master) where+ mempty = TmplNone+ TmplNone `mappend` a = a+ a `mappend` _ = a++data StateCtrl master+ = CtrlNone+ | CtrlName Text+ | CtrlNameAs Text Text+ | CtrlExt (JavascriptUrl (Route master))+ | CtrlExtAs Text (JavascriptUrl (Route master))+ | CtrlProvider (JavascriptUrl (Route master))++instance Monoid (StateCtrl master) where+ mempty = CtrlNone+ CtrlNone `mappend` a = a+ a `mappend` _ = a++data UiTC master = UiTC+ { tcTempl :: StateTemplate master+ , tcCtrl :: StateCtrl master+ , tcCss :: [CssUrl (Route master)]+ }++instance Monoid (UiState master) where+ mempty = UiState mempty mempty mempty mempty False mempty mempty+ (UiState a1 a2 a3 a4 a5 a6 a7) `mappend` (UiState b1 b2 b3 b4 b5 b6 b7) = UiState+ (mappend a1 b1)+ (mappend a2 b2)+ (mappend a3 b3)+ (mappend a4 b4)+ (a5 || b5)+ (mappend a6 b6)+ (mappend a7 b7)++instance Monoid (UiTC maste) where+ mempty = UiTC mempty mempty mempty+ (UiTC a0 a1 a2) `mappend` (UiTC b0 b1 b2) = UiTC+ (mappend a0 b0)+ (mappend a1 b1)+ (mappend a2 b2)++type GAngular master m = WriterT (AngularWriter master m) (HandlerT master m)+type GUiState master = Writer (UiState master)
+ yesod-angular-ui.cabal view
@@ -0,0 +1,47 @@+name: yesod-angular-ui+version: 0.1.0.0+synopsis: Angular Helpers+description: Library for developing i18n webapps with yesod and angular.+homepage: https://github.com/tolysz/yesod-angular-ui+bug-reports: https://github.com/tolysz/yesod-angular-ui/issues+license: BSD3+license-file: LICENSE+author: Marcin Tolysz+maintainer: tolysz@gmail.com+copyright: Copyright (c) 2014, Marcin Tolysz All rights reserved.+ Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/+ Copyright 2010, Michael Snoyman. All rights reserved.+category: Web+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10+library+ exposed-modules: Yesod.AngularUI+ , Yesod.AngularUI.Router+ , Yesod.AngularUI.Types+ , Text.Naked.Coffee+ ghc-options: -Wall+ -- other-modules: + -- other-extensions: + build-depends: base >=4.7 && <4.9+ , text+ , template-haskell+ , transformers+ , mtl+ , shakespeare+ , directory+ , yesod+ , yesod-core+ , containers+ , resourcet+ , blaze-html+ , hjsmin++ hs-source-dirs: src+ default-language: Haskell2010+ default-extensions: TemplateHaskell+ QuasiQuotes++source-repository head+ type: git+ location: git://github.com/tolysz/yesod-angular-ui.git