packages feed

hako (empty) → 0.2.0

raw patch · 7 files changed

+416/−0 lines, 7 filesdep +QuickCheckdep +basedep +hakosetup-changed

Dependencies added: QuickCheck, base, hako, haskell-src-meta, parsec, template-haskell

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Tobias Dammers++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 Tobias Dammers 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
+ Text/Hako.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE QuasiQuotes #-}+-- | A simplist template language using a quasi-quoting approach.+-- Hako quasi-quote expressions return a 'Html', which can+-- be converted back to a 'String' using 'fromHtml'.+-- Basic syntax rules:+-- * Text is kept as-is, without any encoding performed.+--+-- >>> [hako|<p>foobar</p>|]+-- Html "<p>foobar</p>"+--+-- * Curly braces designate Haskell expressions, which must return an instance+--   of typeclass 'ToHtml'; the 'toHtml' method is called automatically.+--+-- >>> [hako|This is {"<a>quoted</a>"}|]+-- Html "This is &lt;a&gt;quoted&lt;/a&gt;"+--+-- * If the opening curly brace is immediately followed by the keyword def,+--   then the expression is interpreted as a definition instead; it works +--   pretty much exactly like a function or constant definition in plain old+--   Haskell, and the definition thus created can be called as a function from+--   anywhere within the template.+--+-- >>> [hako|{def a x =<a>{x}</a>}Here's a {a "link"}.|]+-- Html "Here's a <a>link</a>."+--+-- * A @def@ block can be used before it is defined.+--+-- >>> [hako|Here's a {a "link"}.{def a x =<a>{x}</a>]|]+-- Html "Here's a <a>link</a>."+--+-- * As is to be expected from a quasi-quoter, the current scope is carried+--   into the template.+--+-- >>> let txt = "Hello, world!" in [hako|<div>{txt}</div>|]+-- Html "<div>Hello, world!</div>"+--+-- * Since @{}@ expressions can contain any valid Haskell expression (as long+--   as its type implements 'ToHtml'), you can use any Haskell function that is+--   currently in scope.+--+-- >>> [hako|{def li x=<li>x</li>}<ul>{map li [1,2,3]}</ul>|]+-- Html "<ul><li>1</li><li>2</li><li>3</li></ul>"+module Text.Hako+( hako+, hakof+, HH.Html (..)+) where++import Text.Hako.Parsing+import Text.Hako.Html+import qualified Text.Hako.Html as HH+import Language.Haskell.TH+import Language.Haskell.TH.Quote++hako :: QuasiQuoter+hako = QuasiQuoter { quoteExp = parseTemplateFromString+                   , quotePat = error "Hako does not implement pattern quoting"+                   , quoteType = error "Hako does not implement type quoting"+                   , quoteDec = error "Hako does not implement dec quoting"+                   }++hakof = quoteFile hako
+ Text/Hako/Html.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances #-}+-- | Implements HTML-encoding for Hako.+-- The 'Html' type and the 'ToHtml' typeclass together take care of +-- html-encoding appropriately and automatically inside Hako templates.+module Text.Hako.Html+( htmlEncode+, Html (..)+, ToHtml+, toHtml+, fromHtml+, (<++>)+) where++-- | Basic HTML-encoding: converts all special HTML characters into the+-- corresponding entities.+htmlEncode :: String -> Html+htmlEncode =+    Html . (foldl (++) []) . (map encodeChar)+    where encodeChar c =+            case c of+                '&' -> "&amp;"+                '<' -> "&lt;"+                '>' -> "&gt;"+                '"' -> "&quot;"+                '\'' -> "&apos;"+                otherwise -> [c]++-- | All expressions interpolated into Hako templates using @{}@ syntax+-- must satisfy 'ToHtml'. Any member of 'Show' automatically has a default+-- implementation through 'show'; additionally, suitable implementations+-- are provided for 'String' (skipping the quoting and escaping which 'show' +-- would otherwise introduce), as well as 'List's, 'Maybe's and 'Either's of +-- 'ToHtmls'.+class ToHtml a where+    toHtml :: a -> Html++-- | A piece of HTML source. Use 'fromHtml' to get the HTML source back out.+data Html = Html String+    deriving (Show, Eq)++-- | Get HTML source as String+fromHtml :: Html -> String+fromHtml (Html a) = a++-- | 'Html' itself is also a member of 'ToHtml'; converting from 'Html' to +-- 'Html' is an identity.+instance ToHtml Html where+    toHtml = id++-- | Strings have their own instance of 'ToHtml', which performs HTML-encoding+-- but skips the call to 'show' which would otherwise introduce undesirable+-- quotes and escaping.+instance ToHtml [Char] where+    toHtml = htmlEncode++-- | Implement an instance for 'Maybe', so that 'Nothing' is leniently +-- converted to an empty string, and 'Just's are unpacked.+instance ToHtml a => ToHtml (Maybe a) where+    toHtml (Just a) = toHtml a+    toHtml Nothing = Html ""++-- | 'Either' should work also, as long as both branches are 'ToHtml'+-- themselves.+instance (ToHtml a, ToHtml b) => ToHtml (Either a b) where+    toHtml (Left a) = toHtml a+    toHtml (Right a) = toHtml a++-- | Lists are automatically folded using straightforward concatenation.+instance ToHtml a => ToHtml [a] where+    toHtml [] = Html ""+    toHtml xs = foldl1 (<++>) $ map toHtml xs++-- | All other types in 'Show' default to HTML-encoding their 'show'+-- representation.+instance Show a => ToHtml a where+    toHtml = htmlEncode . show++-- | Concatenate two 'Html's together.+-- The 'Html' equivalent to list concatenation (@++@)+(<++>) :: Html -> Html -> Html+(Html a) <++> (Html b) = Html (a ++ b)
+ Text/Hako/Parsing.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE TemplateHaskell, FlexibleContexts #-}+module Text.Hako.Parsing+( parseTemplateFromString+) where++import Text.Parsec+import Language.Haskell.TH+import Language.Haskell.Meta.Parse+import Text.Parsec.String+import Text.Hako.Html++-- | Hako's main parser, suitable as a quoteExpr.+parseTemplateFromString :: String -> ExpQ+parseTemplateFromString s = either (error . show) return $ parse template [] s++data Template = Template [Dec] [Exp]++tjoin :: Template -> Template -> Template+tjoin (Template dl el) (Template dr er) =+    Template (dl ++ dr) (el ++ er)++tpack :: Template -> Exp+tpack (Template defs exps) =+    let body = if null exps+                then emptyLiteralExp+                else foldl1 expJoin exps+    in if null defs+        then body+        else LetE defs body++template :: Stream s m Char => ParsecT s u m Exp+template = do+    tfs <- many templateFragment+    return $ tpack $ foldl1 tjoin tfs++templateFragment :: Stream s m Char => ParsecT s u m Template+templateFragment = try templateDefFragment+                 <|> templateExpFragment+                 <|> templateLitFragment+                 <?> "template fragment"++templateDefFragment :: Stream s m Char => ParsecT s u m Template+templateDefFragment = do+    defs <- blockDef+    return $ Template defs []++templateExpFragment :: Stream s m Char => ParsecT s u m Template+templateExpFragment = do+    exp <- haskellExpr+    return $ Template [] [exp]++templateLitFragment :: Stream s m Char => ParsecT s u m Template+templateLitFragment = do+    exp <- literalText+    return $ Template [] [exp]++emptyLiteralExp :: Exp+emptyLiteralExp = AppE (ConE . mkName $ "Html") $ LitE $ StringL ""++expJoin :: Exp -> Exp -> Exp+expJoin a b = AppE (AppE (VarE . mkName $ "<++>") a) b++expWrap :: Exp -> Exp+expWrap a = AppE (VarE . mkName $ "toHtml") a++blockDef :: Stream s m Char => ParsecT s u m [Dec]+blockDef = do+    string "{def"+    space+    leader <- manyTill anyChar $ char '=' +    inner <- template+    string "}"+    let decs = parseDecs $ leader ++ " = " ++ pprint inner+    case decs of+        Right d -> return d+        Left err -> error err++literalText :: Stream s m Char => ParsecT s u m Exp+literalText = do+    str <- many1 $ noneOf "{}"+    return $ AppE (ConE . mkName $ "Html") $ LitE $ StringL str++haskellExpr :: Stream s m Char => ParsecT s u m Exp+haskellExpr = do+    e <- haskellExpr'+    return $ expWrap e++haskellExpr' :: Stream s m Char => ParsecT s u m Exp+haskellExpr' = do+    _ <- char '{'+    src <- haskellText+    _ <- char '}'+    either fail return $ parseExp src++haskellText :: Stream s m Char => ParsecT s u m String+haskellText = do+    parts <- many1 haskellPart+    return $ concat parts++bracedText :: Stream s m Char => ParsecT s u m String+bracedText = do+    char '{'+    inner <- haskellText+    char '}'+    return $ "{" ++ inner ++ "}"++haskellPart :: Stream s m Char => ParsecT s u m String+haskellPart = quotedChar+            <|> quotedEscapedChar+            <|> quotedString+            <|> bracedText+            <|> haskellOther++haskellOther :: Stream s m Char => ParsecT s u m String+haskellOther = many1 $ noneOf "\"'{}"++quotedChar :: Stream s m Char => ParsecT s u m String+quotedChar = do+    char '\''+    c <- noneOf "\\"+    char '\''+    return ['\'', c, '\'']++quotedEscapedChar :: Stream s m Char => ParsecT s u m String+quotedEscapedChar = do+    char '\''+    char '\\'+    c <- anyChar+    char '\''+    return ['\'', '\\', c, '\'']++quotedString :: Stream s m Char => ParsecT s u m String+quotedString = do+    char '"'+    strs <- many quotedStringPart+    char '"'+    let str = concat strs+    return $ "\"" ++ str ++ "\""+    where quotedStringPart = singleChar <|> escapedChar+          singleChar = do { c <- noneOf "\"\\"; return [c] }+          escapedChar = do { char '\\'; c <- anyChar; return ['\\',c] }
+ hako.cabal view
@@ -0,0 +1,78 @@+-- hako.cabal auto-generated by cabal init. For additional options,+-- see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                hako++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.2.0++-- A short (one-line) description of the package.+Synopsis:            A mako-like quasi-quoter template library++-- A longer description of the package.+Description:      A quasi-quote based HTML template library with a simplistic+                  approach, Hako borrows its philosophy from Mako, a popular+				  Python template library. The idea is that the template +				  mechanism itself should be kept simple, while exposing the+				  full expressivity of Haskell itself inside the templates.+				  +				  At the same time, any value interpolated into a template gets+				  HTML-encoded by default, but you can override this behavior+				  by providing your own instances of the 'ToHtml' typeclass.++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Tobias Dammers++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          tdammers@gmail.com++-- A copyright notice.+-- Copyright:           ++Category:            Text++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.8++Extra-source-files:+    tests/Test.hs++Library+  -- Modules exported by the library.+  Exposed-modules:     Text.Hako, Text.Hako.Parsing, Text.Hako.Html+  +  -- Packages needed in order to build this package.+  Build-depends:       parsec >= 3.0 && < 4.0+               ,       base >= 3.0 && < 5.0+               ,       template-haskell >= 2.5 && < 3.0+               ,       haskell-src-meta >= 0.5 && < 0.6+  +  -- Modules not exported by this package.+  -- Other-modules:       +  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:         +  +Test-suite tests+    Type:             exitcode-stdio-1.0+    Hs-source-dirs:   tests+    Main-is:          Test.hs+    Build-depends:    base+                 ,    hako+                 ,    QuickCheck
+ tests/Test.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE QuasiQuotes #-}++import Test.QuickCheck+import Test.QuickCheck.All+import Text.Hako+import Text.Hako.Html++prop_textOnly = [hako|asdf|] == Html "asdf"+prop_htmlEntities = [hako|<>&"'"|] == Html "&lt;&gt;&amp;&quot;&apo;&quot;"+prop_htmlEntitiesSane s =+    let r = [hako|{s}|]+        isSpecialChar c = c `elem` "<>'\""+    in not . any isSpecialChar $ fromHtml r+prop_stringInterpolation s = [hako|{Html s}|] == Html s+prop_let s = [hako|{def x ={Html s}}{s}|] == Html s++main = do+        quickCheck prop_textOnly+        quickCheck prop_htmlEntities+        quickCheck (prop_stringInterpolation :: String -> Bool)+        quickCheck (prop_htmlEntitiesSane :: String -> Bool)+        quickCheck (prop_let :: String -> Bool)