packages feed

hamlet 1.1.8.1 → 1.1.9

raw patch · 3 files changed

+88/−27 lines, 3 files

Files

Text/Hamlet.hs view
@@ -20,6 +20,7 @@     , hamlet     , hamletFile     , hamletFileReload+    , ihamletFileReload     , xhamlet     , xhamletFile       -- * I18N Hamlet@@ -378,8 +379,13 @@ hamletFile = hamletFileWithSettings hamletRules defaultHamletSettings  hamletFileReload :: FilePath -> Q Exp-hamletFileReload = hamletFileReloadWithSettings hamletRules defaultHamletSettings+hamletFileReload = hamletFileReloadWithSettings runtimeRules defaultHamletSettings+  where runtimeRules = HamletRuntimeRules { hrrI18n = False } +ihamletFileReload :: FilePath -> Q Exp+ihamletFileReload = hamletFileReloadWithSettings runtimeRules defaultHamletSettings+  where runtimeRules = HamletRuntimeRules { hrrI18n = True }+ xhamletFile :: FilePath -> Q Exp xhamletFile = hamletFileWithSettings hamletRules xhtmlHamletSettings @@ -422,10 +428,11 @@ type QueryParameters = [(Text, Text)] type RenderUrl url = (url -> QueryParameters -> Text) type Shakespeare url = RenderUrl url -> Html-data VarExp url = EPlain Html-                | EUrl url-                | EUrlParam (url, QueryParameters)-                | EMixin (Shakespeare url)+data VarExp msg url = EPlain Html+                    | EUrl url+                    | EUrlParam (url, QueryParameters)+                    | EMixin (HtmlUrlI18n msg url)+                    | EMsg msg  getVars :: Content -> [(Deref, VarType)] getVars ContentRaw{}     = []@@ -440,28 +447,37 @@ hamletUsedIdentifiers settings =     concatMap getVars . contentFromString settings -hamletFileReloadWithSettings :: Q HamletRules -- ^ not used right now++data HamletRuntimeRules = HamletRuntimeRules {+                            hrrI18n :: Bool+                          }++hamletFileReloadWithSettings :: HamletRuntimeRules                              -> HamletSettings -> FilePath -> Q Exp-hamletFileReloadWithSettings _qhr settings fp = do+hamletFileReloadWithSettings hrr settings fp = do     s <- readFileQ fp     let b = hamletUsedIdentifiers settings s     c <- mapM vtToExp b-    rt <- [|hamletRuntime settings fp|]+    rt <- if hrrI18n hrr+      then [|hamletRuntimeMsg settings fp|]+      else [|hamletRuntime settings fp|]     return $ rt `AppE` ListE c   where     vtToExp :: (Deref, VarType) -> Q Exp     vtToExp (d, vt) = do         d' <- lift d-        c' <- c vt+        c' <- toExp vt         return $ TupE [d', c' `AppE` derefToExp [] d]       where-        c :: VarType -> Q Exp-        c VTAttrs = error "VTAttrs not supported"-        c VTMsg = error "VTMsg not supported"-        c VTPlain = [|EPlain . toHtml|]-        c VTUrl = [|EUrl|]-        c VTUrlParam = [|EUrlParam|]-        c VTMixin = [|\x -> EMixin $ \r -> x r|]+        toExp = c+          where+            c :: VarType -> Q Exp+            c VTAttrs = [|EPlain . attrsToHtml . toAttributes|]+            c VTPlain = [|EPlain . toHtml|]+            c VTUrl = [|EUrl|]+            c VTUrlParam = [|EUrlParam|]+            c VTMixin = [|\x -> EMixin $ \r -> x r|]+            c VTMsg = [|EMsg|]  -- move to Shakespeare.Base? readFileUtf8 :: FilePath -> IO String@@ -500,10 +516,9 @@  hamletRuntime :: HamletSettings               -> FilePath-              -> [(Deref, VarExp url)]+              -> [(Deref, VarExp msg url)]               -> Shakespeare url-hamletRuntime settings fp cd render' = unsafePerformIO $ do-    -- hr <- qhr -- TODO+hamletRuntime settings fp cd render = unsafePerformIO $ do     mtime <- qRunIO $ getModified $ decodeString fp     mdata <- lookupReloadMap fp     case mdata of@@ -516,26 +531,57 @@         s <- readFileUtf8 fp         insertReloadMap fp (mtime, contentFromString settings s) -    go' = mconcat . map go+    go' = mconcat . map (runtimeContentToHtml cd i18nEx render handleMsgEx)+    i18nEx = error "ihamlet needed for i18n"+    handleMsgEx _ = error "i18n _{} encountered, but did not use ihamlet" +type RuntimeVars msg url = [(Deref, VarExp msg url)]+hamletRuntimeMsg :: HamletSettings+              -> FilePath+              -> RuntimeVars msg url+              -> HtmlUrlI18n msg url+hamletRuntimeMsg settings fp cd i18nRender render = unsafePerformIO $ do+    mtime <- qRunIO $ getModified $ decodeString fp+    mdata <- lookupReloadMap fp+    case mdata of+      Just (lastMtime, lastContents) ->+        if mtime == lastMtime then return $ go' lastContents+          else fmap go' $ newContent mtime+      Nothing -> fmap go' $ newContent mtime+  where+    newContent mtime = do+        s <- readFileUtf8 fp+        insertReloadMap fp (mtime, contentFromString settings s)++    go' = mconcat . map (runtimeContentToHtml cd i18nRender render handleMsg)+    handleMsg d = case lookup d cd of+            Just (EMsg s) -> i18nRender s+            _ -> error $ show d ++ ": expected EMsg for ContentMsg"++runtimeContentToHtml :: RuntimeVars msg url -> Translate msg -> Render url -> (Deref -> Html) -> Content -> Html+runtimeContentToHtml cd i18nRender render handleMsg = go+  where     go :: Content -> Html-    go (ContentMsg {}) = error "ContentMsg not supported"-    go (ContentAttrs {}) = error "ContentAttrs not supported"+    go (ContentMsg d) = handleMsg d     go (ContentRaw s) = preEscapedToHtml s+    go (ContentAttrs d) =+        case lookup d cd of+            Just (EPlain s) -> s+            _ -> error $ show d ++ ": expected EPlain for ContentAttrs"     go (ContentVar d) =         case lookup d cd of             Just (EPlain s) -> s-            _ -> error $ show d ++ ": expected EPlain"+            _ -> error $ show d ++ ": expected EPlain for ContentVar"     go (ContentUrl False d) =         case lookup d cd of-            Just (EUrl u) -> toHtml $ render' u []+            Just (EUrl u) -> toHtml $ render u []             _ -> error $ show d ++ ": expected EUrl"     go (ContentUrl True d) =         case lookup d cd of             Just (EUrlParam (u, p)) ->-                toHtml $ render' u p+                toHtml $ render u p             _ -> error $ show d ++ ": expected EUrlParam"     go (ContentEmbed d) =         case lookup d cd of-            Just (EMixin m) -> m render'+            Just (EMixin m) -> m i18nRender render             _ -> error $ show d ++ ": expected EMixin"
hamlet.cabal view
@@ -1,5 +1,5 @@ name:            hamlet-version:         1.1.8.1+version:         1.1.9 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>
test/HamletTest.hs view
@@ -9,6 +9,7 @@ 
 import Prelude hiding (reverse)
 import Text.Hamlet
