ginger 0.2.4.0 → 0.2.5.0

raw patch · 5 files changed

+155/−34 lines, 5 filesdep +tastydep +tasty-hunitdep ~basedep ~data-defaultdep ~mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: tasty, tasty-hunit

Dependency ranges changed: base, data-default, mtl, transformers

API changes (from Hackage documentation)

Files

• ginger.cabal +18/−1
• src/Text/Ginger/GVal.hs +46/−9
• src/Text/Ginger/Parse.hs +36/−10
• src/Text/Ginger/Run.hs +42/−14
• test/Spec.hs +13/−0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                ginger-version:             0.2.4.0+version:             0.2.5.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.@@ -57,3 +57,20 @@                  , text                  , transformers                  , unordered-containers >= 0.2.5++test-suite tests+    type: exitcode-stdio-1.0+    main-is: Spec.hs+    hs-source-dirs: test+    default-language: Haskell2010+    build-depends: base >=4.5 && <5+                 , ginger+                 , aeson+                 , bytestring+                 , data-default+                 , mtl+                 , tasty+                 , tasty-hunit+                 , text+                 , transformers+                 , utf8-string

@@ -69,7 +69,8 @@ -- in a template context, will be a 'GVal'. -- @m@, in most cases, should be a 'Monad'. ----- | Some laws apply here, most notably:+-- Some laws apply here, most notably:+-- -- - when 'isNull' is 'True', then all of 'asFunction', 'asText', 'asNumber', --   'asHtml', 'asList', 'asDictItems', and 'length' should produce 'Nothing' -- - when 'isNull' is 'True', then 'asBoolean' should produce 'False'@@ -88,8 +89,14 @@         , asFunction :: Maybe (Function m) -- ^ Access value as a callable function, if it is one         , length :: Maybe Int -- ^ Get length of value, if it is a collection (list/dict)         , isNull :: Bool -- ^ Check if the value is null+        , asJSON :: Maybe JSON.Value -- ^ Provide a custom JSON representation of the value         } +-- | Convenience wrapper around 'asDictItems' to represent a 'GVal' as a+-- 'HashMap'.+asHashMap :: GVal m -> Maybe (HashMap Text (GVal m))+asHashMap g = HashMap.fromList <$> asDictItems g+ -- | The default 'GVal' is equivalent to NULL. instance Default (GVal m) where     def = GVal@@ -103,8 +110,31 @@             , asFunction = Nothing             , isNull = True             , length = Nothing+            , asJSON = Nothing             } +-- | Conversion to JSON values attempts the following conversions, in order:+--+-- - check the 'isNull' property; if it is 'True', always return 'Null',+--   even if the GVal implements 'asJSON'+-- - 'asJSON'+-- - 'asList'+-- - 'asDictItems' (through 'asHashMap')+-- - 'asNumber'+-- - 'asText'+--+-- 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 = +        if isNull g+            then JSON.Null+            else (fromMaybe (JSON.toJSON $ asText g) $+                    asJSON g <|>+                    (JSON.toJSON <$> asList g) <|>+                    (JSON.toJSON <$> asHashMap g) <|>+                    (JSON.toJSON <$> asNumber g))+ -- | For convenience, 'Show' is implemented in a way that looks similar to -- JavaScript / JSON instance Show (GVal m) where@@ -181,7 +211,7 @@  -- | 'Nothing' becomes NULL, 'Just' unwraps. instance ToGVal m v => ToGVal m (Maybe v) where-    toGVal Nothing = def+    toGVal Nothing = def { asJSON = Just JSON.Null }     toGVal (Just x) = toGVal x  -- | Haskell lists become list-like 'GVal's@@ -288,6 +318,7 @@ -- | Construct a pair from a key and a value. (~>) :: ToGVal m a => Text -> a -> Pair m k ~> v = (k, toGVal v)+infixr 8 ~>  -- | Silly helper function, needed to bypass the default 'Show' instance of -- 'Scientific' in order to make integral 'Scientific's look like integers.@@ -306,6 +337,7 @@             , asBoolean = x             , asNumber = Just $ if x then 1 else 0             , isNull = False+            , asJSON = Just (JSON.Bool x)             }  -- | 'String' -> 'GVal' conversion uses the 'IsString' class; because 'String'@@ -372,15 +404,19 @@  -- | Convert Aeson 'Value's to 'GVal's over an arbitrary host monad. Because -- JSON cannot represent functions, this conversion will never produce a--- 'Function'.+-- 'Function'. Further, the 'ToJSON' instance for such a 'GVal' will always+-- produce the exact 'Value' that was use to construct the it. instance ToGVal m JSON.Value where-    toGVal (JSON.Number n) = toGVal n-    toGVal (JSON.String s) = toGVal s-    toGVal (JSON.Bool b) = toGVal b-    toGVal (JSON.Null) = def-    toGVal (JSON.Array a) = toGVal $ Vector.toList a-    toGVal (JSON.Object o) = toGVal o+    toGVal j = (rawJSONToGVal j) { asJSON = Just j } +rawJSONToGVal :: JSON.Value -> GVal m+rawJSONToGVal (JSON.Number n) = toGVal n+rawJSONToGVal (JSON.String s) = toGVal s+rawJSONToGVal (JSON.Bool b) = toGVal b+rawJSONToGVal (JSON.Null) = def+rawJSONToGVal (JSON.Array a) = toGVal $ Vector.toList a+rawJSONToGVal (JSON.Object o) = toGVal o+ -- | Turn a 'Function' into a 'GVal' fromFunction :: Function m -> GVal m fromFunction f =@@ -390,6 +426,7 @@         , asBoolean = True         , isNull = False         , asFunction = Just f+        , asJSON = Just "<<function>>"         }  

