diff --git a/yesod-core/Yesod/Message.hs b/yesod-core/Yesod/Message.hs
index b84f3e86..aa4fb749 100644
--- a/yesod-core/Yesod/Message.hs
+++ b/yesod-core/Yesod/Message.hs
@@ -1,259 +1,5 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE ExistentialQuantification #-}
 module Yesod.Message
-    ( mkMessage
-    , RenderMessage (..)
-    , ToMessage (..)
-    , SomeMessage (..)
+    ( module Text.Shakespeare.I18N
     ) where
 
-import Language.Haskell.TH.Syntax
-import Data.Text (Text, pack, unpack)
-import System.Directory
-import Data.Maybe (catMaybes)
-import Data.List (isSuffixOf, sortBy, foldl')
-import qualified Data.ByteString as S
-import Data.Text.Encoding (decodeUtf8)
-import Data.Char (isSpace, toLower, toUpper)
-import Data.Ord (comparing)
-import Text.Shakespeare.Base (Deref (..), Ident (..), parseHash, derefToExp)
-import Text.ParserCombinators.Parsec (parse, many, eof, many1, noneOf, (<|>))
-import Control.Arrow ((***))
-import Data.Monoid (mempty, mappend)
-import qualified Data.Text as T
-import Data.String (IsString (fromString))
-
-class ToMessage a where
-    toMessage :: a -> Text
-instance ToMessage Text where
-    toMessage = id
-instance ToMessage String where
-    toMessage = Data.Text.pack
-
-class RenderMessage master message where
-    renderMessage :: master
-                  -> [Text] -- ^ languages
-                  -> message
-                  -> Text
-
-instance RenderMessage master Text where
-    renderMessage _ _ = id
-
-type Lang = Text
-
-mkMessage :: String
-          -> FilePath
-          -> Lang
-          -> Q [Dec]
-mkMessage dt folder lang = do
-    files <- qRunIO $ getDirectoryContents folder
-    contents <- qRunIO $ fmap catMaybes $ mapM (loadLang folder) files
-    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 dt' = ConT $ mkName dt
-    let mname = mkName $ dt ++ "Message"
-    c1 <- fmap concat $ mapM (toClauses dt) contents
-    c2 <- mapM (sToClause dt) sdef
-    c3 <- defClause
-    return
-        [ DataD [] mname [] (map (toCon dt) sdef) []
-        , InstanceD
-            []
-            (ConT ''RenderMessage `AppT` dt' `AppT` ConT mname)
-            [ FunD (mkName "renderMessage") $ c1 ++ c2 ++ [c3]
-            ]
-        ]
-
-toClauses :: String -> (Lang, [Def]) -> Q [Clause]
-toClauses dt (lang, defs) =
-    mapM go defs
-  where
-    go def = do
-        a <- newName "lang"
-        (pat, bod) <- mkBody dt (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
-       -> String -- ^ constructor
-       -> [String] -- ^ variable names
-       -> [Content]
-       -> Q (Pat, Exp)
-mkBody dt cs vs ct = do
-    vp <- mapM go vs
-    let pat = RecP (mkName $ "Msg" ++ cs) (map (varName dt *** VarP) vp)
-    let ct' = map (fixVars vp) ct
-    pack' <- [|Data.Text.pack|]
-    tomsg <- [|toMessage|]
-    let ct'' = map (toH pack' tomsg) ct'
-    mapp <- [|mappend|]
-    let app a b = InfixE (Just a) mapp (Just b)
-    e <-
-        case ct'' of
-            [] -> [|mempty|]
-            [x] -> return x
-            (x:xs) -> return $ foldl' app x xs
-    return (pat, e)
-  where
-    toH pack' _ (Raw s) = pack' `AppE` SigE (LitE (StringL s)) (ConT ''String)
-    toH _ tomsg (Var d) = tomsg `AppE` derefToExp [] d
-    go x = do
-        let y = mkName $ '_' : x
-        return (x, y)
-    fixVars vp (Var d) = Var $ fixDeref vp d
-    fixVars _ (Raw s) = Raw s
-    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
-
-sToClause :: String -> SDef -> Q Clause
-sToClause dt sdef = do
-    (pat, bod) <- mkBody dt (sconstr sdef) (map fst $ svars sdef) (scontent sdef)
-    return $ Clause
-        [WildP, ConP (mkName "[]") [], pat]
-        (NormalB bod)
-        []
-
-defClause :: Q Clause
-defClause = do
-    a <- newName "sub"
-    c <- newName "langs"
-    d <- newName "msg"
-    rm <- [|renderMessage|]
-    return $ Clause
-        [VarP a, ConP (mkName ":") [WildP, VarP c], VarP d]
-        (NormalB $ rm `AppE` VarE a `AppE` VarE c `AppE` VarE d)
-        []
-
-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)
-
-varName :: String -> String -> Name
-varName a y =
-    mkName $ concat [lower a, "Message", upper y]
-  where
-    lower (x:xs) = toLower x : xs
-    lower [] = []
-    upper (x:xs) = toUpper x : xs
-    upper [] = []
-
-checkDef :: [SDef] -> [Def] -> Q ()
-checkDef x y =
-    go (sortBy (comparing sconstr) x) (sortBy (comparing constr) y)
-  where
-    go _ [] = return ()
-    go [] (b:_) = error $ "Extra message constructor: " ++ constr b
-    go (a:as) (b:bs)
-        | sconstr a < constr b = go as (b:bs)
-        | sconstr a > constr b = error $ "Extra message constructor: " ++ constr b
-        | otherwise = do
-            go' (svars a) (vars b)
-            go as bs
-    go' ((an, at):as) ((bn, mbt):bs)
-        | an /= bn = error "Mismatched variable names"
-        | otherwise =
-            case mbt of
-                Nothing -> go' as bs
-                Just bt
-                    | at == bt -> go' as bs
-                    | otherwise -> error "Mismatched variable types"
-    go' [] [] = return ()
-    go' _ _ = error "Mistmached variable count"
-
-toSDefs :: [Def] -> Q [SDef]
-toSDefs = mapM toSDef
-
-toSDef :: Def -> Q SDef
-toSDef d = do
-    vars' <- mapM go $ vars d
-    return $ SDef (constr d) vars' (content d)
-  where
-    go (a, Just b) = return (a, b)
-    go (a, Nothing) = error $ "Main language missing type for " ++ show (constr d, a)
-
-data SDef = SDef
-    { sconstr :: String
-    , svars :: [(String, String)]
-    , scontent :: [Content]
-    }
-
-data Def = Def
-    { constr :: String
-    , vars :: [(String, Maybe String)]
-    , content :: [Content]
-    }
-
-loadLang :: FilePath -> FilePath -> IO (Maybe (Lang, [Def]))
-loadLang folder file = do
-    let file' = folder ++ '/' : file
-    e <- doesFileExist file'
-    if e && ".msg" `isSuffixOf` file
-        then do
-            let lang = pack $ reverse $ drop 4 $ reverse file
-            bs <- S.readFile file'
-            let s = unpack $ decodeUtf8 bs
-            defs <- fmap catMaybes $ mapM parseDef $ lines s
-            return $ Just (lang, defs)
-        else return Nothing
-
-parseDef :: String -> IO (Maybe Def)
-parseDef "" = return Nothing
-parseDef ('#':_) = return Nothing
-parseDef s =
-    case end of
-        ':':end' -> do
-            content' <- fmap compress $ parseContent $ dropWhile isSpace end'
-            case words begin of
-                [] -> error $ "Missing constructor: " ++ s
-                (w:ws) -> return $ Just Def
-                            { constr = w
-                            , vars = map parseVar ws
-                            , content = content'
-                            }
-        _ -> error $ "Missing colon: " ++ s
-  where
-    (begin, end) = break (== ':') s
-
-data Content = Var Deref | Raw String
-
-compress :: [Content] -> [Content]
-compress [] = []
-compress (Raw a:Raw b:rest) = compress $ Raw (a ++ b) : rest
-compress (x:y) = x : compress y
-
-parseContent :: String -> IO [Content]
-parseContent s =
-    either (error . show) return $ parse go s s
-  where
-    go = do
-        x <- many go'
-        eof
-        return x
-    go' = (Raw `fmap` many1 (noneOf "#")) <|> (fmap (either Raw Var) parseHash)
-
-parseVar :: String -> (String, Maybe String)
-parseVar s =
-    case break (== '@') s of
-        (x, '@':y) -> (x, Just y)
-        _ -> (s, Nothing)
-
-data SomeMessage master = forall msg. RenderMessage master msg => SomeMessage msg
-
-instance IsString (SomeMessage master) where
-    fromString = SomeMessage . T.pack
+import Text.Shakespeare.I18N
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index 723b5e71..f50af8bc 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -56,6 +56,7 @@ library
                    , shakespeare           >= 0.10     && < 0.11
                    , shakespeare-js        >= 0.10     && < 0.11
                    , shakespeare-css       >= 0.10     && < 0.11
+                   , shakespeare-i18n      >= 0.0      && < 0.1
                    , blaze-builder         >= 0.2.1.4  && < 0.4
                    , transformers          >= 0.2.2    && < 0.3
                    , clientsession         >= 0.7.3.1  && < 0.8