+import Text.Hamlet.RT
 import Data.List (intercalate)
 import qualified Data.Text.Lazy as T
 import qualified Data.List
@@ -262,6 +263,7 @@   ^{embed}
   |]
       ihelper "<h1>Hola</h1>\n" $(ihamletFile "test/hamlets/nonpolyihamlet.hamlet")
+      ihelper "<h1>Hola</h1>\n" $(ihamletFileReload "test/hamlets/nonpolyihamlet.hamlet")
 
     it "pattern-match tuples: forall" $ do
       let people = [("Michael", 26), ("Miriam", 25)]
@@ -487,6 +489,19 @@     it "AngularJS attribute values #122" $
         helper "<li ng-repeat=\"addr in msgForm.new.split(/\\\\s/)\">{{addr}}</li>\n"
             [hamlet|<li ng-repeat="addr in msgForm.new.split(/\\s/)">{{addr}}|]
+
+    it "runtime Hamlet with caret interpolation" $ do
+        let toInclude render = render (5, [("hello", "world")])
+        let renderer x y = pack $ show (x :: Int, y :: [(Text, Text)])
+            template1 = "@?{url}"
+            template2 = "foo^{toInclude}bar"
+        toInclude <- parseHamletRT defaultHamletSettings template1
+        hamletRT <- parseHamletRT defaultHamletSettings template2
+        res <- renderHamletRT hamletRT
+            [ (["toInclude"], HDTemplate toInclude)
+            , (["url"], HDUrlParams 5 [(pack "hello", pack "world")])
+            ] renderer
+        helperHtml "foo(5,[(\"hello\",\"world\")])bar" res
 
 data Pair = Pair String Int