@@ -20,7 +20,7 @@                    , try, lookAhead                    , manyTill, oneOf, string, notFollowedBy, between, sepBy                    , eof, spaces, anyChar, char-                   , option+                   , option, optionMaybe                    , unexpected                    , digit                    , getState, modifyState@@ -199,11 +199,11 @@  interpolationStmtP :: Monad m => Parser m Statement interpolationStmtP = do-    try $ string "{{"+    try $ openInterpolationP     spaces     expr <- expressionP     spaces-    string "}}"+    closeInterpolationP     return $ InterpolationS expr  literalStmtP :: Monad m => Parser m Statement@@ -216,7 +216,7 @@  endOfLiteralP :: Monad m => Parser m () endOfLiteralP =-    (ignore . lookAhead . try . string $ "{{") <|>+    (ignore . lookAhead . try $ openInterpolationP) <|>     (ignore . lookAhead $ openTagP) <|>     (ignore . lookAhead $ openCommentP) <|>     eof@@ -333,8 +333,15 @@ forStmtP = do     (iteree, varNameVal, varNameIndex) <- fancyTagP "for" forHeadP     body <- statementsP+    elseBranchMay <- optionMaybe $ do+        try $ simpleTagP "else"+        statementsP     simpleTagP "endfor"-    return $ ForS varNameIndex varNameVal iteree body+    let forLoop = ForS varNameIndex varNameVal iteree body+    return $ maybe+        forLoop+        (\elseBranch -> IfS iteree forLoop elseBranch)+        elseBranchMay  includeP :: Monad m => Parser m Statement includeP = do@@ -342,7 +349,8 @@     include sourceName  forHeadP :: Monad m => Parser m (Expression, VarName, Maybe VarName)-forHeadP = try forHeadInP <|> forHeadAsP+forHeadP =+    (try forHeadInP <|> forHeadAsP) <* optional (string "recursive" >> spaces)  forIteratorP :: Monad m => Parser m (VarName, Maybe VarName) forIteratorP = try forIndexedIteratorP <|> try forSimpleIteratorP <?> "iteration variables"@@ -396,6 +404,12 @@ simpleTagP :: Monad m => String -> Parser m () simpleTagP tagName = openTagP >> string tagName >> closeTagP +openInterpolationP :: Monad m => Parser m ()+openInterpolationP = openP '{'++closeInterpolationP :: Monad m => Parser m ()+closeInterpolationP = closeP '}'+ openCommentP :: Monad m => Parser m () openCommentP = openP '#' @@ -475,16 +489,28 @@  ternaryExprP :: Monad m => Parser m Expression ternaryExprP = do-    condition <- booleanExprP+    expr1 <- booleanExprP     spaces-    ternaryTailP condition <|> return condition+    cTernaryTailP expr1 <|> pyTernaryTailP expr1 <|> return expr1 -ternaryTailP :: Monad m => Expression -> Parser m Expression-ternaryTailP condition = do+cTernaryTailP :: Monad m => Expression -> Parser m Expression+cTernaryTailP condition = do     char '?'     spaces     yesBranch <- expressionP     char ':'+    spaces+    noBranch <- expressionP+    return $ TernaryE condition yesBranch noBranch++pyTernaryTailP :: Monad m => Expression -> Parser m Expression+pyTernaryTailP yesBranch = do+    string "if"+    notFollowedBy identCharP+    spaces+    condition <- booleanExprP+    string "else"+    notFollowedBy identCharP     spaces     noBranch <- expressionP     return $ TernaryE condition yesBranch noBranch

