shakespeare-js-1.1.0/0000755000000000000000000000000012051365556012614 5ustar0000000000000000shakespeare-js-1.1.0/Setup.lhs0000644000000000000000000000021712051365556014424 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > import System.Cmd (system) > main :: IO () > main = defaultMain shakespeare-js-1.1.0/test.hs0000644000000000000000000000012512051365556014125 0ustar0000000000000000import Test.Hspec import ShakespeareJsTest (specs) main :: IO () main = hspec specs shakespeare-js-1.1.0/shakespeare-js.cabal0000644000000000000000000000547112051365556016514 0ustar0000000000000000name: shakespeare-js version: 1.1.0 license: MIT license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman synopsis: Stick your haskell variables into javascript/coffeescript at compile time. description: Shakespeare is a template family for type-safe, efficient templates with simple variable interpolation . Shakespeare templates can be used inline with a quasi-quoter or in an external file. Shakespeare interpolates variables according to the type being inserted. In this case, the variable type needs a ToJavascript instance. . There is also shakespeare-coffeescript for coffeescript templates. Coffescript is a language that compiles down to javascript. It expects a coffeescript compiler in your path, and variable should be a ToCoffee instance. And we even have a Roy template for the adventorous FP addicts. . Please see http://www.yesodweb.com/book/shakespearean-templates for a more thorough description and examples . shakespeare-js was originally called julius, and shakespeare originated from the hamlet template package. extra-source-files: test/juliuses/external1.coffee test/juliuses/external1.julius test/juliuses/external2.julius test/ShakespeareJsTest.hs test.hs category: Web, Yesod stability: Stable cabal-version: >= 1.8 build-type: Simple homepage: http://www.yesodweb.com/book/shakespearean-templates library build-depends: base >= 4 && < 5 , shakespeare >= 1.0.2 && < 1.1 , template-haskell , text >= 0.7 , aeson >= 0.5 exposed-modules: Text.Julius Text.Coffee Text.Roy ghc-options: -Wall if impl(ghc >= 7.4) cpp-options: -DGHC_7_4 if flag(test_coffee) cpp-options: -DTEST_COFFEE if flag(test_export) cpp-options: -DTEST_EXPORT flag test_export default: False flag test_coffee description: render tests through coffeescript render function -- cabal configure --enable-tests -ftest_coffee && cabal build && dist/build/test/test default: False test-suite test hs-source-dirs: test main-is: ../test.hs other-modules: Quoter type: exitcode-stdio-1.0 ghc-options: -Wall build-depends: shakespeare-js , shakespeare , base , HUnit , hspec >= 1.3 , text , template-haskell , aeson -- cabal bug -- if flag(test_coffee) -- cpp-options: -DTEST_COFFEE source-repository head type: git location: git://github.com/yesodweb/shakespeare.git shakespeare-js-1.1.0/LICENSE0000644000000000000000000000207512051365556013625 0ustar0000000000000000Copyright (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. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. shakespeare-js-1.1.0/Text/0000755000000000000000000000000012051365556013540 5ustar0000000000000000shakespeare-js-1.1.0/Text/Coffee.hs0000644000000000000000000000633112051365556015266 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# 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 @%{...}@. -- -- Further reading: -- -- 1. Shakespearean templates: -- -- 2. CoffeeScript: module Text.Coffee ( -- * Functions -- ** Template-Reading Functions -- | These QuasiQuoter and Template Haskell methods return values of -- type @'JavascriptUrl' url@. See the Yesod book for details. coffee , coffeeFile , coffeeFileReload , coffeeFileDebug #ifdef TEST_EXPORT , coffeeSettings #endif ) where import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH.Syntax import Text.Shakespeare import Text.Julius -- | The Coffeescript language compiles down to Javascript. -- We do this compilation once at compile time to avoid needing to do it during the request. -- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request rather than a system call. -- During the pre-conversion we first modify all Haskell insertions -- so that they will be ignored by the Coffeescript compiler (backticks). -- So %{var} is change to `%{var}` using the preEscapeBegin and preEscapeEnd. -- preEscapeIgnore is used to not insert backtacks for variable already inside strings or backticks. -- coffeescript will happily ignore the interpolations, and backticks would not be treated as escaping in that context. coffeeSettings :: Q ShakespeareSettings coffeeSettings = do jsettings <- javascriptSettings return $ jsettings { varChar = '%' , preConversion = Just PreConvert { preConvert = ReadProcess "coffee" ["-sp"] , preEscapeBegin = "`" , preEscapeEnd = "`" , preEscapeIgnoreBalanced = "'\"`" , preEscapeIgnoreLine = "#" } } -- | Read inline, quasiquoted CoffeeScript. coffee :: QuasiQuoter coffee = 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. coffeeFile :: FilePath -> Q Exp coffeeFile 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. coffeeFileReload :: FilePath -> Q Exp coffeeFileReload fp = do rs <- coffeeSettings shakespeareFileReload rs fp -- | Deprecated synonym for 'coffeeFileReload' coffeeFileDebug :: FilePath -> Q Exp coffeeFileDebug = coffeeFileReload {-# DEPRECATED coffeeFileDebug "Please use coffeeFileReload instead." #-} shakespeare-js-1.1.0/Text/Roy.hs0000644000000000000000000000542412051365556014652 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} -- | A Shakespearean module for Roy, 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 @roy@. -- -- To use this module, @roy@ must be installed on your system. -- -- @#{...}@ is the Shakespearean standard for variable interpolation, but -- CoffeeScript already uses that sequence for string interpolation. -- Therefore, it seems more future-proof to use @%{...}@ for interpolation -- -- Integration with Roy is a bit rough right now. -- You can only perorm a shakespeare insertion inside a Roy string. -- This should work well for urls and strings. -- Otherwise you should stick your Haskell into Julius as a window variable, -- and then retrieve it in your Roy code. -- -- Further reading: -- -- 1. Shakespearean templates: -- -- 2. Roy: module Text.Roy ( -- * Functions -- ** Template-Reading Functions -- | These QuasiQuoter and Template Haskell methods return values of -- type @'JavascriptUrl' url@. See the Yesod book for details. roy , royFile , royFileReload #ifdef TEST_EXPORT , roySettings #endif ) where import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH.Syntax import Text.Shakespeare import Text.Julius -- | The Roy language compiles down to Javascript. -- We do this compilation once at compile time to avoid needing to do it during the request. -- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call. roySettings :: Q ShakespeareSettings roySettings = do jsettings <- javascriptSettings return $ jsettings { varChar = '%' , preConversion = Just PreConvert { preConvert = ReadProcess "roy" ["--stdio"] , preEscapeBegin = "`" , preEscapeEnd = "`" , preEscapeIgnoreBalanced = "'\"`" , preEscapeIgnoreLine = "//" } } -- | Read inline, quasiquoted Roy. roy :: QuasiQuoter roy = QuasiQuoter { quoteExp = \s -> do rs <- roySettings quoteExp (shakespeare rs) s } -- | Read in a Roy template file. This function reads the file once, at -- compile time. royFile :: FilePath -> Q Exp royFile fp = do rs <- roySettings shakespeareFile rs fp -- | Read in a Roy template file. This impure function uses -- unsafePerformIO to re-read the file on every call, allowing for rapid -- iteration. royFileReload :: FilePath -> Q Exp royFileReload fp = do rs <- roySettings shakespeareFileReload rs fp shakespeare-js-1.1.0/Text/Julius.hs0000644000000000000000000001123712051365556015353 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} -- | A Shakespearean module for Javascript templates, introducing type-safe, -- compile-time variable and url interpolation.-- -- To use this module, @coffee@ must be installed on your system. -- -- You might consider trying 'Text.Coffee', which compiles down to Javascript. -- -- Further reading: module Text.Julius ( -- * Functions -- ** Template-Reading Functions -- | These QuasiQuoter and Template Haskell methods return values of -- type @'JavascriptUrl' url@. See the Yesod book for details. js , julius , juliusFile , jsFile , juliusFileDebug , jsFileDebug , juliusFileReload , jsFileReload -- * Datatypes , JavascriptUrl , Javascript (..) , RawJavascript (..) -- * Typeclass for interpolated variables , ToJavascript (..) , RawJS (..) -- ** Rendering Functions , renderJavascript , renderJavascriptUrl -- ** internal, used by 'Text.Coffee' , javascriptSettings -- ** internal , juliusUsedIdentifiers ) where import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH.Syntax import Data.Text.Lazy.Builder (Builder, fromText, toLazyText, fromLazyText) import Data.Monoid import qualified Data.Text as TS import qualified Data.Text.Lazy as TL import Text.Shakespeare import Data.Aeson (Value) import Data.Aeson.Encode (fromValue) renderJavascript :: Javascript -> TL.Text renderJavascript (Javascript b) = toLazyText b -- | render with route interpolation. If using this module standalone, apart -- from type-safe routes, a dummy renderer can be used: -- -- > renderJavascriptUrl (\_ _ -> undefined) javascriptUrl -- -- When using Yesod, a renderer is generated for you, which can be accessed -- within the GHandler monad: 'Yesod.Handler.getUrlRenderParams'. renderJavascriptUrl :: (url -> [(TS.Text, TS.Text)] -> TS.Text) -> JavascriptUrl url -> TL.Text renderJavascriptUrl r s = renderJavascript $ s r -- | Newtype wrapper of 'Builder'. newtype Javascript = Javascript { unJavascript :: Builder } deriving Monoid -- | Return type of template-reading functions. type JavascriptUrl url = (url -> [(TS.Text, TS.Text)] -> TS.Text) -> Javascript asJavascriptUrl :: JavascriptUrl url -> JavascriptUrl url asJavascriptUrl = id -- | A typeclass for types that can be interpolated in CoffeeScript templates. class ToJavascript a where toJavascript :: a -> Builder #if 0 instance ToJavascript [Char] where toJavascript = fromLazyText . TL.pack instance ToJavascript TS.Text where toJavascript = fromText instance ToJavascript TL.Text where toJavascript = fromLazyText instance ToJavascript Javascript where toJavascript = unJavascript instance ToJavascript Builder where toJavascript = id #endif instance ToJavascript Value where toJavascript = fromValue newtype RawJavascript = RawJavascript Builder instance ToJavascript RawJavascript where toJavascript (RawJavascript a) = a class RawJS a where rawJS :: a -> RawJavascript instance RawJS [Char] where rawJS = RawJavascript . fromLazyText . TL.pack instance RawJS TS.Text where rawJS = RawJavascript . fromText instance RawJS TL.Text where rawJS = RawJavascript . fromLazyText instance RawJS Builder where rawJS = RawJavascript javascriptSettings :: Q ShakespeareSettings javascriptSettings = do toJExp <- [|toJavascript|] wrapExp <- [|Javascript|] unWrapExp <- [|unJavascript|] asJavascriptUrl' <- [|asJavascriptUrl|] return $ defaultShakespeareSettings { toBuilder = toJExp , wrap = wrapExp , unwrap = unWrapExp , modifyFinalValue = Just asJavascriptUrl' } js, julius :: QuasiQuoter js = QuasiQuoter { quoteExp = \s -> do rs <- javascriptSettings quoteExp (shakespeare rs) s } julius = js jsFile, juliusFile :: FilePath -> Q Exp jsFile fp = do rs <- javascriptSettings shakespeareFile rs fp juliusFile = jsFile jsFileReload, juliusFileReload :: FilePath -> Q Exp jsFileReload fp = do rs <- javascriptSettings shakespeareFileReload rs fp juliusFileReload = jsFileReload jsFileDebug, juliusFileDebug :: FilePath -> Q Exp juliusFileDebug = jsFileReload {-# DEPRECATED juliusFileDebug "Please use juliusFileReload instead." #-} jsFileDebug = jsFileReload {-# DEPRECATED jsFileDebug "Please use jsFileReload instead." #-} -- | Determine which identifiers are used by the given template, useful for -- creating systems like yesod devel. juliusUsedIdentifiers :: String -> [(Deref, VarType)] juliusUsedIdentifiers = shakespeareUsedIdentifiers defaultShakespeareSettings shakespeare-js-1.1.0/test/0000755000000000000000000000000012051365556013573 5ustar0000000000000000shakespeare-js-1.1.0/test/Quoter.hs0000644000000000000000000000151612051365556015411 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} module Quoter (quote, quoteFile, quoteFileReload) where import Language.Haskell.TH.Syntax import Language.Haskell.TH.Quote (QuasiQuoter (..)) #ifdef TEST_COFFEE import Text.Coffee import Text.Coffee (coffeeSettings) import Text.Shakespeare (shakespeare) #else import Text.Julius #endif quote :: QuasiQuoter quoteFile :: FilePath -> Q Exp quoteFileReload :: FilePath -> Q Exp #ifdef TEST_COFFEE translate ('#':'{':rest) = translate $ '%':'{':translate rest translate (c:other) = c:translate other translate [] = [] quote = QuasiQuoter { quoteExp = \s -> do rs <- coffeeSettings quoteExp (shakespeare rs) (translate s) } quoteFile = coffeeFile quoteFileReload = coffeeFileReload #else quote = julius quoteFile = juliusFile quoteFileReload = juliusFileReload #endif shakespeare-js-1.1.0/test/ShakespeareJsTest.hs0000644000000000000000000001057312051365556017525 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} module ShakespeareJsTest (specs) where import Test.HUnit hiding (Test) import Test.Hspec import Prelude hiding (reverse) #ifdef TEST_COFFEE import Text.Coffee #endif import Text.Julius import Quoter (quote, quoteFile, quoteFileReload) import Data.List (intercalate) import qualified Data.Text.Lazy as T import qualified Data.List import qualified Data.List as L import Data.Text (Text, pack, unpack) import Data.Monoid (mappend) import Data.Aeson (toJSON) join :: [String] -> String #ifdef TEST_COFFEE join l = (intercalate ";\n" l) #else join = intercalate "\n" #endif specs :: Spec specs = describe "shakespeare-js" $ do it "julius" $ do let var = "x=2" let urlp = (Home, [(pack "p", pack "q")]) flip jelper [quote|['שלום', @{Home}, #{rawJS var}, '@?{urlp}', ^{jmixin} ]|] $ intercalate " " [ "['שלום'," , "url, " ++ var ++ "," , "'url?p=q'," , "f(2) ]" ] it "juliusFile" $ do let var = "x=2" let urlp = (Home, [(pack "p", pack "q")]) flip jelper $(quoteFile "test/juliuses/external1.julius") $ join [ "שלום" , var , "url" , "url?p=q" , "f(2)" ] ++ "\n" it "juliusFileReload" $ do let var = "x=2" let urlp = (Home, [(pack "p", pack "q")]) flip jelper $(quoteFileReload "test/juliuses/external1.julius") $ join [ "שלום" , var , "url" , "url?p=q" , "f(2)" ] ++ "\n" {- TODO it "juliusFileDebugChange" $ do let var = "somevar" test result = jelper result $(juliusFileDebug "test/juliuses/external2.julius") writeFile "test/juliuses/external2.julius" "var #{var} = 1;" test "var somevar = 1;" writeFile "test/juliuses/external2.julius" "var #{var} = 2;" test "var somevar = 2;" writeFile "test/juliuses/external2.julius" "var #{var} = 1;" -} it "julius module names" $ let foo = "foo" double = 3.14 :: Double int = -5 :: Int in jelper "[oof, oof, 3.14, -5]" #ifdef TEST_COFFEE [quote|[%{Data.List.reverse foo}, %{L.reverse foo}, %{show double}, %{show int}]|] #else [quote|[#{rawJS $ Data.List.reverse foo}, #{rawJS $ L.reverse foo}, #{rawJS $ show double}, #{rawJS $ show int}]|] #endif -- not valid coffeescript #ifndef TEST_COFFEE it "single dollar at and caret" $ do jelper "$@^" [quote|$@^|] jelper "#{@{^{" [quote|#\{@\{^\{|] #endif it "dollar operator" $ do let val = (1 :: Int, (2 :: Int, 3 :: Int)) jelper "2" [quote|#{ rawJS $ show $ fst $ snd val }|] jelper "2" [quote|#{ rawJS $ show $ fst $ snd $ val}|] it "empty file" $ jelper "" [quote||] it "JSON data" $ jelper "\"Hello \\\"World!\\\"\"" [julius|#{toJSON "Hello \"World!\""}|] data Url = Home | Sub SubUrl data SubUrl = SubUrl render :: Url -> [(Text, Text)] -> Text render Home qs = pack "url" `mappend` showParams qs render (Sub SubUrl) qs = pack "suburl" `mappend` showParams qs showParams :: [(Text, Text)] -> Text showParams [] = pack "" showParams z = pack $ '?' : intercalate "&" (map go z) where go (x, y) = go' x ++ '=' : go' y go' = concatMap encodeUrlChar . unpack -- | Taken straight from web-encodings; reimplemented here to avoid extra -- dependencies. encodeUrlChar :: Char -> String encodeUrlChar c -- List of unreserved characters per RFC 3986 -- Gleaned from http://en.wikipedia.org/wiki/Percent-encoding | 'A' <= c && c <= 'Z' = [c] | 'a' <= c && c <= 'z' = [c] | '0' <= c && c <= '9' = [c] encodeUrlChar c@'-' = [c] encodeUrlChar c@'_' = [c] encodeUrlChar c@'.' = [c] encodeUrlChar c@'~' = [c] encodeUrlChar ' ' = "+" encodeUrlChar y = let (a, c) = fromEnum y `divMod` 16 b = a `mod` 16 showHex' x | x < 10 = toEnum $ x + (fromEnum '0') | x < 16 = toEnum $ x - 10 + (fromEnum 'A') | otherwise = error $ "Invalid argument to showHex: " ++ show x in ['%', showHex' b, showHex' c] jmixin :: JavascriptUrl u jmixin = [quote|f(2)|] jelper :: String -> JavascriptUrl Url -> Assertion jelper res h = do T.pack res @=? renderJavascriptUrl render h instance Show Url where show _ = "FIXME remove this instance show Url" shakespeare-js-1.1.0/test/juliuses/0000755000000000000000000000000012051365556015436 5ustar0000000000000000shakespeare-js-1.1.0/test/juliuses/external1.julius0000644000000000000000000000006112051365556020573 0ustar0000000000000000שלום #{rawJS var} @{Home} @?{urlp} ^{jmixin} shakespeare-js-1.1.0/test/juliuses/external1.coffee0000644000000000000000000000006312051365556020511 0ustar0000000000000000'שלום' %{var} '@{Home}' '@?{urlp}' ^{cofmixin} shakespeare-js-1.1.0/test/juliuses/external2.julius0000644000000000000000000000001712051365556020575 0ustar0000000000000000var #{var} = 2;