shakespeare 2.1.1 → 2.1.3
raw patch · 6 files changed
+110/−88 lines, 6 files
Files
- ChangeLog.md +7/−2
- Text/Shakespeare/Base.hs +10/−46
- Text/Shakespeare/I18N.hs +69/−13
- shakespeare.cabal +1/−1
- test/Text/Shakespeare/BaseSpec.hs +1/−25
- test/Text/Shakespeare/I18NSpec.hs +22/−1
ChangeLog.md view
@@ -1,8 +1,13 @@ # ChangeLog for shakespeare -### 2.1.1+### 2.1.3 -* Add support for `TypeApplications` inside Shakespeare quasiquotes+* [#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
Text/Shakespeare/Base.hs view
@@ -29,7 +29,7 @@ import Language.Haskell.TH.Syntax hiding (makeRelativeToProject) import Language.Haskell.TH (appE)-import Data.Char (isUpper, isSymbol, isPunctuation, isAscii, isLower, isNumber)+import Data.Char (isUpper, isSymbol, isPunctuation, isAscii) import Data.FileEmbed (makeRelativeToProject) import Text.ParserCombinators.Parsec import Text.Parsec.Prim (Parsec)@@ -41,8 +41,6 @@ import qualified System.IO as SIO import qualified Data.Text.Lazy.IO as TIO import Control.Monad (when)-import Data.Maybe (mapMaybe)-import Data.List.NonEmpty (nonEmpty, NonEmpty ((:|))) newtype Ident = Ident String deriving (Show, Eq, Read, Data, Typeable, Ord, Lift)@@ -57,7 +55,6 @@ | DerefBranch Deref Deref | DerefList [Deref] | DerefTuple [Deref]- | DerefType String | DerefGetField Deref String -- ^ Record field access via @OverloadedRecordDot@. 'derefToExp' only supports this -- feature on compilers which support @OverloadedRecordDot@.@@ -96,7 +93,7 @@ -- See: http://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-160002.2 isOperatorChar c- | isAscii c = c `elem` "!#$%&*+./<=>?\\^|-~:"+ | isAscii c = c `elem` "!#$%&*+./<=>?@\\^|-~:" | otherwise = isSymbol c || isPunctuation c derefPrefix x = do@@ -106,7 +103,7 @@ derefInfix x = try $ do _ <- delim xs <- many $ try $ derefSingle >>= \x' -> delim >> return x'- op <- (many1 (satisfy isOperatorChar) <* lookAhead (oneOf " \t")) <?> "operator"+ op <- many1 (satisfy isOperatorChar) <?> "operator" -- special handling for $, which we don't deal with when (op == "$") $ fail "don't handle $" let op' = DerefIdent $ Ident op@@ -114,21 +111,9 @@ skipMany $ oneOf " \t" return $ DerefBranch (DerefBranch op' $ foldl1 DerefBranch $ x : xs) (foldl1 DerefBranch ys) derefSingle = do- x <- derefType <|> derefTuple <|> derefList <|> derefOp <|> derefParens <|> numeric <|> fmap DerefString strLit <|> ident+ x <- derefTuple <|> derefList <|> derefOp <|> derefParens <|> numeric <|> strLit <|> ident fields <- many recordDot pure $ foldl DerefGetField x fields- tyNameOrVar = liftA2 (:) (alphaNum <|> char '\'') (many (alphaNum <|> char '_' <|> char '\''))- derefType = try $ do- _ <- char '@' >> notFollowedBy (oneOf " \t")- x <-- try tyNameOrVar- <|> try (string "()")- <|> try strLit- <|> between- (char '(')- (char ')')- (unwords <$> many ((try tyNameOrVar <|> try strLitQuoted) <* many (oneOf " \t")))- pure $ DerefType x recordDot = do _ <- char '.' x <- lower <|> char '_'@@ -154,8 +139,11 @@ Nothing -> DerefIntegral $ read' "Integral" $ n ++ x Just z -> DerefRational $ toRational (read' "Rational" $ n ++ x ++ '.' : z :: Double)- strLitQuoted = liftA2 (:) (char '"') (many quotedChar) <> fmap pure (char '"')- strLit = char '"' *> many quotedChar <* char '"'+ strLit = do+ _ <- char '"'+ chars <- many quotedChar+ _ <- char '"'+ return $ DerefString chars quotedChar = (char '\\' >> escapedChar) <|> noneOf "\"" escapedChar = let cecs = [('n', '\n'), ('r', '\r'), ('b', '\b'), ('t', '\t')@@ -185,31 +173,8 @@ expType (Ident (c:_)) = if isUpper c || c == ':' then ConE else VarE expType (Ident "") = error "Bad Ident" -strType :: String -> Type-strType t0 = case t0 of- "" -> ConT ''()- hd : tl- | all isNumber t0 -> LitT (NumTyLit (read t0))- | isLower hd -> VarT (mkName (hd : tl))- | otherwise -> ConT (mkName (hd : tl))--strTypeWords :: String -> Type-strTypeWords t = case words t of- [] -> ConT ''()- [ty] -> strType ty- ts@(ty : tys)- | not (null ty)- && head ty == '\"'- && not (null (last ts))- && last (last ts) == '\"' ->- LitT (StrTyLit t)- | otherwise -> foldl AppT (strType ty) (map strType tys)- derefToExp :: Scope -> Deref -> Exp-derefToExp s (DerefBranch x y) = case y of- DerefBranch (DerefType t) y' -> derefToExp s x `AppTypeE` strTypeWords t `AppE` derefToExp s y'- DerefType t -> derefToExp s x `AppTypeE` strTypeWords t- _ -> derefToExp s x `AppE` derefToExp s y+derefToExp s (DerefBranch x y) = derefToExp s x `AppE` derefToExp s y derefToExp _ (DerefModulesIdent mods i@(Ident s)) = expType i $ Name (mkOccName s) (NameQ $ mkModName $ intercalate "." mods) derefToExp scope (DerefIdent i@(Ident s)) =@@ -219,7 +184,6 @@ derefToExp _ (DerefIntegral i) = LitE $ IntegerL i derefToExp _ (DerefRational r) = LitE $ RationalL r derefToExp _ (DerefString s) = LitE $ StringL s-derefToExp _ (DerefType _) = error "exposed type application" derefToExp s (DerefList ds) = ListE $ map (derefToExp s) ds derefToExp s (DerefTuple ds) = TupE $ #if MIN_VERSION_template_haskell(2,16,0)
Text/Shakespeare/I18N.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ExistentialQuantification #-} @@ -62,7 +63,6 @@ ) 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 +72,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)) @@ -165,22 +165,79 @@ 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+ let mname = mkName $ dt2 ++ postfix+ c1 <- fmap concat $ mapM (toClauses prefix dt2 ) contents'+ c2 <- mapM (sToClause prefix dt2) sdef c3 <- defClause return $ ( if genType- then ((DataD [] mname [] Nothing (map (toCon dt) sdef) []) :)+ then ((DataD [] mname [] Nothing (map (toCon 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' + us1 = filter (/= ' ') us in ParensT (ConT (mkName ts) + `AppT` VarT (mkName us1)) + 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' | 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]+ 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 :: String -> String -> (Lang, [Def]) -> Q [Clause] toClauses prefix dt (lang, defs) = mapM go defs where@@ -358,8 +415,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
shakespeare.cabal view
@@ -1,5 +1,5 @@ name: shakespeare-version: 2.1.1+version: 2.1.3 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>
test/Text/Shakespeare/BaseSpec.hs view
@@ -33,31 +33,6 @@ (DerefBranch (DerefIdent (Ident "+")) (DerefIdent (Ident "a"))) (DerefIdent (Ident "b")))) - it "parseDeref parse single type applications" $ do- runParser parseDeref () "" "x @y" `shouldBe`- Right- (DerefBranch- (DerefIdent (Ident "x"))- (DerefType "y"))- it "parseDeref parse unit type applications" $ do- runParser parseDeref () "" "x @()" `shouldBe`- Right- (DerefBranch- (DerefIdent (Ident "x"))- (DerefType "()"))- it "parseDeref parse compound type applications" $ do- runParser parseDeref () "" "x @(Maybe String)" `shouldBe`- Right- (DerefBranch- (DerefIdent (Ident "x"))- (DerefType "Maybe String"))- it "parseDeref parse single @ as operator" $ do- runParser parseDeref () "" "x @ y" `shouldBe`- Right- (DerefBranch- (DerefBranch (DerefIdent (Ident "@")) (DerefIdent (Ident "x")))- (DerefIdent (Ident "y")))- it "parseDeref parse expressions with record dot" $ do runParser parseDeref () "" "x.y" `shouldBe` Right (DerefGetField (DerefIdent (Ident "x")) "y")@@ -131,3 +106,4 @@ eShowErrors :: Either ParseError c -> c eShowErrors = either (error . show) id+
test/Text/Shakespeare/I18NSpec.hs view
@@ -1,16 +1,37 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+ module Text.Shakespeare.I18NSpec ( spec ) where import Data.Text (Text) import Text.Shakespeare.I18N+import Language.Haskell.TH.Syntax+import Test.Hspec +class Lift master => YesodSubApp master where+ data YesodSubAppData master :: *++newtype SubApp master = SubApp+ {+ getOrdering :: Ordering+ }++data Test = Test++class Testable a where+ isTestable :: a -> Bool ++instance Testable Test where + isTestable Test = True+ spec :: Monad m => m () spec = return () -data Test = Test+mkMessage "(YesodSubApp master) => SubApp master" "other-messages" "en" mkMessage "Test" "test-messages" "en"+