ginger 0.2.5.0 → 0.2.6.0

raw patch · 7 files changed

+205/−48 lines, 7 filesdep +tasty-quickcheckPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: tasty-quickcheck

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• ginger.cabal +4/−1
• src/Text/Ginger.hs +5/−2
• src/Text/Ginger/GVal.hs +1/−1
• src/Text/Ginger/Optimizer.hs +69/−0
• src/Text/Ginger/Run.hs +123/−43
• test/Spec.hs +2/−0

@@ -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

@@ -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

@@ -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--

@@ -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) $

@@ -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

@@ -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

@@ -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         ]