This is the content +``` + +Conceptually, this desugars to: + +```haskell +^{ modalWidget $ \modal -> + [whamlet| + ^{ modalHeader modal [whamlet|
This is the content |] } + |] + } +
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.
diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
--- a/Text/Hamlet.hs
+++ b/Text/Hamlet.hs
@@ -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"
diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs
--- a/Text/Hamlet/Parse.hs
+++ b/Text/Hamlet/Parse.hs
@@ -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
diff --git a/Text/Hamlet/RT.hs b/Text/Hamlet/RT.hs
--- a/Text/Hamlet/RT.hs
+++ b/Text/Hamlet/RT.hs
@@ -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
diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs
--- a/Text/Shakespeare/Base.hs
+++ b/Text/Shakespeare/Base.hs
@@ -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]
diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs
--- a/Text/Shakespeare/I18N.hs
+++ b/Text/Shakespeare/I18N.hs
@@ -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 }
diff --git a/other-messages/en.msg b/other-messages/en.msg
new file mode 100644
--- /dev/null
+++ b/other-messages/en.msg
@@ -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
+
diff --git a/shakespeare.cabal b/shakespeare.cabal
--- a/shakespeare.cabal
+++ b/shakespeare.cabal
@@ -1,5 +1,5 @@
name: shakespeare
-version: 2.0.30
+version: 2.2.0
license: MIT
license-file: LICENSE
author: Michael Snoyman Hello world outside Hello world
+ 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
+