diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2015 Tobias Dammers +Copyright (c) 2015-2016 Tobias Dammers Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/ginger.cabal b/ginger.cabal --- a/ginger.cabal +++ b/ginger.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: ginger -version: 0.2.5.0 +version: 0.2.6.0 synopsis: An implementation of the Jinja2 template language in Haskell description: Ginger is Jinja, minus the most blatant pythonisms. Wants to be feature complete, but isn't quite there yet. @@ -22,6 +22,7 @@ , Text.Ginger.AST , Text.Ginger.GVal , Text.Ginger.Html + , Text.Ginger.Optimizer , Text.Ginger.Parse , Text.Ginger.Run , Text.PrintfA @@ -71,6 +72,8 @@ , mtl , tasty , tasty-hunit + , tasty-quickcheck , text , transformers + , unordered-containers >= 0.2.5 , utf8-string diff --git a/src/Text/Ginger.hs b/src/Text/Ginger.hs --- a/src/Text/Ginger.hs +++ b/src/Text/Ginger.hs @@ -277,11 +277,14 @@ -- | The data structures used to represent templates, statements and -- expressions internally. , module Text.Ginger.AST + +-- *** Optimizer +-- | An optimizing AST rewriter +, module Text.Ginger.Optimizer ) where import Text.Ginger.Parse +import Text.Ginger.Optimizer import Text.Ginger.AST import Text.Ginger.Run import Text.Ginger.GVal - - diff --git a/src/Text/Ginger/GVal.hs b/src/Text/Ginger/GVal.hs --- a/src/Text/Ginger/GVal.hs +++ b/src/Text/Ginger/GVal.hs @@ -126,7 +126,7 @@ -- Note that the default conversions will never return booleans unless 'asJSON' -- explicitly does this, because 'asText' will always return *something*. instance JSON.ToJSON (GVal m) where - toJSON g = + toJSON g = if isNull g then JSON.Null else (fromMaybe (JSON.toJSON $ asText g) $ diff --git a/src/Text/Ginger/Optimizer.hs b/src/Text/Ginger/Optimizer.hs new file mode 100644 --- /dev/null +++ b/src/Text/Ginger/Optimizer.hs @@ -0,0 +1,69 @@ +-- | A syntax tree optimizer +module Text.Ginger.Optimizer +( Optimizable (..) ) +where + +import Text.Ginger.AST +import Data.Monoid + +class Optimizable a where + optimize :: a -> a + +instance Optimizable Template where + optimize = optimizeTemplate + +instance Optimizable Statement where + optimize = optimizeStatement + +instance Optimizable Block where + optimize = optimizeBlock + +instance Optimizable Macro where + optimize = optimizeMacro + +optimizeTemplate t = + t { templateBody = optimize $ templateBody t + , templateBlocks = fmap optimize $ templateBlocks t + , templateParent = fmap optimize $ templateParent t + } + +{- + = MultiS [Statement] -- ^ A sequence of multiple statements + | ScopedS Statement -- ^ Run wrapped statement in a local scope + | LiteralS Html -- ^ Literal output (anything outside of any tag) + | InterpolationS Expression -- ^ {{ expression }} + | IfS Expression Statement Statement -- ^ {% if expression %}statement{% else %}statement{% endif %} + | ForS (Maybe VarName) VarName Expression Statement -- ^ {% for index, varname in expression %}statement{% endfor %} + | SetVarS VarName Expression -- ^ {% set varname = expr %} + | DefMacroS VarName Macro -- ^ {% macro varname %}statements{% endmacro %} + | BlockRefS VarName + | PreprocessedIncludeS Template -- ^ {% include "template" %} + | NullS -- ^ The do-nothing statement (NOP) +-} +optimizeStatement (MultiS items) = + case optimizeStatementList items of + [] -> NullS + [x] -> x + xs -> MultiS xs +optimizeStatement s = s + +optimizeBlock (Block b) = Block $ optimize b + +optimizeMacro (Macro args body) = Macro args (optimize body) + +optimizeStatementList = + mergeLiterals . + cullNulls . + fmap optimize + +cullNulls :: [Statement] -> [Statement] +cullNulls = filter (not . isNullS) + where + isNullS NullS = True + isNullS _ = False + +mergeLiterals :: [Statement] -> [Statement] +mergeLiterals [] = [] +mergeLiterals [x] = [x] +mergeLiterals (x@(LiteralS a):y@(LiteralS b):xs) = mergeLiterals $ (LiteralS $ a <> b):xs +mergeLiterals (x:xs) = x:mergeLiterals xs diff --git a/src/Text/Ginger/Run.hs b/src/Text/Ginger/Run.hs --- a/src/Text/Ginger/Run.hs +++ b/src/Text/Ginger/Run.hs @@ -31,6 +31,7 @@ , makeContextText , makeContextTextM , Run, liftRun, liftRun2 +, extractArgs, extractArgsT, extractArgsL, extractArgsDefL ) where @@ -51,6 +52,8 @@ , seq , fst, snd , maybe + , Either (..) + , id ) import qualified Prelude import Data.Maybe (fromMaybe, isJust) @@ -80,6 +83,8 @@ import Safe (readMay, lastDef, headMay) import Network.HTTP.Types (urlEncode) import Debug.Trace (trace) +import Data.Maybe (isNothing) +import Data.List (lookup, zipWith, unzip) -- | Execution context. Determines how to look up variables from the -- environment, and how to write out template output. @@ -132,6 +137,68 @@ args' :: [Text] args' = Prelude.map (asText . snd) args +-- | Match args according to a given arg spec, Python style. +-- The return value is a triple of @(matched, args, kwargs, unmatchedNames)@, +-- where @matches@ is a hash map of named captured arguments, args is a list of +-- remaining unmatched positional arguments, kwargs is a list of remaining +-- unmatched named arguments, and @unmatchedNames@ contains the argument names +-- that haven't been matched. +extractArgs :: [Text] -> [(Maybe Text, a)] -> (HashMap Text a, [a], HashMap Text a, [Text]) +extractArgs argNames args = + let (matchedPositional, argNames', args') = matchPositionalArgs argNames args + (matchedKeyword, argNames'', args'') = matchKeywordArgs argNames' args' + unmatchedPositional = [ a | (Nothing, a) <- args'' ] + unmatchedKeyword = HashMap.fromList [ (k, v) | (Just k, v) <- args'' ] + in ( HashMap.fromList (matchedPositional ++ matchedKeyword) + , unmatchedPositional + , unmatchedKeyword + , argNames'' + ) + where + matchPositionalArgs :: [Text] -> [(Maybe Text, a)] -> ([(Text, a)], [Text], [(Maybe Text, a)]) + matchPositionalArgs [] args = ([], [], args) + matchPositionalArgs names [] = ([], names, []) + matchPositionalArgs names@(n:ns) allArgs@((anm, arg):args) + | Just n == anm || isNothing anm = + let (matched, ns', args') = matchPositionalArgs ns args + in ((n, arg):matched, ns', args') + | otherwise = ([], names, allArgs) + + matchKeywordArgs :: [Text] -> [(Maybe Text, a)] -> ([(Text, a)], [Text], [(Maybe Text, a)]) + matchKeywordArgs [] args = ([], [], args) + matchKeywordArgs names allArgs@((Nothing, arg):args) = + let (matched, ns', args') = matchKeywordArgs names args + in (matched, ns', (Nothing, arg):args') + matchKeywordArgs names@(n:ns) args = + case (lookup (Just n) args) of + Nothing -> + let (matched, ns', args') = matchKeywordArgs ns args + in (matched, n:ns', args') + Just v -> + let args' = [ (k,v) | (k,v) <- args, k /= Just n ] + (matched, ns', args'') = matchKeywordArgs ns args' + in ((n,v):matched, ns', args'') + +-- | Parse argument list into type-safe argument structure. +extractArgsT :: ([Maybe a] -> b) -> [Text] -> [(Maybe Text, a)] -> Either ([a], HashMap Text a, [Text]) b +extractArgsT f argNames args = + let (matchedMap, freeArgs, freeKwargs, unmatched) = extractArgs argNames args + in if List.null freeArgs && HashMap.null freeKwargs + then Right (f $ fmap (\name -> HashMap.lookup name matchedMap) argNames) + else Left (freeArgs, freeKwargs, unmatched) + +-- | Parse argument list into flat list of matched arguments. +extractArgsL :: [Text] -> [(Maybe Text, a)] -> Either ([a], HashMap Text a, [Text]) [Maybe a] +extractArgsL = extractArgsT id + +extractArgsDefL :: [(Text, a)] -> [(Maybe Text, a)] -> Either ([a], HashMap Text a, [Text]) [a] +extractArgsDefL argSpec args = + let (names, defs) = unzip argSpec + in injectDefaults defs <$> extractArgsL names args + +injectDefaults :: [a] -> [Maybe a] -> [a] +injectDefaults = zipWith fromMaybe + defRunState :: forall m h. (Monoid h, Monad m) => Template -> RunState m h defRunState tpl = RunState @@ -148,42 +215,43 @@ , ("any", fromFunction gfnAny) , ("all", fromFunction gfnAll) -- TODO: batch - , ("ceil", fromFunction . unaryNumericFunc 0 $ Prelude.fromIntegral . Prelude.ceiling) , ("capitalize", fromFunction . variadicStringFunc $ mconcat . Prelude.map capitalize) + , ("ceil", fromFunction . unaryNumericFunc 0 $ Prelude.fromIntegral . Prelude.ceiling) , ("center", fromFunction gfnCenter) , ("concat", fromFunction . variadicStringFunc $ mconcat) , ("contains", fromFunction gfnContains) - , ("default", fromFunction gfnDefault) , ("d", fromFunction gfnDefault) + , ("default", fromFunction gfnDefault) , ("difference", fromFunction . variadicNumericFunc 0 $ difference) - , ("escape", fromFunction gfnEscape) , ("e", fromFunction gfnEscape) + , ("equals", fromFunction gfnEquals) + , ("escape", fromFunction gfnEscape) , ("filesizeformat", fromFunction gfnFileSizeFormat) , ("filter", fromFunction gfnFilter) - , ("equals", fromFunction gfnEquals) - , ("nequals", fromFunction gfnNEquals) - , ("greaterEquals", fromFunction gfnGreaterEquals) - , ("lessEquals", fromFunction gfnLessEquals) - , ("greater", fromFunction gfnGreater) - , ("less", fromFunction gfnLess) , ("floor", fromFunction . unaryNumericFunc 0 $ Prelude.fromIntegral . Prelude.floor) + , ("greater", fromFunction gfnGreater) + , ("greaterEquals", fromFunction gfnGreaterEquals) , ("int", fromFunction . unaryFunc $ toGVal . (fmap (Prelude.truncate :: Scientific -> Int)) . asNumber) , ("int_ratio", fromFunction . variadicNumericFunc 1 $ fromIntegral . intRatio . Prelude.map Prelude.floor) , ("iterable", fromFunction . unaryFunc $ toGVal . (\x -> isList x || isDict x)) , ("length", fromFunction . unaryFunc $ toGVal . length) + , ("less", fromFunction gfnLess) + , ("lessEquals", fromFunction gfnLessEquals) , ("modulo", fromFunction . variadicNumericFunc 1 $ fromIntegral . modulo . Prelude.map Prelude.floor) + , ("nequals", fromFunction gfnNEquals) , ("num", fromFunction . unaryFunc $ toGVal . asNumber) - , ("product", fromFunction . variadicNumericFunc 1 $ Prelude.product) , ("printf", fromFunction gfnPrintf) + , ("product", fromFunction . variadicNumericFunc 1 $ Prelude.product) , ("ratio", fromFunction . variadicNumericFunc 1 $ Scientific.fromFloatDigits . ratio . Prelude.map Scientific.toRealFloat) + , ("replace", fromFunction $ gfnReplace) , ("round", fromFunction . unaryNumericFunc 0 $ Prelude.fromIntegral . Prelude.round) , ("show", fromFunction . unaryFunc $ fromString . show) , ("slice", fromFunction $ gfnSlice) + , ("sort", fromFunction $ gfnSort) , ("str", fromFunction . unaryFunc $ toGVal . asText) , ("sum", fromFunction . variadicNumericFunc 0 $ Prelude.sum) , ("truncate", fromFunction . unaryNumericFunc 0 $ Prelude.fromIntegral . Prelude.truncate) , ("urlencode", fromFunction $ gfnUrlEncode) - , ("sort", fromFunction $ gfnSort) ] gfnRawHtml :: Function (Run m h) @@ -315,41 +383,53 @@ return . toGVal $ center (asText s) (fromMaybe 80 $ Prelude.truncate <$> asNumber w) (asText pad) gfnSlice :: Function (Run m h) - gfnSlice [] = return def - gfnSlice [(Nothing, slicee)] = return slicee - gfnSlice [(Nothing, slicee), (Nothing, startPos)] = - gfnSlice [(Nothing, slicee), (Nothing, startPos), (Nothing, def)] - gfnSlice [(Nothing, slicee), (Nothing, startPos), (Nothing, length)] = do - case asDictItems slicee of - Just items -> do - let slicedItems = slice items startInt lengthInt - return $ dict slicedItems - Nothing -> do - let items = fromMaybe [] $ asList slicee - slicedItems = slice items startInt lengthInt - return $ toGVal slicedItems - where - startInt :: Int - startInt = fromMaybe 0 . fmap Prelude.round . asNumber $ startPos + gfnSlice args = + let argValues = + extractArgsDefL + [ ("slicee", def) + , ("start", def) + , ("length", def) + ] + args + in case argValues of + Right (slicee:startPos:length:[]) -> do + let startInt :: Int + startInt = fromMaybe 0 . fmap Prelude.round . asNumber $ startPos - lengthInt :: Maybe Int - lengthInt = fmap Prelude.round . asNumber $ length + lengthInt :: Maybe Int + lengthInt = fmap Prelude.round . asNumber $ length - slice :: [a] -> Int -> Maybe Int -> [a] - slice xs start Nothing = - Prelude.drop start $ xs - slice xs start (Just length) = - Prelude.take length . Prelude.drop start $ xs - gfnSlice ((Nothing, slicee):(Nothing, startPos):args) = - let length = fromMaybe def $ List.lookup (Just "length") args - in gfnSlice [(Nothing, slicee), (Nothing, startPos), (Nothing, length)] - gfnSlice ((Nothing, slicee):args) = - let startPos = fromMaybe def $ List.lookup (Just "start") args - in gfnSlice ((Nothing, slicee):(Nothing, startPos):args) - gfnSlice args = - let slicee = fromMaybe def $ List.lookup (Just "slicee") args - in gfnSlice ((Nothing, slicee):args) + slice :: [a] -> Int -> Maybe Int -> [a] + slice xs start Nothing = + Prelude.drop start $ xs + slice xs start (Just length) = + Prelude.take length . Prelude.drop start $ xs + case asDictItems slicee of + Just items -> do + let slicedItems = slice items startInt lengthInt + return $ dict slicedItems + Nothing -> do + let items = fromMaybe [] $ asList slicee + slicedItems = slice items startInt lengthInt + return $ toGVal slicedItems + _ -> fail "Invalid arguments to 'slice'" + gfnReplace :: Function (Run m h) + gfnReplace args = + let argValues = + extractArgsDefL + [ ("str", def) + , ("search", def) + , ("replace", def) + ] + args + in case argValues of + Right (strG:searchG:replaceG:[]) -> do + let str = asText strG + search = asText searchG + replace = asText replaceG + return . toGVal $ Text.replace search replace str + _ -> fail "Invalid arguments to 'replace'" gfnSort :: Function (Run m h) gfnSort [] = return def diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -3,6 +3,7 @@ import Test.Tasty import Text.Ginger.SimulationTests (simulationTests) +import Text.Ginger.PropertyTests (propertyTests) main = defaultMain allTests @@ -10,4 +11,5 @@ allTests = testGroup "All Tests" [ simulationTests + , propertyTests ]