hamlet 0.4.2 → 0.5.0

raw patch · 9 files changed

+1186/−161 lines, 9 filesdep +blaze-builderdep +neitherdep −blaze-htmlPVP ok

version bump matches the API change (PVP)

Dependencies added: blaze-builder, neither

Dependencies removed: blaze-html

API changes (from Hackage documentation)

Files

• Text/Cassius.hs +403/−0
• Text/Hamlet.hs +26/−9
• Text/Hamlet/Debug.hs +139/−0
• Text/Hamlet/Parse.hs +8/−2
• Text/Hamlet/Quasi.hs +48/−70
• Text/Hamlet/RT.hs +68/−49
• Text/Julius.hs +223/−0
• hamlet.cabal +6/−2
• runtests.hs +265/−29

@@ -0,0 +1,403 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+module Text.Cassius+    ( Cassius+    , Css (..)+    , renderCassius+    , CassiusMixin+    , cassiusMixin+    , cassius+    , Color (..)+    , colorRed+    , colorBlack+    , cassiusFile+    , cassiusFileDebug+    ) where++import Text.ParserCombinators.Parsec hiding (Line)+import Data.Neither (AEither (..), either)+import Data.Traversable (sequenceA)+import Control.Applicative ((<$>))+import Data.List (intercalate)+import Data.Char (isUpper, isDigit)+import Language.Haskell.TH.Quote (QuasiQuoter (..))+import Language.Haskell.TH.Syntax+import Text.Blaze.Builder.Core (Builder, fromByteString, toLazyByteString)+import Text.Blaze.Builder.Utf8 (fromString)+import Data.Maybe (catMaybes)+import Prelude hiding (either)+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.UTF8 as BSU+import qualified Data.ByteString.Lazy as L+import Data.Monoid+import Data.Word (Word8)+import Data.Bits+import System.IO.Unsafe (unsafePerformIO)++data Color = Color Word8 Word8 Word8+    deriving Show+instance ToCss Color where+    toCss (Color r g b) =+        let (r1, r2) = toHex r+            (g1, g2) = toHex g+            (b1, b2) = toHex b+         in '#' :+            if r1 == r2 && g1 == g2 && b1 == b2+                then [r1, g1, b1]+                else [r1, r2, g1, g2, b1, b2]+      where+        toHex :: Word8 -> (Char, Char)+        toHex x = (toChar $ shiftR x 4, toChar $ x .&. 15)+        toChar :: Word8 -> Char+        toChar c+            | c < 10 = mkChar c 0 '0'+            | otherwise = mkChar c 10 'A'+        mkChar :: Word8 -> Word8 -> Char -> Char+        mkChar a b' c =+            toEnum $ fromIntegral $ a - b' + fromIntegral (fromEnum c)++colorRed :: Color+colorRed = Color 255 0 0++colorBlack :: Color+colorBlack = Color 0 0 0++renderCss :: Css -> L.ByteString+renderCss (Css b) = toLazyByteString b++renderCassius :: (url -> [(String, String)] -> String) -> Cassius url -> L.ByteString+renderCassius r s = renderCss $ s r++newtype Css = Css Builder+    deriving Monoid+type Cassius url = (url -> [(String, String)] -> String) -> Css++class ToCss a where+    toCss :: a -> String+instance ToCss [Char] where toCss = id++data ContentPair = CPSimple Contents Contents+                 | CPMixin Deref+    deriving Show+contentPairToContents :: ContentPair -> Contents+contentPairToContents (CPSimple x y) = concat [x, ContentRaw ":" : y]+contentPairToContents (CPMixin deref) = [ContentMix deref]++data FlatDec = FlatDec Contents [ContentPair]+    deriving Show++data Deref = DerefLeaf String+           | DerefBranch Deref Deref+    deriving (Show, Eq)++instance Lift Deref where+    lift (DerefLeaf s) = do+        dl <- [|DerefLeaf|]+        return $ dl `AppE` (LitE $ StringL s)+    lift (DerefBranch x y) = do+        x' <- lift x+        y' <- lift y+        db <- [|DerefBranch|]+        return $ db `AppE` x' `AppE` y'++data Content = ContentRaw String+             | ContentVar Deref+             | ContentUrl Deref+             | ContentUrlParam Deref+             | ContentMix Deref+    deriving Show+type Contents = [Content]++data DecS = Attrib Contents Contents+          | Block Contents [DecS]+          | MixinDec Deref+    deriving Show++data Line = LinePair Contents Contents+          | LineSingle Contents+          | LineMix Deref+    deriving Show++data Nest = Nest Line [Nest]+    deriving Show++parseLines :: Parser [(Int, Line)]+parseLines = fmap (catMaybes)+           $ many (parseEmptyLine <|> try parseComment <|> parseLine)++eol :: Parser ()+eol =+    (char '\n' >> return ()) <|> (string "\r\n" >> return ())++parseEmptyLine :: Parser (Maybe (Int, Line))+parseEmptyLine = eol >> return Nothing++parseComment :: Parser (Maybe (Int, Line))+parseComment = do+    _ <- many $ oneOf " \t"+    _ <- string "$#"+    _ <- many $ noneOf "\r\n"+    eol <|> return ()+    return Nothing++parseLine :: Parser (Maybe (Int, Line))+parseLine = do+    ss <- fmap sum $ many ((char ' ' >> return 1) <|>+                           (char '\t' >> return 4))+    x <- parseLineMix <|> do+            key' <- many1 $ parseContent False+            let key = trim key'+            parsePair key <|> return (LineSingle key)+    eol <|> eof+    return $ Just (ss, x)+  where+    parseLineMix = do+        _ <- char '^'+        d <- parseDeref+        _ <- char '^'+        return $ LineMix d+    parsePair key = do+        _ <- try $ string ": "+        _ <- spaces+        val <- many1 $ parseContent True+        return $ LinePair key $ trim val+    --trim = reverse . dropWhile isSpace . reverse+    trim = id -- FIXME++parseContent :: Bool -> Parser Content+parseContent allowColon = do+    (char '$' >> (parseDollar <|> parseVar)) <|>+      (char '@' >> (parseAt <|> parseUrl)) <|> safeColon <|> do+        s <- many1 $ noneOf $ (if allowColon then id else (:) ':') "\r\n$@"+        return $ ContentRaw s+  where+    safeColon = try $ do+        _ <- char ':'+        notFollowedBy $ oneOf " \t"+        return $ ContentRaw ":"+    parseAt = char '@' >> return (ContentRaw "@")+    parseUrl = do+        c <- (char '?' >> return ContentUrlParam) <|> return ContentUrl+        d <- parseDeref+        _ <- char '@'+        return $ c d+    parseDollar = char '$' >> return (ContentRaw "$")+    parseVar = do+        d <- parseDeref+        _ <- char '$'+        return $ ContentVar d++parseDeref :: Parser Deref+parseDeref =+    deref+  where+    derefParens = between (char '(') (char ')') deref+    derefSingle = derefParens <|> fmap DerefLeaf ident+    deref = do+        let delim = (char '.' <|> (many1 (char ' ') >> return ' '))+        x <- derefSingle+        xs <- many $ delim >> derefSingle+        return $ foldr1 DerefBranch $ x : xs+    ident = many1 (alphaNum <|> char '_' <|> char '\'')++nestLines :: [(Int, Line)] -> [Nest]+nestLines [] = []+nestLines ((i, l):rest) =+    let (deeper, rest') = span (\(i', _) -> i' > i) rest+     in Nest l (nestLines deeper) : nestLines rest'++nestToDec :: Bool -> Nest -> AEither [String] DecS+nestToDec _ (Nest LineMix{} (_:_)) =+    ALeft ["Mixins may not have nested content"]+nestToDec True (Nest LineMix{} []) =+    ALeft ["Cannot have LineMix at top level"]+nestToDec False (Nest (LineMix deref) []) =+    ARight $ MixinDec deref+nestToDec _ (Nest LinePair{} (_:_)) =+    ALeft ["Only LineSingle may have nested content"]+nestToDec _ (Nest LineSingle{} []) =+    ALeft ["A LineSingle must have nested content"]+nestToDec True (Nest LinePair{} _) =+    ALeft ["Cannot have a LinePair at top level"]+nestToDec _ (Nest (LineSingle name) nests) =+    Block name <$> sequenceA (map (nestToDec False) nests)+nestToDec _ (Nest (LinePair key val) []) = ARight $ Attrib key val++flatDec :: DecS -> [FlatDec]+flatDec Attrib{} = error "flatDec Attrib"+flatDec MixinDec{} = error "flatDec MixinDec"+flatDec (Block name decs) =+    let as = concatMap getAttrib decs+        bs = concatMap getBlock decs+        a = case as of+                [] -> id+                _ -> (:) (FlatDec name as)+        b = concatMap flatDec bs+     in a b+  where+    getAttrib (Attrib x y) = [CPSimple x y]+    getAttrib (MixinDec d) = [CPMixin d]+    getAttrib Block{} = []+    getBlock (Block n d) = [Block (concat [name, ContentRaw " " : n]) d]+    getBlock _ = []++render :: FlatDec -> Contents+render (FlatDec n pairs) =+    let inner = intercalate [ContentRaw ";"]+              $ map contentPairToContents pairs+     in concat [n, [ContentRaw "{"], inner, [ContentRaw "}"]]++compressContents :: Contents -> Contents+compressContents [] = []+compressContents (ContentRaw x:ContentRaw y:z) =+    compressContents $ ContentRaw (x ++ y) : z+compressContents (x:y) = x : compressContents y++contentsToCassius :: [Content] -> Q Exp+contentsToCassius a = do+    r <- newName "_render"+    c <- mapM (contentToCss r) $ compressContents a+    d <- case c of+            [] -> [|mempty|]+            [x] -> return x+            _ -> do+                mc <- [|mconcat|]+                return $ mc `AppE` ListE c+    return $ LamE [VarP r] d++cassiusMixin :: QuasiQuoter+cassiusMixin =+    QuasiQuoter e p+  where+    p = error "cassiusMixin quasi-quoter for patterns does not exist"+    e s = do+        let a = either (error . show) id+              $ parse parseLines s s+        let b = flip map a $ \(_, l) ->+                    case l of+                        LinePair x y -> CPSimple x y+                        LineMix deref -> CPMixin deref+                        LineSingle _ -> error "Mixins cannot contain singles"+        d <- contentsToCassius+           $ intercalate [ContentRaw ";"]+           $ map contentPairToContents b+        sm <- [|CassiusMixin|]+        return $ sm `AppE` d++newtype CassiusMixin url = CassiusMixin { unCassiusMixin :: Cassius url }++cassius :: QuasiQuoter+cassius =+    QuasiQuoter cassiusFromString p+  where+    p = error "cassius quasi-quoter for patterns does not exist"++cassiusFromString :: String -> Q Exp+cassiusFromString s = do+    let a = either (error . show) id $ parse parseLines s s+    let b = either (error . unlines) id+          $ sequenceA $ map (nestToDec True) $ nestLines a+    contentsToCassius $ concatMap render $ concatMap flatDec b++contentToCss :: Name -> Content -> Q Exp+contentToCss _ (ContentRaw s') = do+    let d = S8.unpack $ BSU.fromString s'+    ts <- [|Css . fromByteString . S8.pack|]+    return $ ts `AppE` LitE (StringL d)+contentToCss _ (ContentVar d) = do+    ts <- [|Css . fromString . toCss|]+    return $ ts `AppE` derefToExp d+contentToCss r (ContentUrl d) = do+    ts <- [|Css . fromString|]+    return $ ts `AppE` (VarE r `AppE` derefToExp d `AppE` ListE [])+contentToCss r (ContentUrlParam d) = do+    ts <- [|Css . fromString|]+    up <- [|\r' (u, p) -> r' u p|]+    return $ ts `AppE` (up `AppE` VarE r `AppE` derefToExp d)+contentToCss r (ContentMix d) = do+    un <- [|unCassiusMixin|]+    return $ un `AppE` derefToExp d `AppE` VarE r++derefToExp :: Deref -> Exp+derefToExp (DerefBranch x y) =+    let x' = derefToExp x+        y' = derefToExp y+     in x' `AppE` y'+derefToExp (DerefLeaf "") = error "Illegal empty ident"+derefToExp (DerefLeaf v@(s:_))+    | all isDigit v = LitE $ IntegerL $ read v+    | isUpper s = ConE $ mkName v+    | otherwise = VarE $ mkName v++cassiusFile :: FilePath -> Q Exp+cassiusFile fp = do+    contents <- fmap BSU.toString $ qRunIO $ S8.readFile fp+    cassiusFromString contents++data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin++getVars :: Line -> [(Deref, VarType)]+getVars (LinePair x y) = concatMap getVars' $ x ++ y+getVars (LineSingle x) = concatMap getVars' x+getVars (LineMix x) = [(x, VTMixin)]++getVars' :: Content -> [(Deref, VarType)]+getVars' ContentRaw{} = []+getVars' (ContentVar d) = [(d, VTPlain)]+getVars' (ContentUrl d) = [(d, VTUrl)]+getVars' (ContentUrlParam d) = [(d, VTUrlParam)]+getVars' (ContentMix d) = [(d, VTMixin)]++data CDData url = CDPlain String+                | CDUrl url+                | CDUrlParam (url, [(String, String)])+                | CDMixin (CassiusMixin url)++vtToExp :: (Deref, VarType) -> Q Exp+vtToExp (d, vt) = do+    d' <- lift d+    c' <- c vt+    return $ TupE [d', c' `AppE` derefToExp d]+  where+    c VTPlain = [|CDPlain . toCss|]+    c VTUrl = [|CDUrl|]+    c VTUrlParam = [|CDUrlParam|]+    c VTMixin = [|CDMixin|]++cassiusFileDebug :: FilePath -> Q Exp+cassiusFileDebug fp = do+    s <- fmap BSU.toString $ qRunIO $ S8.readFile fp+    let a = either (error . show) id $ parse parseLines s s+        b = concatMap (getVars . snd) a+    c <- mapM vtToExp b+    cr <- [|cassiusRuntime|]+    return $ cr `AppE` (LitE $ StringL fp) `AppE` ListE c++cassiusRuntime :: FilePath -> [(Deref, CDData url)] -> Cassius url+cassiusRuntime fp cd render' = unsafePerformIO $ do+    s <- fmap BSU.toString $ qRunIO $ S8.readFile fp+    let a = either (error . show) id $ parse parseLines s s+    let b = either (error . unlines) id+          $ sequenceA $ map (nestToDec True) $ nestLines a+    return $ mconcat $ map go $ concatMap render $ concatMap flatDec b+  where+    go :: Content -> Css+    go (ContentRaw s) = Css $ fromString s+    go (ContentVar d) =+        case lookup d cd of+            Just (CDPlain s) -> Css $ fromString s+            _ -> error $ show d ++ ": expected CDPlain"+    go (ContentUrl d) =+        case lookup d cd of+            Just (CDUrl u) -> Css $ fromString $ render' u []+            _ -> error $ show d ++ ": expected CDUrl"+    go (ContentUrlParam d) =+        case lookup d cd of+            Just (CDUrlParam (u, p)) ->+                Css $ fromString $ render' u p+            _ -> error $ show d ++ ": expected CDUrlParam"+    go (ContentMix d) =+        case lookup d cd of+            Just (CDMixin (CassiusMixin m)) -> m render'+            _ -> error $ show d ++ ": expected CDMixin"

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module Text.Hamlet     ( -- * Basic quasiquoters       hamlet@@ -8,6 +9,7 @@       -- * Load from external file     , hamletFile     , xhamletFile+    , hamletFileDebug       -- * Customized settings     , hamletWithSettings     , hamletFileWithSettings@@ -15,8 +17,10 @@     , defaultHamletSettings     , xhtmlHamletSettings       -- * Datatypes-    , Html+    , Html (..)     , Hamlet+      -- * Typeclass+    , ToHtml (..)       -- * Construction/rendering     , renderHamlet     , renderHtml@@ -35,22 +39,35 @@ import Text.Hamlet.Parse import Text.Hamlet.Quasi import Text.Hamlet.RT-import Text.Blaze+import Text.Hamlet.Debug+import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.Monoid (mappend)---- | An function generating an 'Html' given a URL-rendering function.-type Hamlet url = (url -> String) -> Html ()+import Text.Blaze.Builder.Core (toLazyByteString, fromByteString)+import Text.Blaze.Builder.Html (fromHtmlEscapedString)+import Text.Blaze.Builder.Utf8 (fromString)  -- | Converts a 'Hamlet' to lazy bytestring.-renderHamlet :: (url -> String) -> Hamlet url -> L.ByteString+renderHamlet :: (url -> [(String, String)] -> String) -> Hamlet url -> L.ByteString renderHamlet render h = renderHtml $ h render +renderHtml :: Html -> L.ByteString+renderHtml (Html h) = toLazyByteString h+ -- | Wrap an 'Html' for embedding in an XML file.-cdata :: Html () -> Html ()+cdata :: Html -> Html cdata h =-    preEscapedString "<![CDATA["+    Html (fromByteString "<![CDATA[")     `mappend`     h     `mappend`-    preEscapedString "]]>"+    Html (fromByteString "]]>")++preEscapedString :: String -> Html+preEscapedString = Html . fromString++string :: String -> Html+string = Html . fromHtmlEscapedString++unsafeByteString :: S.ByteString -> Html+unsafeByteString = Html . fromByteString

@@ -0,0 +1,139 @@+{-# LANGUAGE TemplateHaskell #-}+module Text.Hamlet.Debug+    ( hamletFileDebug+    ) where++import Text.Hamlet.Parse+import Text.Hamlet.Quasi+import Text.Hamlet.RT+import Language.Haskell.TH.Syntax+import qualified Data.ByteString.Char8 as S8+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.ByteString.UTF8 as BSU+import Control.Arrow+import Data.Either+import Control.Monad (forM)++unsafeRenderTemplate :: FilePath -> HamletMap url+                     -> (url -> [(String, String)] -> String) -> Html+unsafeRenderTemplate fp hd render = unsafePerformIO $ do+    contents <- fmap BSU.toString $ S8.readFile fp+    temp <- parseHamletRT defaultHamletSettings contents+    renderHamletRT' True temp hd render++hamletFileDebug :: FilePath -> Q Exp+hamletFileDebug fp = do+    contents <- fmap BSU.toString $ qRunIO $ S8.readFile fp+    HamletRT docs <- qRunIO $ parseHamletRT defaultHamletSettings contents+    urt <- [|unsafeRenderTemplate|]+    render <- newName "render"+    let hd = combineDVals $ concatMap getHD docs+    hd' <- liftDVals (VarE render) hd+    let h = urt `AppE` LitE (StringL fp) `AppE` hd' `AppE` VarE render+    return $ LamE [VarP render] h++derefToExp :: [Exp] -> Exp+derefToExp = foldr1 AppE . reverse++type DVal = ([Exp], DVal')+data DVal' = DHtml+           | DUrl+           | DUrlParam+           | DTemplate+           | DBool+           | DMaybe [([String], DVal)]+           | DList [([String], DVal)]+    deriving (Show, Eq)++liftDVals :: Exp -> [([String], DVal)] -> Q Exp+liftDVals render pairs = do+    pairs' <- forM pairs $ \(k, d) -> do+        let k' = ListE $ map (LitE . StringL) k+        d' <- liftDVal render d+        return $ TupE [k', d']+    return $ ListE pairs'++liftDVal :: Exp -> DVal -> Q Exp+liftDVal _ (x, DHtml) = do+    f <- [|HDHtml . toHtml|]+    return $ f `AppE` derefToExp x+liftDVal _ (x, DUrl) = do+    f <- [|HDUrl|]+    return $ f `AppE` derefToExp x+liftDVal _ (x, DUrlParam) = do+    f <- [|uncurry HDUrlParams|]+    return $ f `AppE` derefToExp x+liftDVal render (x, DTemplate) = do+    f <- [|HDHtml|]+    return $ f `AppE` (derefToExp x `AppE` render)+liftDVal _ (x, DBool) = do+    f <- [|HDBool|]+    return $ f `AppE` derefToExp x+liftDVal render (x, DMaybe each) = do+    var <- newName "_var"+    each' <- liftDVals render $ map (second $ replaceFirst $ VarE var) each+    let each'' = LamE [VarP var] each'+    hdlist <- [|HDMaybe|]+    map' <- [|fmap|]+    return $ hdlist `AppE` (map' `AppE` each'' `AppE` derefToExp x)+liftDVal render (x, DList each) = do+    var <- newName "_var"+    each' <- liftDVals render $ map (second $ replaceFirst $ VarE var) each+    let each'' = LamE [VarP var] each'+    hdlist <- [|HDList|]+    map' <- [|map|]+    return $ hdlist `AppE` (map' `AppE` each'' `AppE` derefToExp x)++combineDVals :: [([String], DVal)] -> [([String], DVal)]+combineDVals [] = []+combineDVals ((x1, y1):rest) =+    case matches of+        [] -> (x1, y1) : combineDVals rest+        ys -> (x1, foldr combine' y1 ys) : combineDVals nomatch+  where+    matches = map snd $ filter (\(x, _) -> x == x1) rest+    nomatch = filter (\(x, _) -> x /= x1) rest+    combine' (a, x) (b, y)+        | a == b = (a, combine x y)+        | otherwise = error $ "Bad parameters to combine': " ++ show ((a, x), (b, y))+    combine (DList x) (DList y) = DList $ combineDVals $ x ++ y+    combine (DMaybe x) (DMaybe y) = DMaybe $ combineDVals $ x ++ y+    combine x y+        | x == y = x+    combine x y = error $ "Bad parameters to combine: " ++ show (x, y)++varNames :: [String] -> [Exp]+varNames = map $ varName []+getHD :: SimpleDoc -> [([String], DVal)]+getHD SDRaw{} = []+getHD (SDVar x) = [(x, (varNames x, DHtml))]+getHD (SDUrl hasParams x) =+    [(x, (varNames x, if hasParams then DUrlParam else DUrl))]+getHD (SDTemplate x) = [(x, (varNames x, DTemplate))]+getHD (SDCond xs edocs) =+    let hd = concatMap getHD $ edocs ++ concatMap snd xs+        bools = map (\(x, _) -> (x, (varNames x, DBool))) xs+     in hd ++ bools+getHD (SDMaybe x y docs ndocs) =+    (x, (varNames x, DMaybe subs)) : tops ++ ntops+  where+    hd = concatMap getHD docs+    (tops, subs) = partitionEithers $ map go hd+    ntops = concatMap getHD ndocs+    go (a@(y':rest), e)+        | y == y' = Right (rest, e)+        | otherwise = Left (a, e)+    go ([], _) = error "getHD of SDMaybe"+getHD (SDForall x y docs) =+     (x, (varNames x, DList subs)) : tops+  where+    hd = concatMap getHD docs+    (tops, subs) = partitionEithers $ map go hd+    go (a@(y':rest), e)+        | y == y' = Right (rest, e)+        | otherwise = Left (a, e)+    go ([], _) = error "getHD of SDForall"++replaceFirst :: Exp -> DVal -> DVal+replaceFirst x (_:y, z) = (x:y, z)+replaceFirst _ _ = error "replaceFirst on something empty"

@@ -71,6 +71,7 @@     ss <- fmap sum $ many ((char ' ' >> return 1) <|>                            (char '\t' >> return 4))     x <- doctype <|>+         comment <|>          backslash <|>          try controlIf <|>          try controlElseIf <|>@@ -90,8 +91,13 @@     eol' = (char '\n' >> return ()) <|> (string "\r\n" >> return ())     eol = eof <|> eol'     doctype = do-        string "!!!" >> eol+        try $ string "!!!" >> eol         return $ LineContent [ContentRaw $ hamletDoctype set ++ "\n"]+    comment = do+        _ <- try $ string "$#"+        _ <- many $ noneOf "\r\n"+        eol+        return $ LineContent []     backslash = do         _ <- char '\\'         (eol >> return (LineContent [ContentRaw "\n"]))@@ -125,7 +131,7 @@         eol         return $ LineForall x y     tag = do-        x <- tagName <|> tagIdent <|> tagClass+        x <- tagName <|> tagIdent <|> tagClass <|> tagAttrib         xs <- many $ tagIdent <|> tagClass <|> tagAttrib         c <- (eol >> return []) <|> (do             _ <- many1 $ oneOf " \t"

@@ -1,6 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Text.Hamlet.Quasi     ( hamlet     , xhamlet@@ -12,25 +13,34 @@     , hamletFile     , xhamletFile     , hamletFileWithSettings-    , showParams+    , ToHtml (..)+    , varName+    , Html (..)+    , Hamlet     ) where  import Text.Hamlet.Parse import Language.Haskell.TH.Syntax import Language.Haskell.TH.Quote-import Data.Char (isUpper)+import Data.Char (isUpper, isDigit) import qualified Data.ByteString.UTF8 as BSU+import qualified Data.ByteString.Lazy.UTF8 as BSLU import qualified Data.ByteString.Char8 as S8-import Data.Monoid (mconcat, mappend, mempty)-import Text.Blaze (unsafeByteString, Html, string)-import Data.List (intercalate)+import Data.Monoid (Monoid (..))+import Text.Blaze.Builder.Core (Builder, fromByteString, toLazyByteString)+import Text.Blaze.Builder.Html (fromHtmlEscapedString)+import Data.Maybe (fromMaybe)+import Data.String +instance IsString Html where+    fromString = Html . fromHtmlEscapedString+ class ToHtml a where-    toHtml :: a -> Html ()+    toHtml :: a -> Html instance ToHtml String where-    toHtml = string-instance ToHtml (Html a) where-    toHtml x = x >> return ()+    toHtml = Html . fromHtmlEscapedString+instance ToHtml Html where+    toHtml = id  type Scope = [(Ident, Exp)] @@ -38,16 +48,13 @@ docsToExp render scope docs = do     exps <- mapM (docToExp render scope) docs     me <- [|mempty|]+    ma <- [|mappend|]+    let ma' x y = InfixE (Just x) ma $ Just y     return $         case exps of             [] -> me             [x] -> x-            _ ->-                let x = init exps-                    y = last exps-                    x' = map (BindS WildP) x-                    y' = NoBindS y-                 in DoE $ x' ++ [y']+            _ -> foldr1 ma' exps  docToExp :: Exp -> Scope -> Doc -> Q Exp docToExp render scope (DocForall list ident@(Ident name) inside) = do@@ -92,14 +99,16 @@  contentToExp :: Exp -> Scope -> Content -> Q Exp contentToExp _ _ (ContentRaw s) = do-    os <- [|unsafeByteString . S8.pack|]+    os <- [|Html . fromByteString . S8.pack|]     let s' = LitE $ StringL $ S8.unpack $ BSU.fromString s     return $ os `AppE` s' contentToExp _ scope (ContentVar d) = do     str <- [|toHtml|]     return $ str `AppE` deref scope d contentToExp render scope (ContentUrl hasParams d) = do-    ou <- if hasParams then [|outputUrlParams|] else [|outputUrl|]+    ou <- if hasParams+            then [|\r (u, p) -> Html $ fromHtmlEscapedString $ r u p|]+            else [|\r u -> Html $ fromHtmlEscapedString $ r u []|]     let d' = deref scope d     return $ ou `AppE` render `AppE` d' contentToExp render scope (ContentEmbed d) = do@@ -176,23 +185,25 @@      in x' `AppE` y' deref scope (DerefLeaf d@(Ident dName)) =     case lookup d scope of-        Nothing -> varName dName+        Nothing -> varName scope dName         Just exp' -> exp'-  where-    varName "" = error "Illegal empty varName"-    varName v@(s:_) =-        case lookup (Ident v) scope of-            Just e -> e-            Nothing ->-                if isUpper s-                    then ConE $ mkName v-                    else VarE $ mkName v +varName :: Scope -> String -> Exp+varName _ "" = error "Illegal empty varName"+varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope++strToExp :: String -> Exp+strToExp s@(c:_)+    | all isDigit s = LitE $ IntegerL $ read s+    | isUpper c = ConE $ mkName s+    | otherwise = VarE $ mkName s+strToExp "" = error "strToExp on empty string"+ -- | Checks for truth in the left value in each pair in the first argument. If -- a true exists, then the corresponding right action is performed. Only the -- first is performed. In there are no true values, then the second argument is -- performed, if supplied.-condH :: [(Bool, Html ())] -> Maybe (Html ()) -> Html ()+condH :: [(Bool, Html)] -> Maybe Html -> Html condH [] Nothing = mempty condH [] (Just x) = x condH ((True, y):_) _ = y@@ -200,50 +211,17 @@  -- | Runs the second argument with the value in the first, if available. -- Otherwise, runs the third argument, if available.-maybeH :: Maybe v -> (v -> Html ()) -> Maybe (Html ()) -> Html ()+maybeH :: Maybe v -> (v -> Html) -> Maybe Html -> Html maybeH Nothing _ Nothing = mempty maybeH Nothing _ (Just x) = x maybeH (Just v) f _ = f v --- | Uses the URL rendering function to convert the given URL to a 'String' and--- then calls 'outputString'.-outputUrl :: (url -> String) -> url -> Html ()-outputUrl render u = string $ render u---- | Same as 'outputUrl', but appends a query-string with given keys and--- values.-outputUrlParams :: (url -> String) -> (url, [(String, String)]) -> Html ()-outputUrlParams render (u, []) = outputUrl render u-outputUrlParams render (u, params) = mappend-    (outputUrl render u)-    (string $ showParams params)--showParams :: [(String, String)] -> String-showParams z =-    '?' : intercalate "&" (map go z)-  where-    go (x, y) = go' x ++ '=' : go' y-    go' = concatMap encodeUrlChar+newtype Html = Html Builder+    deriving Monoid+instance Show Html where+    show (Html b) = show $ BSLU.toString $ toLazyByteString b+instance Eq Html where+    (Html a) == (Html b) = toLazyByteString a == toLazyByteString b --- | 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]+-- | An function generating an 'Html' given a URL-rendering function.+type Hamlet url = (url -> [(String, String)] -> String) -> Html

@@ -6,9 +6,11 @@     ( -- * Public API       HamletRT (..)     , HamletData (..)+    , HamletMap     , HamletException (..)     , parseHamletRT     , renderHamletRT+    , renderHamletRT'     , SimpleDoc (..)     ) where @@ -17,20 +19,22 @@ import Control.Exception (Exception) import Data.Typeable (Typeable) import Control.Failure-import Text.Blaze import Text.Hamlet.Parse-import Text.Hamlet.Quasi (showParams)+import Text.Hamlet.Quasi (Html (..)) import Data.List (intercalate)+import Text.Blaze.Builder.Utf8 (fromString) -data HamletData url = HDHtml (Html ())-                    | HDUrl url-                    | HDUrlParams url [(String, String)]-                    | HDTemplate HamletRT-                    | HDBool Bool-                    | HDMaybe (Maybe (HamletData url))-                    | HDList [HamletData url]-                    | HDMap [(String, HamletData url)]+type HamletMap url = [([String], HamletData url)] +data HamletData url+    = HDHtml Html+    | HDUrl url+    | HDUrlParams url [(String, String)]+    | HDTemplate HamletRT+    | HDBool Bool+    | HDMaybe (Maybe (HamletMap url))+    | HDList [HamletMap url]+ data SimpleDoc = SDRaw String                | SDVar [String]                | SDUrl Bool [String]@@ -85,67 +89,82 @@     flattenDeref _ (DerefLeaf (Ident x)) = return [x]     flattenDeref orig (DerefBranch (DerefLeaf (Ident x)) y) = do         y' <- flattenDeref orig y-        return $ x : y'+        return $ y' ++ [x]     flattenDeref orig _ = failure $ HamletUnsupportedDocException orig  renderHamletRT :: Failure HamletException m                => HamletRT-               -> HamletData url-               -> (url -> String)-               -> m (Html ())-renderHamletRT (HamletRT docs) (HDMap scope0) renderUrl =+               -> HamletMap url+               -> (url -> [(String, String)] -> String)+               -> m Html+renderHamletRT = renderHamletRT' False++renderHamletRT' :: Failure HamletException m+                => Bool+                -> HamletRT+                -> HamletMap url+                -> (url -> [(String, String)] -> String)+                -> m Html+renderHamletRT' tempAsHtml (HamletRT docs) scope0 renderUrl =     liftM mconcat $ mapM (go scope0) docs   where-    go _ (SDRaw s) = return $ preEscapedString s+    go _ (SDRaw s) = return $ Html $ fromString s     go scope (SDVar n) = do-        v <- lookup' n n $ HDMap scope+        v <- lookup' n n scope         case v of             HDHtml h -> return h-            _ -> fa $ intercalate "." n ++ ": expected HDHtml"+            _ -> fa $ showName n ++ ": expected HDHtml"     go scope (SDUrl p n) = do-        v <- lookup' n n $ HDMap scope+        v <- lookup' n n scope         case (p, v) of-            (False, HDUrl u) -> return $ preEscapedString $ renderUrl u+            (False, HDUrl u) -> return $ Html $ fromString $ renderUrl u []             (True, HDUrlParams u q) ->-                return $ preEscapedString $ renderUrl u ++ showParams q-            (False, _) -> fa $ intercalate "." n ++ ": expected HDUrl"-            (True, _) -> fa $ intercalate "." n ++ ": expected HDUrlParams"+                return $ Html $ fromString $ renderUrl u q+            (False, _) -> fa $ showName n ++ ": expected HDUrl"+            (True, _) -> fa $ showName n ++ ": expected HDUrlParams"     go scope (SDTemplate n) = do-        v <- lookup' n n $ HDMap scope-        case v of-            HDTemplate h -> renderHamletRT h (HDMap scope) renderUrl-            _ -> fa $ intercalate "." n ++ ": expected HDTemplate"+        v <- lookup' n n scope+        case (tempAsHtml, v) of+            (False, HDTemplate h) -> renderHamletRT' tempAsHtml h scope renderUrl+            (False, _) -> fa $ showName n ++ ": expected HDTemplate"+            (True, HDHtml h) -> return h+            (True, _) -> fa $ showName n ++ ": expected HDHtml"     go scope (SDForall n ident docs') = do-        v <- lookup' n n $ HDMap scope+        v <- lookup' n n scope         case v of-            HDList os -> do+            HDList os ->                 liftM mconcat $ forM os $ \o -> do-                    let scope' = HDMap $ (ident, o) : scope-                    renderHamletRT (HamletRT docs') scope' renderUrl-            _ -> fa $ intercalate "." n ++ ": expected HDList"+                    let scope' = map (\(x, y) -> (ident : x, y)) o ++ scope+                    renderHamletRT' tempAsHtml (HamletRT docs') scope' renderUrl+            _ -> fa $ showName n ++ ": expected HDList"     go scope (SDMaybe n ident jdocs ndocs) = do-        v <- lookup' n n $ HDMap scope+        v <- lookup' n n scope         (scope', docs') <-             case v of                 HDMaybe Nothing -> return (scope, ndocs)-                HDMaybe (Just o) -> return ((ident, o) : scope, jdocs)-                _ -> fa $ intercalate "." n ++ ": expected HDMaybe"-        renderHamletRT (HamletRT docs') (HDMap scope') renderUrl+                HDMaybe (Just o) -> do+                    let scope' = map (\(x, y) -> (ident : x, y)) o ++ scope+                    return (scope', jdocs)+                _ -> fa $ showName n ++ ": expected HDMaybe"+        renderHamletRT' tempAsHtml (HamletRT docs') scope' renderUrl     go scope (SDCond [] docs') =-        renderHamletRT (HamletRT docs') (HDMap scope) renderUrl+        renderHamletRT' tempAsHtml (HamletRT docs') scope renderUrl     go scope (SDCond ((b, docs'):cs) els) = do-        v <- lookup' b b $ HDMap scope+        v <- lookup' b b scope         case v of             HDBool True ->-                renderHamletRT (HamletRT docs') (HDMap scope) renderUrl+                renderHamletRT' tempAsHtml (HamletRT docs') scope renderUrl             HDBool False -> go scope (SDCond cs els)-            _ -> fa $ intercalate "." b ++ ": expected HDBool"-    lookup' _ [] x = return x-    lookup' orig (n:ns) (HDMap m) =-        case lookup n m of-            Nothing -> fa $ intercalate "." orig ++ " not found"-            Just o -> lookup' orig ns o-    lookup' orig _ _ = fa $ intercalate "." orig ++ ": unexpected type"-    fa = failure . HamletRenderException-renderHamletRT _ _ _ =-    failure $ HamletRenderException "renderHamletRT must be given a HDMap"+            _ -> fa $ showName b ++ ": expected HDBool"+    lookup' :: Failure HamletException m+            => [String] -> [String] -> HamletMap url -> m (HamletData url)+    lookup' orig k m =+        case lookup k m of+            Nothing -> fa $ showName orig ++ ": not found"+            Just x -> return x++fa :: Failure HamletException m => String -> m a+fa = failure . HamletRenderException++showName :: [String] -> String+showName = intercalate "." . reverse

@@ -0,0 +1,223 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+module Text.Julius+    ( Julius+    , Javascript (..)+    , renderJulius+    , julius+    , juliusFile+    , juliusFileDebug+    ) where++import Text.ParserCombinators.Parsec hiding (Line)+import Data.Char (isUpper, isDigit)+import Language.Haskell.TH.Quote (QuasiQuoter (..))+import Language.Haskell.TH.Syntax+import Text.Blaze.Builder.Core (Builder, fromByteString, toLazyByteString)+import Text.Blaze.Builder.Utf8 (fromString)+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.UTF8 as BSU+import qualified Data.ByteString.Lazy as L+import Data.Monoid+import System.IO.Unsafe (unsafePerformIO)++renderJavascript :: Javascript -> L.ByteString+renderJavascript (Javascript b) = toLazyByteString b++renderJulius :: (url -> [(String, String)] -> String) -> Julius url -> L.ByteString+renderJulius r s = renderJavascript $ s r++newtype Javascript = Javascript Builder+    deriving Monoid+type Julius url = (url -> [(String, String)] -> String) -> Javascript++class ToJavascript a where+    toJavascript :: a -> String+instance ToJavascript [Char] where toJavascript = id++data Deref = DerefLeaf String+           | DerefBranch Deref Deref+    deriving (Show, Eq)++instance Lift Deref where+    lift (DerefLeaf s) = do+        dl <- [|DerefLeaf|]+        return $ dl `AppE` (LitE $ StringL s)+    lift (DerefBranch x y) = do+        x' <- lift x+        y' <- lift y+        db <- [|DerefBranch|]+        return $ db `AppE` x' `AppE` y'++data Content = ContentRaw String+             | ContentVar Deref+             | ContentUrl Deref+             | ContentUrlParam Deref+             | ContentMix Deref+    deriving Show+type Contents = [Content]++parseContents :: Parser Contents+parseContents = many1 parseContent++parseContent :: Parser Content+parseContent = do+    (char '%' >> (parsePercent <|> parseVar)) <|>+      (char '@' >> (parseAt <|> parseUrl)) <|> do+      (char '^' >> (parseCaret <|> parseMix)) <|> do+        s <- many1 $ noneOf "%@^"+        return $ ContentRaw s+  where+    parseCaret = char '^' >> return (ContentRaw "^")+    parseMix = do+        d <- parseDeref+        _ <- char '^'+        return $ ContentMix d+    parseAt = char '@' >> return (ContentRaw "@")+    parseUrl = do+        c <- (char '?' >> return ContentUrlParam) <|> return ContentUrl+        d <- parseDeref+        _ <- char '@'+        return $ c d+    parsePercent = char '%' >> return (ContentRaw "%")+    parseVar = do+        d <- parseDeref+        _ <- char '%'+        return $ ContentVar d++parseDeref :: Parser Deref+parseDeref =+    deref+  where+    derefParens = between (char '(') (char ')') deref+    derefSingle = derefParens <|> fmap DerefLeaf ident+    deref = do+        let delim = (char '.' <|> (many1 (char ' ') >> return ' '))+        x <- derefSingle+        xs <- many $ delim >> derefSingle+        return $ foldr1 DerefBranch $ x : xs+    ident = many1 (alphaNum <|> char '_' <|> char '\'')++compressContents :: Contents -> Contents+compressContents [] = []+compressContents (ContentRaw x:ContentRaw y:z) =+    compressContents $ ContentRaw (x ++ y) : z+compressContents (x:y) = x : compressContents y++contentsToJulius :: [Content] -> Q Exp+contentsToJulius a = do+    r <- newName "_render"+    c <- mapM (contentToJavascript r) $ compressContents a+    d <- case c of+            [] -> [|mempty|]+            [x] -> return x+            _ -> do+                mc <- [|mconcat|]+                return $ mc `AppE` ListE c+    return $ LamE [VarP r] d++julius :: QuasiQuoter+julius =+    QuasiQuoter juliusFromString p+  where+    p = error "julius quasi-quoter for patterns does not exist"++juliusFromString :: String -> Q Exp+juliusFromString s = do+    let a = either (error . show) id $ parse parseContents s s+    contentsToJulius a++contentToJavascript :: Name -> Content -> Q Exp+contentToJavascript _ (ContentRaw s') = do+    let d = S8.unpack $ BSU.fromString s'+    ts <- [|Javascript . fromByteString . S8.pack|]+    return $ ts `AppE` LitE (StringL d)+contentToJavascript _ (ContentVar d) = do+    ts <- [|Javascript . fromString . toJavascript|]+    return $ ts `AppE` derefToExp d+contentToJavascript r (ContentUrl d) = do+    ts <- [|Javascript . fromString|]+    return $ ts `AppE` (VarE r `AppE` derefToExp d `AppE` ListE [])+contentToJavascript r (ContentUrlParam d) = do+    ts <- [|Javascript . fromString|]+    up <- [|\r' (u, p) -> r' u p|]+    return $ ts `AppE` (up `AppE` VarE r `AppE` derefToExp d)+contentToJavascript r (ContentMix d) = do+    return $ derefToExp d `AppE` VarE r++derefToExp :: Deref -> Exp+derefToExp (DerefBranch x y) =+    let x' = derefToExp x+        y' = derefToExp y+     in x' `AppE` y'+derefToExp (DerefLeaf "") = error "Illegal empty ident"+derefToExp (DerefLeaf v@(s:_))+    | all isDigit v = LitE $ IntegerL $ read v+    | isUpper s = ConE $ mkName v+    | otherwise = VarE $ mkName v++juliusFile :: FilePath -> Q Exp+juliusFile fp = do+    contents <- fmap BSU.toString $ qRunIO $ S8.readFile fp+    juliusFromString contents++data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin++getVars :: Content -> [(Deref, VarType)]+getVars ContentRaw{} = []+getVars (ContentVar d) = [(d, VTPlain)]+getVars (ContentUrl d) = [(d, VTUrl)]+getVars (ContentUrlParam d) = [(d, VTUrlParam)]+getVars (ContentMix d) = [(d, VTMixin)]++data JDData url = JDPlain String+                | JDUrl url+                | JDUrlParam (url, [(String, String)])+                | JDMixin (Julius url)++vtToExp :: (Deref, VarType) -> Q Exp+vtToExp (d, vt) = do+    d' <- lift d+    c' <- c vt+    return $ TupE [d', c' `AppE` derefToExp d]+  where+    c VTPlain = [|JDPlain . toJavascript|]+    c VTUrl = [|JDUrl|]+    c VTUrlParam = [|JDUrlParam|]+    c VTMixin = [|JDMixin|]++juliusFileDebug :: FilePath -> Q Exp+juliusFileDebug fp = do+    s <- fmap BSU.toString $ qRunIO $ S8.readFile fp+    let a = either (error . show) id $ parse parseContents s s+        b = concatMap getVars a+    c <- mapM vtToExp b+    cr <- [|juliusRuntime|]+    return $ cr `AppE` (LitE $ StringL fp) `AppE` ListE c++juliusRuntime :: FilePath -> [(Deref, JDData url)] -> Julius url+juliusRuntime fp cd render' = unsafePerformIO $ do+    s <- fmap BSU.toString $ qRunIO $ S8.readFile fp+    let a = either (error . show) id $ parse parseContents s s+    return $ mconcat $ map go a+  where+    go :: Content -> Javascript+    go (ContentRaw s) = Javascript $ fromString s+    go (ContentVar d) =+        case lookup d cd of+            Just (JDPlain s) -> Javascript $ fromString s+            _ -> error $ show d ++ ": expected JDPlain"+    go (ContentUrl d) =+        case lookup d cd of+            Just (JDUrl u) -> Javascript $ fromString $ render' u []+            _ -> error $ show d ++ ": expected JDUrl"+    go (ContentUrlParam d) =+        case lookup d cd of+            Just (JDUrlParam (u, p)) ->+                Javascript $ fromString $ render' u p+            _ -> error $ show d ++ ": expected JDUrlParam"+    go (ContentMix d) =+        case lookup d cd of+            Just (JDMixin m) -> m render'+            _ -> error $ show d ++ ": expected JDMixin"

@@ -1,5 +1,5 @@ name:            hamlet-version:         0.4.2+version:         0.5.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -43,13 +43,17 @@                      bytestring >= 0.9 && < 0.10,                      utf8-string >= 0.3.4 && < 0.4,                      template-haskell,-                     blaze-html >= 0.1.1 && < 0.2,+                     blaze-builder >= 0.1 && < 0.2,+                     neither >= 0.0.1 && < 0.1,                      parsec >= 2 && < 4,                      failure >= 0.1.0 && < 0.2     exposed-modules: Text.Hamlet                      Text.Hamlet.RT+                     Text.Cassius+                     Text.Julius     other-modules:   Text.Hamlet.Parse                      Text.Hamlet.Quasi+                     Text.Hamlet.Debug     ghc-options:     -Wall  executable             runtests

@@ -5,7 +5,10 @@ import Test.HUnit hiding (Test)
 
 import Text.Hamlet
+import Text.Cassius
+import Text.Julius
 import Data.ByteString.Lazy.UTF8 (toString)
+import Data.List (intercalate)
 
 main :: IO ()
 main = defaultMain [testSuite]
@@ -56,20 +59,66 @@     , testCase "currency symbols" caseCurrency
     , testCase "external" caseExternal
     , testCase "parens" caseParens
+    , testCase "hamlet literals"caseHamletLiterals
     , testCase "hamlet' and xhamlet'" caseHamlet'
     , testCase "hamletDebug" caseHamletDebug
     , testCase "hamlet runtime" caseHamletRT
+    , testCase "hamletFileDebug- changing file" caseHamletFileDebugChange
+    , testCase "hamletFileDebug- features" caseHamletFileDebugFeatures
+    , testCase "cassius" caseCassius
+    , testCase "cassiusFile" caseCassiusFile
+    , testCase "cassiusFileDebug" caseCassiusFileDebug
+    , testCase "cassiusFileDebugChange" caseCassiusFileDebugChange
+    , testCase "julius" caseJulius
+    , testCase "juliusFile" caseJuliusFile
+    , testCase "juliusFileDebug" caseJuliusFileDebug
+    , testCase "juliusFileDebugChange" caseJuliusFileDebugChange
+    , testCase "comments" caseComments
+    , testCase "hamletFileDebug double foralls" caseDoubleForalls
+    , testCase "cassius pseudo-class" casePseudo
+    , testCase "different binding names" caseDiffBindNames
     ]
 
 data Url = Home | Sub SubUrl
 data SubUrl = SubUrl
-render :: Url -> String
-render Home = "url"
-render (Sub SubUrl) = "suburl"
+render :: Url -> [(String, String)] -> String
+render Home qs = "url" ++ showParams qs
+render (Sub SubUrl) qs = "suburl" ++ showParams qs
 
+showParams :: [(String, String)] -> String
+showParams [] = ""
+showParams z =
+    '?' : intercalate "&" (map go z)
+  where
+    go (x, y) = go' x ++ '=' : go' y
+    go' = concatMap encodeUrlChar
+
+-- | 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]
+
 data Arg url = Arg
     { getArg :: Arg url
-    , var :: Html ()
+    , var :: Html
     , url :: Url
     , embed :: Hamlet url
     , true :: Bool
@@ -120,11 +169,11 @@ 
 caseUrl :: Assertion
 caseUrl = do
-    helper (render Home) [$hamlet|@url.theArg@|]
+    helper (render Home []) [$hamlet|@url.theArg@|]
 
 caseUrlChain :: Assertion
 caseUrlChain = do
-    helper (render Home) [$hamlet|@url.getArg.getArg.getArg.theArg@|]
+    helper (render Home []) [$hamlet|@url.getArg.getArg.getArg.theArg@|]
 
 caseEmbed :: Assertion
 caseEmbed = do
@@ -322,7 +371,7 @@ caseAttribVars = do
     helper "<div id=\"&lt;var&gt;\"></div>" [$hamlet|#$var.theArg$|]
     helper "<div class=\"&lt;var&gt;\"></div>" [$hamlet|.$var.theArg$|]
-    helper "<div f=\"&lt;var&gt;\"></div>" [$hamlet|%div!f=$var.theArg$|]
+    helper "<div f=\"&lt;var&gt;\"></div>" [$hamlet|!f=$var.theArg$|]
 
 caseStringsAndHtml :: Assertion
 caseStringsAndHtml = do
@@ -393,7 +442,10 @@     $x$
 |]
 
-helper' :: String -> Html ()-> Assertion
+caseHamletLiterals :: Assertion
+caseHamletLiterals = helper "123" [$hamlet|$show.123$|]
+
+helper' :: String -> Html -> Assertion
 helper' res h = do
     let x = renderHtml h
     res @=? toString x
@@ -402,6 +454,8 @@ caseHamlet' = do
     helper' "foo" [$hamlet'|foo|]
     helper' "foo" [$xhamlet'|foo|]
+    helper "<br>" $ const $ [$hamlet'|%br|]
+    helper "<br/>" $ const $ [$xhamlet'|%br|]
 
 caseHamletDebug :: Assertion
 caseHamletDebug = do
@@ -415,7 +469,7 @@     temp <- parseHamletRT defaultHamletSettings "$var$"
     rt <- parseHamletRT defaultHamletSettings $
             unlines
-                [ "$foo.bar.baz$ bin $"
+                [ "$baz.bar.foo$ bin $"
                 , "$forall list l"
                 , "  $l$"
                 , "$maybe just j"
@@ -435,26 +489,208 @@                 , "@?urlp@"
                 ]
     let scope =
-            HDMap
-                [ ("foo", HDMap
-                    [ ("bar", HDMap
-                        [ ("baz", HDHtml $ preEscapedString "foo<bar>baz")
-                        ])
-                    ])
-                , ("list", HDList
-                    [ HDHtml $ string "1"
-                    , HDHtml $ string "2"
-                    , HDHtml $ string "3"
-                    ])
-                , ("just", HDMaybe $ Just $ HDHtml $ string "just")
-                , ("nothing", HDMaybe Nothing)
-                , ("template", HDTemplate temp)
-                , ("var", HDHtml $ string "var")
-                , ("url", HDUrl Home)
-                , ("urlp", HDUrlParams Home [("foo", "bar")])
-                , ("true", HDBool True)
-                , ("false", HDBool False)
-                ]
+            [ (["foo", "bar", "baz"], HDHtml $ preEscapedString "foo<bar>baz")
+            , (["list"], HDList
+                [ [([], HDHtml $ string "1")]
+                , [([], HDHtml $ string "2")]
+                , [([], HDHtml $ string "3")]
+                ])
+            , (["just"], HDMaybe $ Just
+                [ ([], HDHtml $ string "just")
+                ])
+            , (["nothing"], HDMaybe Nothing)
+            , (["template"], HDTemplate temp)
+            , (["var"], HDHtml $ string "var")
+            , (["url"], HDUrl Home)
+            , (["urlp"], HDUrlParams Home [("foo", "bar")])
+            , (["true"], HDBool True)
+            , (["false"], HDBool False)
+            ]
     rend <- renderHamletRT rt scope render
     toString (renderHtml rend) @?=
         "foo<bar>baz bin 123justnothingvarurlaburl?foo=bar"
+
+caseHamletFileDebugChange :: Assertion
+caseHamletFileDebugChange = do
+    let foo = "foo"
+    writeFile "external-debug.hamlet" "$foo$ 1"
+    helper "foo 1" $ $(hamletFileDebug "external-debug.hamlet")
+    writeFile "external-debug.hamlet" "$foo$ 2"
+    helper "foo 2" $ $(hamletFileDebug "external-debug.hamlet")
+    writeFile "external-debug.hamlet" "$foo$ 1"
+
+caseHamletFileDebugFeatures :: Assertion
+caseHamletFileDebugFeatures = do
+    let var = "var"
+    let url = Home
+    let urlp = (Home, [("foo", "bar")])
+    let template = [$hamlet|template|]
+    let true = True
+    let just = Just "just"
+        nothing = Nothing
+    let list = words "1 2 3"
+    let extra = "e"
+    flip helper $(hamletFileDebug "external-debug2.hamlet") $ concat
+        [ "var"
+        , "var"
+        , "url"
+        , "url"
+        , "suburl"
+        , "url?foo=bar"
+        , "template"
+        , "truee"
+        , "not truee"
+        , "elseif truee"
+        , "just"
+        , "juste"
+        , "nothinge"
+        , "1e2e3e"
+        ]
+
+celper :: String -> Cassius Url -> Assertion
+celper res h = do
+    let x = renderCassius render h
+    res @=? toString x
+
+mixin :: CassiusMixin a
+mixin = [$cassiusMixin|
+a: b
+c: d
+|]
+
+caseCassius :: Assertion
+caseCassius = do
+    let var = "var"
+    let urlp = (Home, [("p", "q")])
+    flip celper [$cassius|
+foo
+    color: $colorRed$
+    background: $colorBlack$
+    bar: baz
+    bin
+        color: $(((Color 127) 100) 5)$
+        bar: bar
+        unicode-test: שלום
+        f$var$x: someval
+        background-image: url(@Home@)
+        urlp: url(@?urlp@)
+    ^mixin^
+|] $ concat
+        [ "foo{color:#F00;background:#000;bar:baz;a:b;c:d}"
+        , "foo bin{color:#7F6405;bar:bar;unicode-test:שלום;fvarx:someval;"
+        , "background-image:url(url);urlp:url(url?p=q)}"
+        ]
+
+caseCassiusFile :: Assertion
+caseCassiusFile = do
+    let var = "var"
+    let urlp = (Home, [("p", "q")])
+    flip celper $(cassiusFile "external1.cassius") $ concat
+        [ "foo{color:#F00;background:#000;bar:baz;a:b;c:d}"
+        , "foo bin{color:#7F6405;bar:bar;unicode-test:שלום;fvarx:someval;"
+        , "background-image:url(url);urlp:url(url?p=q)}"
+        ]
+
+caseCassiusFileDebug :: Assertion
+caseCassiusFileDebug = do
+    let var = "var"
+    let urlp = (Home, [("p", "q")])
+    flip celper $(cassiusFileDebug "external1.cassius") $ concat
+        [ "foo{color:#F00;background:#000;bar:baz;a:b;c:d}"
+        , "foo bin{color:#7F6405;bar:bar;unicode-test:שלום;fvarx:someval;"
+        , "background-image:url(url);urlp:url(url?p=q)}"
+        ]
+
+caseCassiusFileDebugChange :: Assertion
+caseCassiusFileDebugChange = do
+    let var = "var"
+    writeFile "external2.cassius" "foo\n  $var$: 1"
+    celper "foo{var:1}" $(cassiusFileDebug "external2.cassius")
+    writeFile "external2.cassius" "foo\n  $var$: 2"
+    celper "foo{var:2}" $(cassiusFileDebug "external2.cassius")
+    writeFile "external2.cassius" "foo\n  $var$: 1"
+
+jmixin = [$julius|var x;|]
+
+jelper :: String -> Julius Url -> Assertion
+jelper res h = do
+    let x = renderJulius render h
+    res @=? toString x
+
+caseJulius :: Assertion
+caseJulius = do
+    let var = "var"
+    let urlp = (Home, [("p", "q")])
+    flip jelper [$julius|שלום
+%var%
+@Home@
+@?urlp@
+^jmixin^
+|] $ intercalate "\r\n"
+        [ "שלום"
+        , var
+        , "url"
+        , "url?p=q"
+        , "var x;"
+        ] ++ "\r\n"
+
+caseJuliusFile :: Assertion
+caseJuliusFile = do
+    let var = "var"
+    let urlp = (Home, [("p", "q")])
+    flip jelper $(juliusFile "external1.julius") $ unlines
+        [ "שלום"
+        , var
+        , "url"
+        , "url?p=q"
+        , "var x;"
+        ]
+
+caseJuliusFileDebug :: Assertion
+caseJuliusFileDebug = do
+    let var = "var"
+    let urlp = (Home, [("p", "q")])
+    flip jelper $(juliusFileDebug "external1.julius") $ unlines
+        [ "שלום"
+        , var
+        , "url"
+        , "url?p=q"
+        , "var x;"
+        ]
+
+caseJuliusFileDebugChange :: Assertion
+caseJuliusFileDebugChange = do
+    let var = "somevar"
+    writeFile "external2.julius" "var %var% = 1;"
+    jelper "var somevar = 1;" $(juliusFileDebug "external2.julius")
+    writeFile "external2.julius" "var %var% = 2;"
+    jelper "var somevar = 2;" $(juliusFileDebug "external2.julius")
+    writeFile "external2.julius" "var %var% = 1;"
+
+caseComments :: Assertion
+caseComments = do
+    helper "" [$hamlet|$# this is a comment
+$# another comment
+$#a third one|]
+    celper "" [$cassius|$# this is a comment
+$# another comment
+$#a third one|]
+
+caseDoubleForalls :: Assertion
+caseDoubleForalls = do
+    let list = map show [1..2]
+    helper "12" $(hamletFileDebug "double-foralls.hamlet")
+instance Show Url where
+    show _ = "FIXME remove this instance show Url"
+
+casePseudo :: Assertion
+casePseudo = do
+    flip celper [$cassius|
+a:visited
+    color: blue
+|] "a:visited{color:blue}"
+
+caseDiffBindNames :: Assertion
+caseDiffBindNames = do
+    let list = words "1 2 3"
+    helper "123123" $(hamletFileDebug "external-debug3.hamlet")