shakespeare 2.0.30 → 2.2.0
raw patch · 12 files changed
Files
- ChangeLog.md +71/−0
- Text/Hamlet.hs +21/−2
- Text/Hamlet/Parse.hs +19/−2
- Text/Hamlet/RT.hs +1/−0
- Text/Shakespeare/Base.hs +20/−1
- Text/Shakespeare/I18N.hs +186/−38
- other-messages/en.msg +29/−0
- shakespeare.cabal +6/−4
- test/Text/HamletSpec.hs +81/−0
- test/Text/Shakespeare/BaseSpec.hs +19/−0
- test/Text/Shakespeare/I18NSpec.hs +45/−4
- test/Text/Shakespeare/TextSpec.hs +9/−0
ChangeLog.md view
@@ -1,5 +1,76 @@ # ChangeLog for shakespeare +### 2.2.0++* Added $component with binding for reusable blocks++You can now bind a component-producing function and reuse its sub-components within the same Hamlet block.++#### Example++```haskell+data Modal = Modal+ { modalHeader :: Widget -> Widget+ , modalBody :: Widget -> Widget+ }++modalWidget :: (Modal -> Widget) -> Widget+```++```hamlet+$component modal <- modalWidget+ $component modalHeader modal+ <h1>This is the title++ $component modalBody modal+ <p>This is the content+```++Conceptually, this desugars to:++```haskell+^{ modalWidget $ \modal ->+ [whamlet|+ ^{ modalHeader modal [whamlet| <h1>This is the title |] }+ ^{ modalBody modal [whamlet| <p>This is the content |] }+ |]+ }+<p>outside+```++Since everything here is just plain Haskell, you can freely pass additional data or parameters to your component-producing function—`modalWidget` and its subcomponents are ordinary functions.+Only the *outermost* component (`modalWidget` in this case) needs to follow the `(Modal -> Widget) -> Widget` pattern; all nested subcomponents can have arbitrary types and arguments.++### 2.1.7.1++* Add missing other-messages to shakespeare.cabal [#299](https://github.com/yesodweb/shakespeare/pull/299)++### 2.1.7++* Use ByteString’s Lift for Hamlet code generation [#298](https://github.com/yesodweb/shakespeare/pull/298)++### 2.1.6++* Introduce options type for i18n, add ability to stop using record types for messages [#290](https://github.com/yesodweb/shakespeare/pull/290)++### 2.1.5++* Add better support for `mkMessage`ing data types with params.[#295](https://github.com/yesodweb/shakespeare/pull/295)+++### 2.1.4++* [#292](https://github.com/yesodweb/shakespeare/pull/292)+ * Add support for multi-line attributes. An example use of this is [here](https://github.com/yesodweb/shakespeare/issues/291).++### 2.1.2++* Add support for context parsing in mkMessage function and related ones [#282](https://github.com/yesodweb/shakespeare/issues/282). Added support for building with LTS versions of 22, 21, 20 and removed older ones.++### 2.1.0++* Add `OverloadedRecordDot`-style record access in expressions+ ### 2.0.30 * Add `Text.Cassius.Ordered` and `Text.Lucius.Ordered` modules with parsers to maintain order between attributes and mixin blocks.
Text/Hamlet.hs view
@@ -48,6 +48,7 @@ , hamletFromString ) where +import Text.Blaze.Internal (unsafeByteString) import Text.Shakespeare.Base import Text.Hamlet.Parse import Language.Haskell.TH.Syntax hiding (Module)@@ -55,6 +56,7 @@ import Data.Char (isUpper, isDigit) import Data.Maybe (fromMaybe) import Data.Text (Text, pack)+import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import Text.Blaze.Html (Html, toHtml) import Text.Blaze.Internal (preEscapedText)@@ -214,6 +216,22 @@ inside' <- docToExp env hr scope' (DocWith dis inside) let lam = LamE [pat] inside' return $ lam `AppE` deref'+docToExp env hr scope (DocComponent mbinding deref inside) = do+ let deref' = derefToExp scope deref+ case mbinding of+ Just binding -> do+ (pat, extraScope) <- bindingPattern binding+ let scope' = extraScope ++ scope+ inside' <-+ hrWithEnv hr $ \env ->+ docsToExp env hr scope' inside+ hrEmbed hr env $ deref' `AppE` LamE [pat] inside'+ Nothing -> do+ inside' <-+ hrWithEnv hr $ \env ->+ docsToExp env hr scope inside+ hrEmbed hr env $ deref' `AppE` inside'+ docToExp env hr scope (DocMaybe val idents inside mno) = do let val' = derefToExp scope val (pat, extraScope) <- bindingPattern idents@@ -263,8 +281,8 @@ contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp contentToExp _ hr _ (ContentRaw s) = do- os <- [|preEscapedText . pack|]- let s' = LitE $ StringL s+ os <- [|unsafeByteString|]+ s' <- lift $ TE.encodeUtf8 (pack s) return $ hrFromHtml hr `AppE` (os `AppE` s') contentToExp _ hr scope (ContentVar d) = do str <- [|toHtml|]@@ -592,6 +610,7 @@ justContent (DocContent c) = c justContent DocForall{} = unsupported "$forall" justContent DocWith{} = unsupported "$with"+ justContent DocComponent{} = unsupported "$component" justContent DocMaybe{} = unsupported "$maybe" justContent DocCase{} = unsupported "$case" justContent DocCond{} = unsupported "attribute conditionals"
Text/Hamlet/Parse.hs view
@@ -66,6 +66,7 @@ | LineNothing | LineCase Deref | LineOf Binding+ | LineComponent (Maybe Binding) Deref | LineTag { _lineTagName :: String , _lineAttr :: [(Maybe Deref, String, Maybe [Content])]@@ -79,7 +80,7 @@ parseLines :: HamletSettings -> String -> Result (Maybe NewlineStyle, HamletSettings, [(Int, Line)]) parseLines set s =- case parse parser s s of+ case parse parser "[Hamlet input]" s of Left e -> Error $ show e Right x -> Ok x where@@ -125,6 +126,7 @@ controlWith <|> controlCase <|> controlOf <|>+ controlComponent <|> angle <|> invalidDollar <|> (eol' >> return (LineContent [] True)) <|>@@ -238,6 +240,14 @@ _ <- spaceTabs eol return $ LineOf x+ controlComponent = do+ _ <- try $ string "$component"+ spaces+ (x, b) <- (second Just <$> try binding) <|>+ ((\x -> (x, Nothing)) <$> parseDeref)+ _ <- spaceTabs+ eol+ return $ LineComponent b x content cr = do x <- many $ content' cr case cr of@@ -283,7 +293,7 @@ contentReg InContent = (ContentRaw . return) <$> noneOf "#@^\r\n" contentReg NotInQuotes = (ContentRaw . return) <$> noneOf "@^#. \t\n\r>" contentReg NotInQuotesAttr = (ContentRaw . return) <$> noneOf "@^ \t\n\r>"- contentReg InQuotes = (ContentRaw . return) <$> noneOf "#@^\"\n\r"+ contentReg InQuotes = (ContentRaw . return) <$> noneOf "#@^\"" tagAttribValue notInQuotes = do cr <- (char '"' >> return InQuotes) <|> return notInQuotes fst <$> content cr@@ -450,6 +460,7 @@ | DocCond [(Deref, [Doc])] (Maybe [Doc]) | DocMaybe Deref Binding [Doc] (Maybe [Doc]) | DocCase Deref [(Binding, [Doc])]+ | DocComponent (Maybe Binding) Deref [Doc] | DocContent Content deriving (Show, Eq, Read, Data, Typeable) @@ -486,6 +497,10 @@ cases <- mapM getOf inside rest' <- nestToDoc set rest Ok $ DocCase d cases : rest'+nestToDoc set (Nest (LineComponent b d) inside:rest) = do+ inside' <- nestToDoc set inside+ rest' <- nestToDoc set rest+ Ok $ DocComponent b d inside' : rest' nestToDoc set (Nest (LineTag tn attrs content classes attrsD avoidNewLine) inside:rest) = do let attrFix (x, y, z) = (x, y, [(Nothing, z)]) let takeClass (a, "class", b) = Just (a, fromMaybe [] b)@@ -546,6 +561,8 @@ DocForall d i (compressDoc doc) : compressDoc rest compressDoc (DocWith dis doc:rest) = DocWith dis (compressDoc doc) : compressDoc rest+compressDoc (DocComponent b d i:rest) =+ DocComponent b d i : compressDoc rest compressDoc (DocMaybe d i doc mnothing:rest) = DocMaybe d i (compressDoc doc) (fmap compressDoc mnothing) : compressDoc rest
Text/Hamlet/RT.hs view
@@ -112,6 +112,7 @@ docs'' <- mapM convert docs' return (deref', docs'') convert DocWith{} = error "Runtime hamlet does not currently support $with"+ convert DocComponent{} = error "Runtime hamlet does not currently support $component" convert DocCase{} = error "Runtime hamlet does not currently support $case" renderHamletRT :: MonadThrow m
Text/Shakespeare/Base.hs view
@@ -55,6 +55,11 @@ | DerefBranch Deref Deref | DerefList [Deref] | DerefTuple [Deref]+ | DerefGetField Deref String+ -- ^ Record field access via @OverloadedRecordDot@. 'derefToExp' only supports this+ -- feature on compilers which support @OverloadedRecordDot@.+ --+ -- @since 2.1.0 deriving (Show, Eq, Read, Data, Typeable, Ord, Lift) derefParens, derefCurlyBrackets :: UserParser a Deref@@ -105,7 +110,15 @@ ys <- many1 $ try $ delim >> derefSingle skipMany $ oneOf " \t" return $ DerefBranch (DerefBranch op' $ foldl1 DerefBranch $ x : xs) (foldl1 DerefBranch ys)- derefSingle = derefTuple <|> derefList <|> derefOp <|> derefParens <|> numeric <|> strLit <|> ident+ derefSingle = do+ x <- derefTuple <|> derefList <|> derefOp <|> derefParens <|> numeric <|> strLit <|> ident+ fields <- many recordDot+ pure $ foldl DerefGetField x fields+ recordDot = do+ _ <- char '.'+ x <- lower <|> char '_'+ xs <- many (alphaNum <|> char '_' <|> char '\'')+ pure (x : xs) deref' lhs = dollar <|> derefSingle' <|> return (foldl1 DerefBranch $ lhs [])@@ -177,6 +190,12 @@ map Just $ #endif map (derefToExp s) ds+derefToExp s (DerefGetField x f) =+#if MIN_VERSION_template_haskell(2,18,0)+ GetFieldE (derefToExp s x) f+#else+ error "Your compiler doesn't support OverloadedRecordDot"+#endif -- FIXME shouldn't we use something besides a list here? flattenDeref :: Deref -> Maybe [String]
Text/Shakespeare/I18N.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExistentialQuantification #-} -----------------------------------------------------------------------------@@ -59,10 +59,18 @@ , ToMessage (..) , SomeMessage (..) , Lang++ , mkMessageOpts++ , MakeMessageOpts+ , defMakeMessageOpts+ , setGenType+ , setConPrefix+ , setTypeSuffix+ , setUseRecordCons ) where import Language.Haskell.TH.Syntax hiding (makeRelativeToProject)-import Control.Applicative ((<$>)) import Control.Monad (filterM, forM) import Data.Text (Text, pack, unpack) import System.Directory@@ -72,12 +80,12 @@ import qualified Data.Map as Map import qualified Data.ByteString as S import Data.Text.Encoding (decodeUtf8)-import Data.Char (isSpace, toLower, toUpper)+import Data.Char (isSpace, toLower, toUpper, isLower) import Data.Ord (comparing) import Text.Shakespeare.Base (Deref (..), Ident (..), parseHash, derefToExp)-import Text.ParserCombinators.Parsec (parse, many, eof, many1, noneOf, (<|>))+import Text.ParserCombinators.Parsec (parse, many, eof, many1, noneOf, (<|>), + string, spaces, char, option, alphaNum, sepBy1, try) import Control.Arrow ((***))-import Data.Monoid (mempty, mappend) import qualified Data.Text as T import Data.String (IsString (fromString)) @@ -124,8 +132,8 @@ -> FilePath -- ^ subdirectory which contains the translation files -> Lang -- ^ default translation language -> Q [Dec]-mkMessage dt folder lang =- mkMessageCommon True "Msg" "Message" dt dt folder lang+mkMessage dt =+ mkMessageCommon True "Msg" "Message" dt dt -- | create 'RenderMessage' instance for an existing data-type@@ -134,7 +142,7 @@ -> FilePath -- ^ path to translation folder -> Lang -- ^ default language -> Q [Dec]-mkMessageFor master dt folder lang = mkMessageCommon False "" "" master dt folder lang+mkMessageFor = mkMessageCommon False "" "" -- | create an additional set of translations for a type created by `mkMessage` mkMessageVariant :: String -- ^ master translation data type@@ -142,7 +150,7 @@ -> FilePath -- ^ path to translation folder -> Lang -- ^ default language -> Q [Dec]-mkMessageVariant master dt folder lang = mkMessageCommon False "Msg" "Message" master dt folder lang+mkMessageVariant = mkMessageCommon False "Msg" "Message" -- |used by 'mkMessage' and 'mkMessageFor' to generate a 'RenderMessage' and possibly a message data type mkMessageCommon :: Bool -- ^ generate a new datatype from the constructors found in the .msg files@@ -153,54 +161,138 @@ -> FilePath -- ^ path to translation folder -> Lang -- ^ default lang -> Q [Dec]-mkMessageCommon genType prefix postfix master dt rawFolder lang = do+mkMessageCommon genType prefix postfix =+ mkMessageOpts opts+ where+ opts = defMakeMessageOpts+ { mmGenType = genType+ , mmConPrefix = prefix+ , mmTypeSuffix = postfix+ }++-- | used by 'mkMessage', 'mkMessageFor' to generate a 'RenderMessage' and possibly a message data type+--+-- @since 2.1.6+mkMessageOpts :: MakeMessageOpts -- ^ options+ -> String -- ^ base name of master datatype+ -> String -- ^ base name of translation datatype+ -> FilePath -- ^ path to translation folder+ -> Lang -- ^ default lang+ -> Q [Dec]+mkMessageOpts opts@(MkMakeMessageOpts {mmGenType = genType, mmTypeSuffix = postfix}) master dt rawFolder lang = do folder <- makeRelativeToProject rawFolder files <- qRunIO $ getDirectoryContents folder let files' = filter (`notElem` [".", ".."]) files- (filess, contents) <- qRunIO $ fmap (unzip . catMaybes) $ mapM (loadLang folder) files'+ (filess, contents) <- qRunIO $ unzip . catMaybes <$> mapM (loadLang folder) files' (mapM_.mapM_) addDependentFile filess let contents' = Map.toList $ Map.fromListWith (++) contents sdef <- case lookup lang contents' of Nothing -> error $ "Did not find main language file: " ++ unpack lang Just def -> toSDefs def- mapM_ (checkDef sdef) $ map snd contents'- let mname = mkName $ dt ++ postfix- c1 <- fmap concat $ mapM (toClauses prefix dt) contents'- c2 <- mapM (sToClause prefix dt) sdef+ mapM_ (checkDef sdef . snd) contents'+ let mname = mkName $ dt2 ++ postfix+ c1 <- concat <$> mapM (toClauses opts dt2 ) contents'+ c2 <- mapM (sToClause opts dt2) sdef c3 <- defClause return $ ( if genType- then ((DataD [] mname [] Nothing (map (toCon dt) sdef) []) :)+ then (DataD [] mname [] Nothing (map (toCon opts dt2) sdef) [] :) else id) [ instanceD- []- (ConT ''RenderMessage `AppT` (ConT $ mkName master) `AppT` ConT mname)+ cxt -- Here the parsed context should be added, otherwise []+ (ConT ''RenderMessage `AppT` (if ' ' `elem` master' + then let (ts, us) = break (== ' ') . + filter (\x -> x /= '(' && x /= ')') $ master'+ combineArgs typeName p xs' = foldl1 AppT . (typeName :) . fmap (VarT . mkName) . filter (not . null) $ go xs' (id, id)+ where+ go :: String -> ([String] -> [String], String -> String) -> [String]+ go [] (endList, currList) = endList [currList []]+ go (x : xs) (endList, currList)+ | p x = go xs (endList . (currList [] :), id)+ | otherwise = go xs (endList, currList . (x :))+ in ParensT (combineArgs (ConT (mkName ts)) (== ' ') us)+ else ConT $ mkName master') `AppT` ConT mname) [ FunD (mkName "renderMessage") $ c1 ++ c2 ++ [c3] ] ]+ where (dt1, cxt0) = case parse parseName "" dt of+ Left err -> error $ show err+ Right x -> x+ dt2 = concat . take 1 $ dt1+ master' | null cxt0 = master+ | otherwise = (\xss -> if length xss > 1 + then '(':unwords xss ++ ")" + else concat . take 1 $ xss) . fst $ + (case parse parseName "" master of+ Left err -> error $ show err+ Right x -> x)+ cxt = fmap (\(c:rest) -> foldl' (\acc v -> acc `AppT` nameToType v) + (ConT $ mkName c) rest) cxt0 -toClauses :: String -> String -> (Lang, [Def]) -> Q [Clause]-toClauses prefix dt (lang, defs) =+ nameToType :: String -> Type -- Is taken from the +-- https://hackage.haskell.org/package/yesod-core-1.6.26.0/docs/src/Yesod.Routes.Parse.html#nameToType+ nameToType t = if isTvar t+ then VarT $ mkName t+ else ConT $ mkName t++ isTvar :: String -> Bool -- Is taken from the +-- https://hackage.haskell.org/package/yesod-core-1.6.26.0/docs/src/Yesod.Routes.Parse.html#isTvar+ isTvar (h:_) = isLower h+ isTvar _ = False++ parseName = do+ cxt' <- option [] parseContext+ args <- many parseWord+ spaces+ eof+ return (args, cxt')++ parseWord = do+ spaces+ many1 alphaNum++ parseContext = try $ do+ cxts <- parseParen parseContexts+ spaces+ _ <- string "=>"+ return cxts++ parseParen p = do+ spaces+ _ <- try ( char '(' )+ r <- p+ spaces+ _ <- try ( char ')' )+ return r++ parseContexts =+ sepBy1 (many1 parseWord) (spaces >> char ',' >> return ())++toClauses :: MakeMessageOpts -> String -> (Lang, [Def]) -> Q [Clause] +toClauses opts@(MkMakeMessageOpts {mmConPrefix = prefix}) dt (lang, defs) = mapM go defs where go def = do a <- newName "lang"- (pat, bod) <- mkBody dt (prefix ++ constr def) (map fst $ vars def) (content def)+ (pat, bod) <- mkBody opts dt (prefix ++ constr def) (map fst $ vars def) (content def) guard <- fmap NormalG [|$(return $ VarE a) == pack $(lift $ unpack lang)|] return $ Clause [WildP, conP (mkName ":") [VarP a, WildP], pat] (GuardedB [(guard, bod)]) [] -mkBody :: String -- ^ datatype+mkBody :: MakeMessageOpts+ -> String -- ^ datatype -> String -- ^ constructor -> [String] -- ^ variable names -> [Content] -> Q (Pat, Exp)-mkBody dt cs vs ct = do+mkBody (MkMakeMessageOpts {mmUseRecordCons = useRecord}) dt cs vs ct = do vp <- mapM go vs- let pat = RecP (mkName cs) (map (varName dt *** VarP) vp)+ let pat = if useRecord+ then RecP (mkName cs) (map (varName dt *** VarP) vp)+ else ConP (mkName cs) [] (map (VarP . snd) vp) let ct' = map (fixVars vp) ct pack' <- [|Data.Text.pack|] tomsg <- [|toMessage|]@@ -224,14 +316,11 @@ fixDeref vp (DerefIdent (Ident i)) = DerefIdent $ Ident $ fixIdent vp i fixDeref vp (DerefBranch a b) = DerefBranch (fixDeref vp a) (fixDeref vp b) fixDeref _ d = d- fixIdent vp i =- case lookup i vp of- Nothing -> i- Just y -> nameBase y+ fixIdent vp i = maybe i nameBase (lookup i vp) -sToClause :: String -> String -> SDef -> Q Clause-sToClause prefix dt sdef = do- (pat, bod) <- mkBody dt (prefix ++ sconstr sdef) (map fst $ svars sdef) (scontent sdef)+sToClause :: MakeMessageOpts -> String -> SDef -> Q Clause+sToClause opts@(MkMakeMessageOpts {mmConPrefix = prefix}) dt sdef = do+ (pat, bod) <- mkBody opts dt (prefix ++ sconstr sdef) (map fst $ svars sdef) (scontent sdef) return $ Clause [WildP, conP (mkName "[]") [], pat] (NormalB bod)@@ -255,11 +344,15 @@ conP = ConP #endif -toCon :: String -> SDef -> Con-toCon dt (SDef c vs _) =- RecC (mkName $ "Msg" ++ c) $ map go vs- where- go (n, t) = (varName dt n, notStrict, ConT $ mkName t)+toCon :: MakeMessageOpts -> String -> SDef -> Con+toCon (MkMakeMessageOpts {mmConPrefix = prefix, mmUseRecordCons = useRecord}) dt (SDef c vs _) =+ if useRecord+ then RecC nm $ map goRec vs+ else NormalC nm $ map goNorm vs+ where+ goRec (n, t) = (varName dt n, notStrict, ConT $ mkName t)+ goNorm (_, t) = (notStrict, ConT $ mkName t)+ nm = mkName $ prefix ++ c varName :: String -> String -> Name varName a y =@@ -358,8 +451,7 @@ loadLangFile file = do bs <- S.readFile file let s = unpack $ decodeUtf8 bs- defs <- fmap catMaybes $ mapM (parseDef . T.unpack . T.strip . T.pack) $ lines s- return defs+ fmap catMaybes $ mapM (parseDef . T.unpack . T.strip . T.pack) $ lines s parseDef :: String -> IO (Maybe Def) parseDef "" = return Nothing@@ -415,3 +507,59 @@ instanceD :: Cxt -> Type -> [Dec] -> Dec instanceD = InstanceD Nothing++-- | Opaque options type for 'mkMessage'+-- This is used to pass options to the 'mkMessage' function.+-- The options are not exposed directly to the user, but can be set using+-- the 'set*' functions, and the default can be made using 'defMakeMessageOpts'.+--+-- @since 2.1.6+data MakeMessageOpts = MkMakeMessageOpts+-- don't export constructor so that we can freely manipulate internals+ { mmGenType :: Bool+ , mmConPrefix :: String+ , mmTypeSuffix :: String+ , mmUseRecordCons :: Bool+ }++-- | Default options for 'mkMessage' are:+-- * @mmGenType@ = @True@+-- * @mmConPrefix@ = @\"Msg\"@+-- * @mmTypeSuffix@ = @\"Message\"@+-- * @mmUseRecordCons@ = @True@+--+-- @since 2.1.6+defMakeMessageOpts :: MakeMessageOpts+defMakeMessageOpts = MkMakeMessageOpts+ { mmGenType = True+ , mmConPrefix = "Msg"+ , mmTypeSuffix = "Message"+ , mmUseRecordCons = True+ }++-- | Whether to generate a new datatype from the constructors found in the .msg+-- files+--+-- @since 2.1.6+setGenType :: Bool -> MakeMessageOpts -> MakeMessageOpts+setGenType x opts = opts { mmGenType = x }++-- | Set the prefix for the constructor names+--+-- @since 2.1.6+setConPrefix :: String -> MakeMessageOpts -> MakeMessageOpts+setConPrefix x opts = opts { mmConPrefix = x }++-- | Set the suffix for the datatype name+--+-- @since 2.1.6+setTypeSuffix :: String -> MakeMessageOpts -> MakeMessageOpts+setTypeSuffix x opts = opts { mmTypeSuffix = x }++-- | Set whether to use record constructors or normal constructors.+-- If you are getting partial-fields warnings you want to remove, set this to+-- 'False'. If you want to use record syntax, set this to 'True'.+--+-- @since 2.1.6+setUseRecordCons :: Bool -> MakeMessageOpts -> MakeMessageOpts+setUseRecordCons x opts = opts { mmUseRecordCons = x }
+ other-messages/en.msg view
@@ -0,0 +1,29 @@+NotAnAdminRR: You must be an administrator to access this page. + +WelcomeHomepageRR: Welcome to the homepage +SeeArchiveRR: See the archive + +NoEntriesRR: There are no entries in the blog +LoginToPostRR: Admins can login to post +NewEntryRR: Post to blog +NewEntryTitleRR: Title +NewEntryContentRR: Content + +PleaseCorrectEntryRR: Your submitted entry had some errors, please correct and try again. +EntryCreatedRR title@Text: Your new blog post, #{title}, has been created + +EntryTitleRR title@Text: Blog postRR: #{title} +CommentsHeadingRR: Comments +NoCommentsRR: There are no comments +AddCommentHeadingRR: Add a Comment +LoginToCommentRR: You must be logged in to comment +AddCommentButtonRR: Add comment + +CommentNameRR: Your display name +CommentTextRR: Comment +CommentAddedRR: Your comment has been added +PleaseCorrectCommentRR: Your submitted comment had some errors, please correct and try again. + +HomepageTitleRR: Yesod Blog Demo +BlogArchiveTitleRR: Blog Archive +
shakespeare.cabal view
@@ -1,5 +1,5 @@ name: shakespeare-version: 2.0.30+version: 2.2.0 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -22,11 +22,12 @@ build-type: Simple homepage: http://www.yesodweb.com/book/shakespearean-templates extra-source-files:+ other-messages/*.msg+ test-messages/*.msg test/reload.txt test/texts/*.text test/juliuses/*.julius test/juliuses/*.coffee- test-messages/*.msg test/cassiuses/*.cassius test/cassiuses/*.lucius test/hamlets/*.hamlet@@ -35,7 +36,7 @@ library default-language: Haskell2010- build-depends: base >= 4.12 && < 5+ build-depends: base >= 4.11 && < 5 , time >= 1 , containers , template-haskell >= 2.7@@ -43,7 +44,7 @@ , text >= 0.7 , process >= 1.0 , ghc-prim- , bytestring+ , bytestring >= 0.11.2 , directory >= 1.2 , aeson < 3 , blaze-markup@@ -128,6 +129,7 @@ type: exitcode-stdio-1.0 ghc-options: -Wall+ build-tool-depends: hspec-discover:hspec-discover build-depends: base >= 4.9 && < 5 , shakespeare , time >= 1
test/Text/HamletSpec.hs view
@@ -22,6 +22,11 @@ import Text.Blaze.Internal (preEscapedString) import Text.Blaze +data ExampleModal widget = ExampleModal + { modalHeader :: widget -> widget, + modalContent :: widget -> widget + } + spec = do it "empty" caseEmpty it "static" caseStatic @@ -499,6 +504,82 @@ 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 "Alpine.js multi-line attribute values #291" $ + helper "<div x-data=\"{\r\n search: '',\r\n\r\n items: ['foo', 'bar', 'baz'],\r\n\r\n get filteredItems() {\r\n return this.items.filter(\r\n i => i.startsWith(this.search)\r\n )\r\n }\r\n }\"></div>" + [hamlet| + $newline never + <div + x-data="{ + search: '', + + items: ['foo', 'bar', 'baz'], + + get filteredItems() { + return this.items.filter( + i => i.startsWith(this.search) + ) + } + }" + > + |] + + it "supports $component without binding" $ + let + container :: String -> HtmlUrl url -> HtmlUrl url + container clazz x = + [hamlet| + $newline never + <div class="container #{clazz}"> + ^{x} + |] + in + helper "<div class=\"container alert\"><p>Hello world</p></div><p>outside</p>" + [hamlet| + $newline never + $component container "alert" + <p>Hello world + <p>outside + |] + + it "supports $component with binding (modal example)" $ + let + modalWidget :: (ExampleModal (HtmlUrl url) -> HtmlUrl url) -> HtmlUrl url + modalWidget body = + let + exampleModal = + ExampleModal + { modalHeader = \content -> + [hamlet| + $newline never + <div class="modal-header"> + ^{content} + |], + modalContent = \content -> + [hamlet| + $newline never + <div class="modal-content"> + ^{content} + |] + } + in + [hamlet| + $newline never + <div class="modal"> + ^{body exampleModal} + |] + in + helper "<div class=\"modal\"><div class=\"modal-header\"><h1>This is the title</h1></div><div class=\"modal-content\"><p>This is the content</p></div></div><p>outside</p>" + [hamlet| + $newline never + $component modal <- modalWidget + $component modalHeader modal + <h1>This is the title + + $component modalContent modal + <p>This is the content + <p>outside + |] it "runtime Hamlet with caret interpolation" $ do let toInclude render = render (5, [("hello", "world")])
test/Text/Shakespeare/BaseSpec.hs view
@@ -33,6 +33,25 @@ (DerefBranch (DerefIdent (Ident "+")) (DerefIdent (Ident "a"))) (DerefIdent (Ident "b")))) + it "parseDeref parse expressions with record dot" $ do+ runParser parseDeref () "" "x.y" `shouldBe`+ Right (DerefGetField (DerefIdent (Ident "x")) "y")++ it "parseDeref parse expressions with multiple record dots" $ do+ runParser parseDeref () "" "x.y.z" `shouldBe`+ Right (DerefGetField (DerefGetField (DerefIdent (Ident "x")) "y") "z")++ it "parseDeref dot surrounded by whitespace" $ do+ runParser parseDeref () "" "x . y" `shouldBe`+ Right+ (DerefBranch+ (DerefBranch (DerefIdent (Ident ".")) (DerefIdent (Ident "x")))+ (DerefIdent (Ident "y")))++ it "parseDeref parse expressions with parenthesized record dot" $ do+ runParser parseDeref () "" "(x).y" `shouldBe`+ Right (DerefGetField (DerefIdent (Ident "x")) "y")+ it "preFilter off" $ do preFilterN defaultShakespeareSettings template `shouldReturn` template
test/Text/Shakespeare/I18NSpec.hs view
@@ -1,16 +1,57 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+ module Text.Shakespeare.I18NSpec ( spec ) where import Data.Text (Text) import Text.Shakespeare.I18N+import Test.Hspec -spec :: Monad m => m ()-spec = return ()+class YesodSubApp master where -data Test = Test+instance YesodSubApp () -mkMessage "Test" "test-messages" "en"+newtype SubApp master = SubApp master++instance YesodSubApp (SubApp master)++data Test a b++mkMessage "(YesodSubApp master) => SubApp master" "other-messages" "en" ++mkMessage "Test a b" "test-messages" "en"++newtype SubAppNoRec master = SubAppNoRec master++instance YesodSubApp (SubAppNoRec master)++data TestNoRec++mkMessageOpts+ (setConPrefix "MsgNR" $ setUseRecordCons False defMakeMessageOpts)+ "(YesodSubApp master) => SubAppNoRec master"+ "(YesodSubApp master) => SubAppNoRec master"+ "other-messages"+ "en"++mkMessageOpts+ (setConPrefix "MsgNR" $ setUseRecordCons False defMakeMessageOpts)+ "TestNoRec"+ "TestNoRec"+ "test-messages"+ "en"++spec :: Spec+spec = do+ describe "I18N" $ do+ it "should generate messages with record constructors" $ do+ let msg = MsgEntryCreatedRR { subAppMessageTitle = "foo" }+ renderMessage (SubApp ()) [] msg `shouldBe` "Your new blog post, foo, has been created"++ it "should generate messages without record constructors" $ do+ let msg = MsgNREntryCreatedRR "bar"+ renderMessage (SubAppNoRec ()) [] msg `shouldBe` "Your new blog post, bar, has been created"
test/Text/Shakespeare/TextSpec.hs view
@@ -1,7 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} module Text.Shakespeare.TextSpec (spec) where +import HamletTestTypes (ARecord(..)) + import Test.HUnit hiding (Test) import Test.Hspec @@ -122,6 +125,12 @@ let val = 2 :: Int let bld = [builderQQ|#{ show val }|] simpT "2" $ toLazyText [builderQQ|^{ bld }|] + +#if MIN_VERSION_template_haskell(2,18,0) + it "record dot" $ do + let z = ARecord 22 True + telper "221" [text|#{z.field1}#{fromEnum z.field2}|] +#endif simpT :: String -> TL.Text -> Assertion simpT a b = nocrlf (pack a) @=? nocrlf (TL.toStrict b)