@@ -77,7 +77,7 @@ import Data.Scientific (Scientific) import Data.Scientific as Scientific import Data.Default (def)-import Safe (readMay, lastDef)+import Safe (readMay, lastDef, headMay) import Network.HTTP.Types (urlEncode) import Debug.Trace (trace) @@ -637,19 +637,47 @@         runInner = runStatement body  runStatement (ForS varNameIndex varNameValue itereeExpr body) = do-    iteree <- runExpression itereeExpr-    let iterPairs =-            if isJust (asDictItems iteree)-                then [ (toGVal k, v) | (k, v) <- fromMaybe [] (asDictItems iteree) ]-                else Prelude.zip (Prelude.map toGVal ([0..] :: [Int])) (fromMaybe [] (asList iteree))-    withLocalScope $ forM_ iterPairs iteration-    where-        iteration (index, value) = do-            setVar varNameValue value-            case varNameIndex of-                Nothing -> return ()-                Just n -> setVar n index-            runStatement body+    let go :: Int -> GVal (Run m h) -> Run m h (GVal (Run m h))+        go recursionDepth iteree = do+            let iterPairs =+                    if isJust (asDictItems iteree)+                        then [ (toGVal k, v) | (k, v) <- fromMaybe [] (asDictItems iteree) ]+                        else Prelude.zip (Prelude.map toGVal ([0..] :: [Int])) (fromMaybe [] (asList iteree))+                numItems :: Int+                numItems = Prelude.length iterPairs+                cycle :: Int -> [(Maybe Text, GVal (Run m h))] -> Run m h (GVal (Run m h))+                cycle index args = return+                                 . fromMaybe def+                                 . headMay+                                 . Prelude.drop (index `Prelude.mod` Prelude.length args)+                                 . fmap snd+                                 $ args+                loop :: [(Maybe Text, GVal (Run m h))] -> Run m h (GVal (Run m h))+                loop [] = fail "Invalid call to `loop`; at least one argument is required"+                loop ((_, loopee):_) = go (Prelude.succ recursionDepth) loopee+                iteration :: (Int, (GVal (Run m h), GVal (Run m h))) -> Run m h ()+                iteration (index, (key, value)) = do+                    setVar varNameValue value+                    setVar "loop" $+                        (dict [ "index" ~> Prelude.succ index+                             , "index0" ~> index+                             , "revindex" ~> (numItems - index)+                             , "revindex0" ~> (numItems - index - 1)+                             , "depth" ~> Prelude.succ recursionDepth+                             , "depth0" ~> recursionDepth+                             , "first" ~> (index == 0)+                             , "last" ~> (Prelude.succ index == numItems)+                             , "length" ~> numItems+                             , "cycle" ~> (fromFunction $ cycle index)+                             ])+                             { asFunction = Just loop }+                    case varNameIndex of+                        Nothing -> return ()+                        Just n -> setVar n key+                    runStatement body+            withLocalScope $ forM_ (Prelude.zip [0..] iterPairs) iteration+            return def+    runExpression itereeExpr >>= go 0 >> return ()  runStatement (PreprocessedIncludeS tpl) =     withTemplate tpl $ runTemplate tpl

@@ -0,0 +1,13 @@+module Main where++import Test.Tasty++import Text.Ginger.SimulationTests (simulationTests)++main = defaultMain allTests++allTests :: TestTree+allTests =+    testGroup "All Tests"+        [ simulationTests+        ]