packages feed

ginger 0.7.3.0 → 0.8.0.0

raw patch · 14 files changed

+733/−136 lines, 14 filesdep +processdep +semigroupsdep +yamldep ~basedep ~http-typesPVP ok

version bump matches the API change (PVP)

Dependencies added: process, semigroups, yaml

Dependency ranges changed: base, http-types

API changes (from Hackage documentation)

- Text.Ginger.GVal: instance Text.Ginger.GVal.FromGVal m Data.Time.LocalTime.LocalTime.LocalTime
- Text.Ginger.GVal: instance Text.Ginger.GVal.FromGVal m Data.Time.LocalTime.LocalTime.ZonedTime
- Text.Ginger.GVal: instance Text.Ginger.GVal.FromGVal m Data.Time.LocalTime.TimeOfDay.TimeOfDay
- Text.Ginger.GVal: instance Text.Ginger.GVal.FromGVal m Data.Time.LocalTime.TimeZone.TimeZone
- Text.Ginger.GVal: instance Text.Ginger.GVal.ToGVal m Data.Time.LocalTime.LocalTime.LocalTime
- Text.Ginger.GVal: instance Text.Ginger.GVal.ToGVal m Data.Time.LocalTime.LocalTime.ZonedTime
- Text.Ginger.GVal: instance Text.Ginger.GVal.ToGVal m Data.Time.LocalTime.TimeOfDay.TimeOfDay
- Text.Ginger.GVal: instance Text.Ginger.GVal.ToGVal m Data.Time.LocalTime.TimeZone.TimeZone
+ Text.Ginger.GVal: gappend :: GVal m -> GVal m -> GVal m
+ Text.Ginger.GVal: instance Text.Ginger.GVal.FromGVal m Data.Time.LocalTime.Internal.LocalTime.LocalTime
+ Text.Ginger.GVal: instance Text.Ginger.GVal.FromGVal m Data.Time.LocalTime.Internal.TimeOfDay.TimeOfDay
+ Text.Ginger.GVal: instance Text.Ginger.GVal.FromGVal m Data.Time.LocalTime.Internal.TimeZone.TimeZone
+ Text.Ginger.GVal: instance Text.Ginger.GVal.FromGVal m Data.Time.LocalTime.Internal.ZonedTime.ZonedTime
+ Text.Ginger.GVal: instance Text.Ginger.GVal.FromGVal m GHC.Integer.Type.Integer
+ Text.Ginger.GVal: instance Text.Ginger.GVal.ToGVal m Data.Time.LocalTime.Internal.LocalTime.LocalTime
+ Text.Ginger.GVal: instance Text.Ginger.GVal.ToGVal m Data.Time.LocalTime.Internal.TimeOfDay.TimeOfDay
+ Text.Ginger.GVal: instance Text.Ginger.GVal.ToGVal m Data.Time.LocalTime.Internal.TimeZone.TimeZone
+ Text.Ginger.GVal: instance Text.Ginger.GVal.ToGVal m Data.Time.LocalTime.Internal.ZonedTime.ZonedTime
+ Text.Ginger.GVal: toInteger :: GVal m -> Maybe Integer
+ Text.Ginger.Html: instance GHC.Base.Semigroup Text.Ginger.Html.Html
+ Text.Ginger.Optimizer: instance GHC.Base.Semigroup Text.Ginger.Optimizer.Collected
+ Text.Ginger.Optimizer: instance GHC.Base.Semigroup Text.Ginger.Optimizer.Purity
+ Text.Ginger.PHP: Assign :: PHP -> PHP -> PHP
+ Text.Ginger.PHP: Bareword :: Text -> PHP
+ Text.Ginger.PHP: Binop :: PHP -> PHP -> PHP -> PHP
+ Text.Ginger.PHP: Call :: PHP -> [PHP] -> PHP
+ Text.Ginger.PHP: Dict :: [(PHP, PHP)] -> PHP
+ Text.Ginger.PHP: Float :: Double -> PHP
+ Text.Ginger.PHP: Int :: Int -> PHP
+ Text.Ginger.PHP: Lambda :: [Text] -> [PHP] -> PHP
+ Text.Ginger.PHP: List :: [PHP] -> PHP
+ Text.Ginger.PHP: Lookup :: PHP -> PHP -> PHP
+ Text.Ginger.PHP: Operator :: Text -> PHP
+ Text.Ginger.PHP: Parenthesized :: PHP -> PHP
+ Text.Ginger.PHP: RawSyntax :: Text -> PHP
+ Text.Ginger.PHP: Return :: PHP -> PHP
+ Text.Ginger.PHP: SQString :: Text -> PHP
+ Text.Ginger.PHP: Statement :: PHP -> PHP
+ Text.Ginger.PHP: StmtBlock :: [PHP] -> PHP
+ Text.Ginger.PHP: Ternary :: PHP -> PHP -> PHP -> PHP
+ Text.Ginger.PHP: Variable :: Text -> PHP
+ Text.Ginger.PHP: data PHP
+ Text.Ginger.PHP: escapeCharSQ :: Char -> Text
+ Text.Ginger.PHP: escapeSQ :: Text -> Text
+ Text.Ginger.PHP: exprToPHP :: Expression a -> PHP
+ Text.Ginger.PHP: type LText = Text
+ Text.Ginger.PHP: writeBuilder :: PHP -> Builder
+ Text.Ginger.PHP: writeText :: PHP -> LText
+ Text.Ginger.Parse: Delimiters :: String -> String -> String -> String -> String -> String -> Delimiters
+ Text.Ginger.Parse: [delimCloseComment] :: Delimiters -> String
+ Text.Ginger.Parse: [delimCloseInterpolation] :: Delimiters -> String
+ Text.Ginger.Parse: [delimCloseTag] :: Delimiters -> String
+ Text.Ginger.Parse: [delimOpenComment] :: Delimiters -> String
+ Text.Ginger.Parse: [delimOpenInterpolation] :: Delimiters -> String
+ Text.Ginger.Parse: [delimOpenTag] :: Delimiters -> String
+ Text.Ginger.Parse: [poDelimiters] :: ParserOptions m -> Delimiters
+ Text.Ginger.Parse: data Delimiters
+ Text.Ginger.Parse: defDelimiters :: Delimiters
+ Text.Ginger.Run.FuncUtils: binaryFunc :: forall m h p. (Monad m) => (GVal (Run p m h) -> GVal (Run p m h) -> GVal (Run p m h)) -> Function (Run p m h)
- Text.Ginger.AST: CallE :: a -> (Expression a) -> [(Maybe Text, Expression a)] -> Expression a
+ Text.Ginger.AST: CallE :: a -> (Expression a) -> [(Maybe Text, (Expression a))] -> Expression a
- Text.Ginger.AST: ObjectE :: a -> [(Expression a, Expression a)] -> Expression a
+ Text.Ginger.AST: ObjectE :: a -> [((Expression a), (Expression a))] -> Expression a
- Text.Ginger.AST: SwitchS :: a -> (Expression a) -> [(Expression a, Statement a)] -> (Statement a) -> Statement a
+ Text.Ginger.AST: SwitchS :: a -> (Expression a) -> [((Expression a), (Statement a))] -> (Statement a) -> Statement a
- Text.Ginger.AST: exprAnnotation :: Expression t -> t
+ Text.Ginger.AST: exprAnnotation :: () => Expression p -> p
- Text.Ginger.AST: stmtAnnotation :: Statement t -> t
+ Text.Ginger.AST: stmtAnnotation :: () => Statement p -> p
- Text.Ginger.GVal: class FromGVal m a where fromGValEither = maybe (Left "Conversion from GVal failed") Right . fromGVal fromGVal = either (const Nothing) Just . fromGValEither
+ Text.Ginger.GVal: class FromGVal m a
- Text.Ginger.Parse: ParserOptions :: IncludeResolver m -> Maybe SourceName -> Bool -> Bool -> Bool -> ParserOptions m
+ Text.Ginger.Parse: ParserOptions :: IncludeResolver m -> Maybe SourceName -> Bool -> Bool -> Bool -> Delimiters -> ParserOptions m
- Text.Ginger.Parse: data SourcePos :: *
+ Text.Ginger.Parse: data SourcePos
- Text.PrintfA: T :: (forall r. PrintfType r => r) -> PrintfTypeT
+ Text.PrintfA: T :: forall r. PrintfType r => r -> PrintfTypeT

Files

CHANGELOG.md view
@@ -1,3 +1,23 @@+## 0.8.0.0++- Now compiles on GHC 8.4+- CLI: added a `system()` template function (for spawning subprocesses)+- CLI accepts YAML+- Added `is` operator (also makes Ginger conform to Jinja2 test syntax)+- Various bugfixes+- New builtins: `escaped`, `in`, Python-style boolean operators, `divisibleBy`,+  `even`, `odd`, and more+- Boolean literals now also accepted in caps+- Improved documentation+- `GVal` instances for `Integer`+- Overridable delimiters++## 0.7.4.0++- Make concat() / ~ more generic (now also concatenates lists and dictionaries)+- CLI omits printing of `null` results. Useful when using as a filter.+- Fixed excessive newlines in CLI output+ ## 0.7.3.0  - Expose parser error position details
README.md view
@@ -20,9 +20,9 @@ Ginger provides most of the original Jinja2 template language, as much as that makes sense in a Haskell host application. -We do, however, some of the most blatant Pythonisms, especially when we felt-the features in question were more of an accidental result of binding template-constructs to Python constructs.+We do, however, avoid some of the most blatant Pythonisms, especially where we+felt the features in question were more of an accidental result of binding+template constructs to Python constructs.  On top of that, we deviate on a few points, and add some features that we think are very useful and help make the language better and more consistent.@@ -45,7 +45,7 @@  Add the following to your `.cabal`'s `build-depends`: -    ginger >=0.3.9.1 && <0.4+    ginger >=0.7.4.0 && <0.8  ## Template Syntax @@ -74,13 +74,19 @@         </body>     </html> -There are two kinds of delimiters. `{% ... %}` and `{{ ... }}`. The first-one is used to execute statements such as for-loops or assign values, the-latter prints the result of an expression to the template.+There are three kinds of delimiters: -*Not implemented yet*: Jinja2 allows the programmer to override the default-tags from `{% %}` and `{{ }}` to different tokens, e.g. `<% %>` and `<< >>`.-Ginger does not currently support this.+- Interpolation, to inject values into the output; these default to `{{` and+  `}}`+- Flow Control, to create conditionals, loops, and other control constructs;+  these default to `{%` and `%}`+- Comments, which are removed from the output; these default to `{#` and `#}`.++These delimiters can be changed on the Haskell side. In principle, any string+is accepted for any delimiter; you may, however, get surprising results if you+pick delimiters that clash with other Ginger syntax, or with one another (e.g.,+using the same string to start interpolations and flow control constructs will+not work).  ## Haskell API 
cli/GingerCLI.hs view
@@ -10,6 +10,7 @@ import Text.Ginger.Html import Data.Text as Text import qualified Data.Aeson as JSON+import qualified Data.Yaml as YAML import Data.Maybe import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap@@ -23,6 +24,8 @@ import Control.Monad.Trans.Maybe import Control.Monad import Data.Default ( def )+import System.Process as Process+import Text.Printf (printf)  loadFile fn = openFile fn ReadMode >>= hGetContents @@ -35,7 +38,7 @@                 return Nothing  decodeFile :: (JSON.FromJSON v) => FilePath -> IO (Maybe v)-decodeFile fn = JSON.decode <$> (openFile fn ReadMode >>= LBS.hGetContents)+decodeFile fn = YAML.decode <$> (openFile fn ReadMode >>= BS.hGetContents)  printF :: GVal (Run p IO Html) printF = fromFunction $ go@@ -45,6 +48,24 @@         printArg (Nothing, v) = liftRun . putStrLn . Text.unpack . asText $ v         printArg (Just x, _) = return () +systemF :: GVal (Run p IO Html)+systemF = fromFunction $ go . fmap snd+    where+        go :: [GVal (Run p IO Html)] -> Run p IO Html (GVal (Run p IO Html))+        go [cmd,args,pipe] = do+          let gArgs = fmap gAsStr . fromMaybe [] . asList $ args+          strToGVal <$> liftRun (Process.readProcess (gAsStr cmd) gArgs (gAsStr pipe))+        go [] = pure def+        go [cmd] = go [cmd,def]+        go [cmd,args] = go [cmd,args,def]+        go xs = go $ Prelude.take 3 xs++gAsStr :: GVal m -> String+gAsStr = Text.unpack . asText++strToGVal :: String -> GVal m+strToGVal = toGVal . Text.pack+ main = do     args <- getArgs     let (srcFn, scopeFn) = case args of@@ -62,6 +83,7 @@         contextLookup key =             case key of                 "print" -> return printF+                "system" -> return systemF                 _ -> return $ scopeLookup key      (tpl, src) <- case srcFn of@@ -88,9 +110,13 @@             let context =                     makeContextHtmlExM                         contextLookup-                        (putStrLn . Text.unpack . htmlSource)+                        (putStr . Text.unpack . htmlSource)                         (hPutStrLn stderr . show)-            runGingerT context t >>= either (hPutStrLn stderr . show) (putStr . show)+            runGingerT context t >>= either (hPutStrLn stderr . show) showOutput+    where+      showOutput value+        | isNull value = return ()+        | otherwise = putStrLn . show $ value  printParserError :: Maybe String -> ParserError -> IO () printParserError srcMay = putStrLn . formatParserError srcMay
ginger.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                ginger-version:             0.7.3.0+version:             0.8.0.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.@@ -31,6 +31,7 @@                  , Text.PrintfA                  , Text.Ginger.Run.VM                  , Text.Ginger.Run.FuncUtils+                 , Text.Ginger.PHP   other-modules: Text.Ginger.Run.Type                , Text.Ginger.Run.Builtins   -- other-extensions:@@ -40,7 +41,7 @@                , bytestring                , data-default >= 0.5                , filepath >= 1.3-               , http-types+               , http-types >= 0.8 && (< 0.11 || >= 0.12)                , mtl >= 2.2                , parsec >= 3.0                , safe >= 0.3@@ -51,6 +52,8 @@                , unordered-containers >= 0.2.5                , utf8-string                , vector+  if !impl(ghc >= 8.0)+    build-depends: semigroups == 0.18.*   hs-source-dirs:      src   default-language:    Haskell2010 @@ -58,14 +61,16 @@     main-is: GingerCLI.hs     hs-source-dirs: cli     default-language:    Haskell2010-    build-depends: base >= 4.5 && <5+    build-depends: base >= 4.8 && <5                  , bytestring                  , data-default >= 0.5                  , ginger                  , aeson+                 , process                  , text                  , transformers                  , unordered-containers >= 0.2.5+                 , yaml  test-suite tests     type: exitcode-stdio-1.0@@ -74,7 +79,7 @@                  , Text.Ginger.SimulationTests     hs-source-dirs: test     default-language: Haskell2010-    build-depends: base >=4.5 && <5+    build-depends: base >=4.8 && <5                  , ginger                  , aeson                  , bytestring
src/Text/Ginger.hs view
@@ -43,9 +43,12 @@ -- Note that whitespace /inside/ delimiters is never printed; the dash only -- ever removes whitespace on the outside. --- | /Not implemented yet/: Jinja2 allows the programmer to override the--- default tags from @{% %}@ and @{{ }}@ to different tokens, e.g. @\<% %\>@--- and @\<\< \>\>@.  Ginger does not currently support this.+-- These delimiters can be changed on the Haskell side. In principle, any+-- string is accepted for any delimiter; you may, however, get surprising+-- results if you pick delimiters that clash with other Ginger syntax, or with+-- one another (e.g., using the same string to start interpolations and flow+-- control constructs will not work). See the 'ParserOptions' and 'Delimiters'+-- data structures for more details.  -- ** Variables -- | You can mess around with the variables in templates provided they are
src/Text/Ginger/GVal.hs view
@@ -20,6 +20,7 @@ import Prelude ( (.), ($), (==), (/=)                , (++), (+), (-), (*), (/), div                , (=<<), (>>=), return+               , (||), (&&)                , undefined, otherwise, id, const                , fmap                , Maybe (..)@@ -60,7 +61,7 @@ import qualified Data.HashMap.Strict as HashMap import Data.HashMap.Strict (HashMap) import qualified Data.Vector as Vector-import Control.Monad ( forM, mapM )+import Control.Monad ((<=<), forM, mapM) import Control.Monad.Trans (MonadTrans, lift) import Data.Default (Default, def) import Text.Printf@@ -110,6 +111,30 @@         , asJSON :: Maybe JSON.Value -- ^ Provide a custom JSON representation of the value         } +gappend :: GVal m -> GVal m -> GVal m+gappend a b =+  GVal+    { asList = (++) <$> asList a <*> asList b+    , asDictItems = (++) <$> asDictItems a <*> asDictItems b+    , asLookup = do+        lookupA <- asLookup a+        lookupB <- asLookup b+        return $ \k -> lookupA k <|> lookupB k+    , asHtml = asHtml a <> asHtml b+    , asText = asText a <> asText b+    , asBoolean = (asBoolean a || asBoolean b) && not (isNull a || isNull b)+    , asNumber = readMay . Text.unpack $ (asText a <> asText b)+    , asFunction = Nothing+    , isNull = isNull a || isNull b+    , asJSON = case (JSON.toJSON a, JSON.toJSON b) of+        (JSON.Array x, JSON.Array y) -> Just $ JSON.Array (x <> y)+        (JSON.Object x, JSON.Object y) -> Just $ JSON.Object (x <> y)+        (JSON.String x, JSON.String y) -> Just $ JSON.String (x <> y)+        (JSON.Null, b) -> Just $ b+        (a, JSON.Null) -> Just $ a+        _ -> Nothing -- If JSON tags mismatch, use default toJSON impl+    }+ -- | Marshal a GVal between carrier monads. -- This will lose 'asFunction' information, because functions cannot be -- transferred to other carrier monads, but it will keep all other data@@ -703,8 +728,13 @@ -- The conversion will fail when the value is not numeric, and also if -- it is too large to fit in an 'Int'. toInt :: GVal m -> Maybe Int-toInt x = toNumber x >>= toBoundedInteger+toInt = toBoundedInteger <=< toNumber +-- | Convert a 'GVal' to an 'Integer'+-- The conversion will fail when the value is not an integer+toInteger :: GVal m -> Maybe Integer+toInteger = Prelude.either (const Nothing) Just . floatingOrInteger <=< asNumber+ -- | Convert a 'GVal' to an 'Int', falling back to the given -- default if the conversion fails. toIntDef :: Int -> GVal m -> Int@@ -754,6 +784,9 @@  instance FromGVal m Scientific where     fromGVal = asNumber++instance FromGVal m Integer where+    fromGVal = toInteger  instance FromGVal m Text where     fromGVal = Just . asText
src/Text/Ginger/Html.hs view
@@ -17,11 +17,11 @@  import Data.Text (Text) import qualified Data.Text as Text-import Data.Monoid+import Data.Semigroup as Semigroup  -- | A chunk of HTML source. newtype Html = Html { unHtml :: Text }-    deriving (Monoid, Show, Eq, Ord)+    deriving (Semigroup.Semigroup, Monoid, Show, Eq, Ord)  -- | Types that support conversion to HTML. class ToHtml s where
src/Text/Ginger/Optimizer.hs view
@@ -12,7 +12,6 @@ import Text.Ginger.AST import Text.Ginger.GVal import Text.Ginger.Run-import Data.Monoid import Control.Monad.Identity import Data.Default import Control.Monad.State (execState, evalState)@@ -22,6 +21,7 @@ import Control.Applicative import Data.Text (Text) import qualified Data.Aeson as JSON+import Data.Semigroup as Semigroup  class Optimizable a where     optimize :: a -> a@@ -47,19 +47,18 @@       , templateParent = optimize <$> templateParent t       } -{--    = MultiS p [Statement a] -- ^ A sequence of multiple statements-    | ScopedS p Statement a -- ^ Run wrapped statement in a local scope-    | LiteralS p Html -- ^ Literal output (anything outside of any tag)-    | InterpolationS p Expression a -- ^ {{ expression }}-    | IfS p Expression a Statement a Statement a -- ^ {% if expression %}statement{% else %}statement{% endif %}-    | ForS p (Maybe VarName) VarName Expression a Statement a -- ^ {% for index, varname in expression %}statement{% endfor %}-    | SetVarS p VarName Expression a -- ^ {% set varname = expr %}-    | DefMacroS p VarName Macro a -- ^ {% macro varname %}statements{% endmacro %}-    | BlockRefS p VarName-    | PreprocessedIncludeS p Template a -- ^ {% include "template" %}-    | NullS p -- ^ The do-nothing statement (NOP)--}+--    = MultiS p [Statement a] -- ^ A sequence of multiple statements+--    | ScopedS p Statement a -- ^ Run wrapped statement in a local scope+--    | LiteralS p Html -- ^ Literal output (anything outside of any tag)+--    | InterpolationS p Expression a -- ^ {{ expression }}+--    | IfS p Expression a Statement a Statement a -- ^ {% if expression %}statement{% else %}statement{% endif %}+--    | ForS p (Maybe VarName) VarName Expression a Statement a -- ^ {% for index, varname in expression %}statement{% endfor %}+--    | SetVarS p VarName Expression a -- ^ {% set varname = expr %}+--    | DefMacroS p VarName Macro a -- ^ {% macro varname %}statements{% endmacro %}+--    | BlockRefS p VarName+--    | PreprocessedIncludeS p Template a -- ^ {% include "template" %}+--    | NullS p -- ^ The do-nothing statement (NOP)+ optimizeStatement (MultiS p items) =     case optimizeStatementList items of         [] -> NullS p@@ -100,21 +99,19 @@ mergeLiterals (x:xs) = x:mergeLiterals xs  -{--data Expression a-    = StringLiteralE p Text -- ^ String literal expression: "foobar"-    | NumberLiteralE p Scientific -- ^ Numeric literal expression: 123.4-    | BoolLiteralE p Bool -- ^ Boolean literal expression: true-    | NullLiteralE p -- ^ Literal null-    | VarE p VarName -- ^ Variable reference: foobar-    | ListE p [Expression a] -- ^ List construct: [ expr, expr, expr ]-    | ObjectE p [(Expression a, Expression a)] -- ^ Object construct: { expr: expr, expr: expr, ... }-    | MemberLookupE p Expression a Expression a -- ^ foo[bar] (also dot access)-    | CallE p Expression a [(Maybe Text, Expression a)] -- ^ foo(bar=baz, quux)-    | LambdaE p [Text] Expression a -- ^ (foo, bar) -> expr-    | TernaryE p Expression a Expression a Expression a -- ^ expr ? expr : expr-    deriving (Show)--}+-- data Expression a+--     = StringLiteralE p Text -- ^ String literal expression: "foobar"+--     | NumberLiteralE p Scientific -- ^ Numeric literal expression: 123.4+--     | BoolLiteralE p Bool -- ^ Boolean literal expression: true+--     | NullLiteralE p -- ^ Literal null+--     | VarE p VarName -- ^ Variable reference: foobar+--     | ListE p [Expression a] -- ^ List construct: [ expr, expr, expr ]+--     | ObjectE p [(Expression a, Expression a)] -- ^ Object construct: { expr: expr, expr: expr, ... }+--     | MemberLookupE p Expression a Expression a -- ^ foo[bar] (also dot access)+--     | CallE p Expression a [(Maybe Text, Expression a)] -- ^ foo(bar=baz, quux)+--     | LambdaE p [Text] Expression a -- ^ (foo, bar) -> expr+--     | TernaryE p Expression a Expression a Expression a -- ^ expr ? expr : expr+--     deriving (Show)  data Purity = Pure | Impure     deriving (Show, Eq, Enum, Read, Ord, Bounded)@@ -123,9 +120,12 @@ bothPure Pure Pure = Pure bothPure _ _ = Impure +instance Semigroup.Semigroup Purity where+    (<>) = bothPure+ instance Monoid Purity where     mempty = Pure-    mappend = bothPure+    mappend = (<>)  pureExpression :: Expression a -> Purity pureExpression (StringLiteralE p _) = Pure@@ -264,7 +264,7 @@     Impure -> Nothing  newtype Collected = Collected [GVal Identity]-    deriving (Monoid)+    deriving (Semigroup.Semigroup, Monoid)  instance ToGVal m Collected where     toGVal = collectedToGVal
+ src/Text/Ginger/PHP.hs view
@@ -0,0 +1,113 @@+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE OverloadedStrings #-}+{-#LANGUAGE TupleSections #-}+{-#LANGUAGE TypeSynonymInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE ScopedTypeVariables #-}+{-#LANGUAGE LambdaCase #-}+{-#LANGUAGE GeneralizedNewtypeDeriving #-}+module Text.Ginger.PHP+where++import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LText+import Data.Text.Lazy.Builder (Builder, fromText, fromLazyText, fromString, toLazyText)+import Data.Monoid+import Data.List+import Data.Bifunctor+import Data.Bool+import Data.Scientific (floatingOrInteger)++import Text.Ginger.AST+import Text.Ginger.Html++type LText = LText.Text++-- | Concrete PHP syntax (or rather, the subset we use)+data PHP+  = RawSyntax Text -- ^ whatever+  | Bareword Text -- ^ @foobar@+  | Variable Text -- ^ @$foobar@+  | SQString Text -- ^ @'foobar'@+  | Int Int -- ^ @23@+  | Float Double -- ^ @23.42@+  | Operator Text -- ^ @+@+  | Parenthesized PHP -- @(...)@+  | StmtBlock [PHP] -- @{...}@+  | List [PHP] -- @[a,b,c,...]@+  | Dict [(PHP,PHP)] -- @[a=>b,c=>d,...]@+  | Assign PHP PHP -- @a = b@+  | Binop PHP PHP PHP -- @a + b@+  | Call PHP [PHP] -- @foo(a,b,c...)@+  | Lookup PHP PHP -- @foo[bar]@+  | Lambda [Text] [PHP] -- @function (args) { statements }@+  | Ternary PHP PHP PHP -- @((cond) ? (yes) : (no))+  | Statement PHP -- @foobar;@+  | Return PHP -- @return foobar;@++writeBuilder :: PHP -> Builder+writeBuilder (RawSyntax txt) = fromText txt+writeBuilder (Bareword txt) = fromText txt+writeBuilder (Variable varname) = "$" <> fromText varname+writeBuilder (SQString txt) = "'" <> fromText (escapeSQ txt) <> "'"+writeBuilder (Int i) = fromString . show $ i+writeBuilder (Float f) = fromString . show $ f+writeBuilder (Operator txt) = fromText txt+writeBuilder (Parenthesized inner) = "(" <> writeBuilder inner <> ")"+writeBuilder (StmtBlock items) = "{" <> (mconcat . map writeBuilder $ items) <> "}"+writeBuilder (List items) = "[" <> (mconcat . intersperse ", " . map writeBuilder $ items) <> "]"+writeBuilder (Dict pairs) = "[" <> (mconcat . intersperse ", " . map writePair $ pairs) <> "]"+  where+    writePair (a, b) = writeBuilder a <> " => " <> writeBuilder b+writeBuilder (Binop lhs op rhs) = writeBuilder lhs <> " " <> writeBuilder op <> " " <> writeBuilder rhs+writeBuilder (Call fn args) = "(" <> writeBuilder fn <> "(" <> (mconcat . intersperse ", " . map writeBuilder $ args) <> "))"+writeBuilder (Lookup dict key) = writeBuilder dict <> "[" <> writeBuilder key <> "]"+writeBuilder (Lambda args stmts) =+  "(function (" <>+  (mconcat . intersperse ", " . map (("$" <>) . fromText) $ args) <>+  ") {" <>+  (mconcat . intersperse ";" . map writeBuilder $ stmts) <>+  "})"+writeBuilder (Ternary cond yes no) =+  "((" <> writeBuilder cond <> ") ? (" <> writeBuilder yes <> ") : (" <> writeBuilder no <> "))"+writeBuilder (Statement expr) = writeBuilder expr <> ";\n"+writeBuilder (Assign a b) = "$" <> writeBuilder a <> " = " <> writeBuilder b <> ";"+writeBuilder (Return expr) = "return " <> writeBuilder expr <> ";\n"++writeText :: PHP -> LText+writeText = toLazyText . writeBuilder++escapeSQ :: Text -> Text+escapeSQ = Text.concatMap escapeCharSQ++escapeCharSQ :: Char -> Text+escapeCharSQ '\'' = "\\'"+escapeCharSQ c = Text.singleton c++exprToPHP :: Expression a -> PHP+exprToPHP (StringLiteralE pos str) =+  SQString str+exprToPHP (NumberLiteralE pos num) =+  either Float Int $ floatingOrInteger num+exprToPHP (BoolLiteralE pos b) =+  Bareword $ bool "false" "true" b+exprToPHP (NullLiteralE pos) =+  Bareword "null"+exprToPHP (VarE pos name) =+  Variable name+exprToPHP (ListE pos expressions) =+  List $ map exprToPHP expressions+exprToPHP (ObjectE pos pairs) =+  Dict $ map (bimap exprToPHP exprToPHP) pairs+exprToPHP (MemberLookupE pos container key) =+  Lookup (exprToPHP container) (exprToPHP key)+exprToPHP (CallE pos callee arglist) =+  Call (exprToPHP callee) (map (exprToPHP . snd) arglist)+exprToPHP (LambdaE pos argspec body) =+  Lambda argspec [Return $ exprToPHP body]+exprToPHP (TernaryE pos cond yes no) =+  Ternary (exprToPHP cond) (exprToPHP yes) (exprToPHP no)+exprToPHP (DoE pos stmt) =+  undefined
src/Text/Ginger/Parse.hs view
@@ -13,6 +13,8 @@ , ParserError (..) , ParserOptions (..) , mkParserOptions+, Delimiters (..)+, defDelimiters , formatParserError , IncludeResolver , Source, SourceName@@ -36,7 +38,7 @@                    , try, lookAhead                    , manyTill, oneOf, string, notFollowedBy, between, sepBy                    , eof, spaces, anyChar, noneOf, char-                   , option, optionMaybe+                   , choice, option, optionMaybe                    , unexpected                    , digit                    , getState, modifyState, putState@@ -102,8 +104,14 @@  instance Exception ParserError where --- | -formatParserError :: Maybe String -> ParserError -> String+-- | Formats a parser errror into something human-friendly.+-- If template source code is not provided, only the line and column numbers+-- and the error message are printed. If template source code is provided,+-- the offending source line is also printed, with a caret (@^@) marking the+-- exact location of the error.+formatParserError :: Maybe String -- ^ Template source code (not filename)+                  -> ParserError -- ^ Error to format+                  -> String formatParserError tplSrc e =     let sourceLocation = do             pos <- peSourcePosition e@@ -142,8 +150,14 @@             $ errorMessages e)         (Just $ errorPos e) --- | Parse Ginger source from a file.-parseGingerFile :: forall m. Monad m => IncludeResolver m -> SourceName -> m (Either ParserError (Template SourcePos))+-- | Parse Ginger source from a file. Both the initial template and all+-- subsequent includes are loaded through the provided 'IncludeResolver'. A+-- consequence of this is that if you pass a \"null resolver\" (like `const+-- (return Nothing)`), this function will always fail.+parseGingerFile :: forall m. Monad m+                => IncludeResolver m+                -> SourceName+                -> m (Either ParserError (Template SourcePos)) parseGingerFile resolver sourceName =     parseGingerFile' opts sourceName     where@@ -152,8 +166,14 @@             (mkParserOptions resolver)                 { poSourceName = Just sourceName } --- | Parse Ginger source from memory.-parseGinger :: forall m. Monad m => IncludeResolver m -> Maybe SourceName -> Source -> m (Either ParserError (Template SourcePos))+-- | Parse Ginger source from memory. The initial template is taken directly+-- from the provided 'Source', while all subsequent includes are loaded through+-- the provided 'IncludeResolver'.+parseGinger :: forall m. Monad m+            => IncludeResolver m+            -> Maybe SourceName+            -> Source+            -> m (Either ParserError (Template SourcePos)) parseGinger resolver sourceName source =     parseGinger' opts source     where@@ -162,7 +182,8 @@             (mkParserOptions resolver)                 { poSourceName = sourceName } --- | Parse Ginger source from a file.+-- | Parse Ginger source from a file. Flavor of 'parseGingerFile' that takes+-- additional 'ParserOptions'. parseGingerFile' :: Monad m => ParserOptions m -> SourceName -> m (Either ParserError (Template SourcePos)) parseGingerFile' opts' fn = do     let opts = opts' { poSourceName = Just fn }@@ -176,14 +197,15 @@                 }         Just src -> parseGinger' opts src --- | Parse Ginger source from memory.+-- | Parse Ginger source from memory. Flavor of 'parseGinger' that takes+-- additional 'ParserOptions'. parseGinger' :: Monad m => ParserOptions m -> Source -> m (Either ParserError (Template SourcePos)) parseGinger' opts src = do     result <-         runReaderT             ( runParserT                 (templateP `before` eof)-                defParseState+                defParseState { psDelimiters = poDelimiters opts }                 (fromMaybe "<<unknown>>" $ poSourceName opts)                 src             )@@ -193,15 +215,47 @@         Left e -> return . Left $ fromParsecError e  +-- | Delimiter configuration.+data Delimiters+    = Delimiters+        { delimOpenInterpolation :: String+        , delimCloseInterpolation :: String+        , delimOpenTag :: String+        , delimCloseTag :: String+        , delimOpenComment :: String+        , delimCloseComment :: String+        }++-- | Default delimiter configuration: @{{ }}@ for interpolation, @{% %}@ for+-- tags, @{# #}@ for comments.+defDelimiters :: Delimiters+defDelimiters+    = Delimiters+        { delimOpenInterpolation = "{{"+        , delimCloseInterpolation = "}}"+        , delimOpenTag = "{%"+        , delimCloseTag = "%}"+        , delimOpenComment = "{#"+        , delimCloseComment = "#}"+        }+ data ParserOptions m     = ParserOptions-        { poIncludeResolver :: IncludeResolver m+        { -- | How to load templates / includes+          poIncludeResolver :: IncludeResolver m+          -- | Current source file name, if any         , poSourceName :: Maybe SourceName+          -- | Disable newline stripping         , poKeepTrailingNewline :: Bool+          -- | Enable auto-stripping of @{% block %}@s         , poLStripBlocks :: Bool+          -- | Enable auto-trimming of @{% block %}@s         , poTrimBlocks :: Bool+          -- | Interpolation, tag, and comment delimiters+        , poDelimiters :: Delimiters         } +-- | Default parser options for a given resolver mkParserOptions :: Monad m => IncludeResolver m -> ParserOptions m mkParserOptions resolver =     ParserOptions@@ -210,12 +264,14 @@         , poKeepTrailingNewline = False         , poLStripBlocks = False         , poTrimBlocks = False+        , poDelimiters = defDelimiters         }  data ParseState     = ParseState         { psBlocks :: HashMap VarName (Block SourcePos)         , psStripIndent :: String+        , psDelimiters :: Delimiters         }  defParseState :: ParseState@@ -223,6 +279,7 @@     ParseState         { psBlocks = HashMap.empty         , psStripIndent = ""+        , psDelimiters = defDelimiters         }  type Parser m a = ParsecT String ParseState (ReaderT (ParserOptions m) m) a@@ -865,71 +922,75 @@ simpleTagP tagName = openTagP >> string tagName >> closeTagP  openInterpolationP :: Monad m => Parser m ()-openInterpolationP = openP '{'+openInterpolationP =+    delimOpenInterpolation . psDelimiters <$> getState >>= openP  closeInterpolationP :: Monad m => Parser m ()-closeInterpolationP = closeP '}'+closeInterpolationP =+    delimCloseInterpolation . psDelimiters <$> getState >>= closeP  openCommentP :: Monad m => Parser m ()-openCommentP = openP '#'+openCommentP =+    delimOpenComment . psDelimiters <$> getState >>= openP  closeCommentP :: Monad m => Parser m ()-closeCommentP = closeP '#'+closeCommentP =+    delimCloseComment . psDelimiters <$> getState >>= closeP  openTagP :: Monad m => Parser m ()-openTagP = openP '%'+openTagP =+    delimOpenTag . psDelimiters <$> getState >>= openP  closeTagP :: Monad m => Parser m () closeTagP = do-    closeP '%'-+    delimCloseTag . psDelimiters <$> getState >>= closeP     unlessFlag poKeepTrailingNewline         (ignore . optional $ literalNewlineP) -openP :: Monad m => Char -> Parser m ()+openP :: Monad m => String -> Parser m () openP c = try (openWP c)         <|> try (openFWP c)         <|> try (openNWP c) -openWP :: Monad m => Char -> Parser m ()+openWP :: Monad m => String -> Parser m () openWP c = ignore $ do     spaces-    string [ '{', c, '-' ]+    string $ c ++ "-"     spacesOrComment -openFWP :: Monad m => Char -> Parser m ()+openFWP :: Monad m => String -> Parser m () openFWP c = ignore $ do-    string [ '{', c, '+' ]+    string $ c ++ "+"     spacesOrComment  -openNWP :: Monad m => Char -> Parser m ()+openNWP :: Monad m => String -> Parser m () openNWP c = ignore $ do     whenFlag poLStripBlocks spaces-    string [ '{', c ]+    string c     notFollowedBy $ oneOf "+-"     spacesOrComment -closeP :: Monad m => Char -> Parser m ()+closeP :: Monad m => String -> Parser m () closeP c = try (closeWP c)          <|> try (closeFWP c)          <|> try (closeNWP c) -closeWP :: Monad m => Char -> Parser m ()+closeWP :: Monad m => String -> Parser m () closeWP c = ignore $ do     spacesOrComment-    string [ '-', c, '}' ]+    string $ '-':c     spaces -closeFWP :: Monad m => Char -> Parser m ()+closeFWP :: Monad m => String -> Parser m () closeFWP c = ignore $ do     spacesOrComment-    string [ '+', c, '}' ]+    string $ '+':c -closeNWP :: Monad m => Char -> Parser m ()+closeNWP :: Monad m => String -> Parser m () closeNWP c = ignore $ do     spacesOrComment-    string [ c, '}' ]+    string c     whenFlag poTrimBlocks spaces  expressionP :: Monad m => Parser m (Expression SourcePos)@@ -979,7 +1040,7 @@     cTernaryTailP pos expr1 <|> pyTernaryTailP pos expr1 <|> return expr1  cTernaryTailP :: Monad m => SourcePos -> (Expression SourcePos) -> Parser m (Expression SourcePos)-cTernaryTailP pos condition = do+cTernaryTailP pos condition = try $ do     char '?'     spacesOrComment     yesBranch <- expressionP@@ -1002,7 +1063,9 @@ booleanExprP =     operativeExprP         comparativeExprP-        [ ("||", "any")+        [ ("or", "any")+        , ("||", "any")+        , ("and", "all")         , ("&&", "all")         ] @@ -1050,6 +1113,7 @@              <|> arrayAccessP              <|> funcCallP              <|> filterP+             <|> testExprP  dotPostfixP :: Monad m => SourcePos -> Parser m ((Expression SourcePos) -> (Expression SourcePos)) dotPostfixP pos = do@@ -1107,6 +1171,21 @@     args <- option [] $ groupP "(" ")" funcArgP     return $ \e -> CallE pos func ((Nothing, e):args) +testExprP :: Monad m => Parser m ((Expression SourcePos) -> (Expression SourcePos))+testExprP = do+    pos <- getPosition+    keyword "is"+    spacesOrComment+    funcName <- atomicExprP+    args <- choice [groupP "(" ")" funcArgP+                  , option [] $ funcArgP >>= (\a -> return [a])]+    return $ \e -> CallE pos (addIsPrefix funcName) ((Nothing, e):args)+    where+      addIsPrefix :: Expression a -> Expression a+      addIsPrefix expr = case expr of+                           (VarE a text) -> VarE a $ Text.append (Text.pack "is_") text+                           _ -> expr+ atomicExprP :: Monad m => Parser m (Expression SourcePos) atomicExprP = doExprP             <|> parenthesizedExprP@@ -1170,7 +1249,9 @@     litName <- identifierP     spacesOrComment     return $ case litName of+        "True" -> BoolLiteralE pos True         "true" -> BoolLiteralE pos True+        "False" -> BoolLiteralE pos False         "false" -> BoolLiteralE pos False         "null" -> NullLiteralE pos         _ -> VarE pos litName@@ -1240,3 +1321,5 @@     string kw     notFollowedBy identCharP     return kw++-- vim: sw=4
src/Text/Ginger/Run.hs view
@@ -129,7 +129,7 @@     , ("capitalize", fromFunction . variadicStringFunc $ mconcat . Prelude.map capitalize)     , ("ceil", fromFunction . unaryNumericFunc 0 $ Prelude.fromIntegral . Prelude.ceiling)     , ("center", fromFunction gfnCenter)-    , ("concat", fromFunction . variadicStringFunc $ mconcat)+    , ("concat", fromFunction gfnConcat)     , ("contains", fromFunction gfnContains)     , ("d", fromFunction gfnDefault)     , ("date", fromFunction gfnDateFormat)@@ -137,27 +137,40 @@     , ("default", fromFunction gfnDefault)     , ("dictsort", fromFunction gfnDictsort)     , ("difference", fromFunction . variadicNumericFunc 0 $ difference)+    , ("divisibleby", fromFunction gfnDivisibleBy)     , ("e", fromFunction gfnEscape)+    , ("eq", fromFunction gfnEquals)     , ("equals", fromFunction gfnEquals)+    , ("equalto", fromFunction gfnEquals)     , ("escape", fromFunction gfnEscape)     , ("eval", fromFunction gfnEval)+    , ("even", fromFunction gfnEven)     , ("filesizeformat", fromFunction gfnFileSizeFormat)     , ("filter", fromFunction gfnFilter)     , ("floor", fromFunction . unaryNumericFunc 0 $ Prelude.fromIntegral . Prelude.floor)     , ("format", fromFunction gfnPrintf)+    , ("ge", fromFunction gfnGreaterEquals)+    , ("gt", fromFunction gfnGreater)     , ("greater", fromFunction gfnGreater)+    , ("greaterthan", 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)+    , ("is_lt", fromFunction gfnLess)     , ("iterable", fromFunction . unaryFunc $ toGVal . (\x -> isList x || isDict x))     , ("json", fromFunction gfnJSON)     , ("length", fromFunction . unaryFunc $ toGVal . length)+    , ("le", fromFunction gfnLessEquals)     , ("less", fromFunction gfnLess)+    , ("lessthan", fromFunction gfnLess)     , ("lessEquals", fromFunction gfnLessEquals)+    , ("lt", fromFunction gfnLess)     , ("map", fromFunction gfnMap)     , ("modulo", fromFunction . variadicNumericFunc 1 $ fromIntegral . modulo . Prelude.map Prelude.floor)+    , ("ne", fromFunction gfnNEquals)     , ("nequals", fromFunction gfnNEquals)     , ("num", fromFunction . unaryFunc $ toGVal . asNumber)+    , ("odd", fromFunction gfnOdd)     , ("printf", fromFunction gfnPrintf)     , ("product", fromFunction . variadicNumericFunc 1 $ Prelude.product)     , ("ratio", fromFunction . variadicNumericFunc 1 $ Scientific.fromFloatDigits . ratio . Prelude.map Scientific.toRealFloat)@@ -173,6 +186,32 @@     , ("upper", fromFunction . variadicStringFunc $ mconcat . Prelude.map Text.toUpper)     , ("lower", fromFunction . variadicStringFunc $ mconcat . Prelude.map Text.toLower)     , ("throw", fromFunction gfnThrow)++    -- Tests/predicates++    , ("in", fromFunction gfnIn)+    , ("escaped", fromFunction gfnEscaped)++    -- TODO: sameas (predicate)+    -- NOTE that this test doesn't make sense in a host language where pointers+    -- are transparent - in Haskell, we simply don't care whether two values+    -- share a memory location or not, and whether they do or not might even+    -- depend on build flags.++    -- TODO: mapping (predicate)+    -- TODO: none (predicate)+    -- TODO: number (predicate)+    -- TODO: sequence (predicate)+    -- TODO: string (predicate)+    -- TODO: callable++    -- TODO: defined (predicate)+    -- TODO: undefined (predicate)+    -- NOTE that @defined@ cannot actually be written as a function. See+    -- issue #33.++    -- TODO: lower (predicate)+    -- TODO: upper (predicate)     ]  -- | Simplified interface to render a ginger template \"into\" a monad.
src/Text/Ginger/Run/Builtins.hs view
@@ -62,7 +62,7 @@ import Safe (readMay, lastDef, headMay) import Network.HTTP.Types (urlEncode) import Debug.Trace (trace)-import Data.List (lookup, zipWith, unzip)+import Data.List (lookup, zipWith, unzip, foldl') import Data.Time ( defaultTimeLocale                  , formatTime                  , LocalTime (..)@@ -99,28 +99,62 @@         . asText         ) -gfnDefault :: Monad m => Function (Run p m h)+gfnDefault :: Monad m => Function m gfnDefault [] = return def gfnDefault ((_, x):xs)     | asBoolean x = return x     | otherwise = gfnDefault xs -gfnEscape :: Monad m => Function (Run p m h)+gfnEscape :: Monad m => Function m gfnEscape = return . toGVal . html . mconcat . fmap (asText . snd) -gfnAny :: Monad m => Function (Run p m h)+-- Check if all arguments are HTML-\"escaped\" (sic!) NOTE that this doesn't+-- really make much sense considering the way Ginger works - every GVal is, by+-- construction, both escaped in its 'asGVal' representation and not escaped in+-- its 'asText' representation, at the same time.+-- So what we check instead is whether the current 'asHtml'representation of+-- the value is exactly the same as what explicitly HTML-encoding the 'asText'+-- representation would give. In other words, we check whether the HTML+-- representations of @{{ v }}@ and @{{ v|escape }}@ match.+gfnEscaped :: Monad m => Function m+gfnEscaped = return . toGVal . List.all (isEscaped . snd)+  where+    isEscaped v =+      (asHtml . toGVal . html . asText $ v) ==+      (asHtml v)++gfnAny :: Monad m => Function m gfnAny xs = return . toGVal $ Prelude.any (asBoolean . snd) xs -gfnAll :: Monad m => Function (Run p m h)+gfnAll :: Monad m => Function m gfnAll xs = return . toGVal $ Prelude.all (asBoolean . snd) xs -gfnEquals :: Monad m => Function (Run p m h)+gfnIn :: Monad m => Function m+gfnIn [] =+  return def+gfnIn [needle] =+  return $ toGVal False+gfnIn [(_, needle),(_, haystack)] =+  return . toGVal $ inDict needle haystack || inList needle haystack++inList :: GVal m -> GVal m -> Bool+inList needle haystack =+  maybe+    False+    (List.any (looseEquals needle))+    (asList haystack)++inDict :: GVal m -> GVal m -> Bool+inDict needle haystack =+  isJust $ lookupKey (asText needle) haystack++gfnEquals :: Monad m => Function m gfnEquals [] = return $ toGVal True gfnEquals [x] = return $ toGVal True gfnEquals (x:xs) =     return . toGVal $ Prelude.all ((snd x `looseEquals`) . snd) xs -gfnNEquals :: Monad m => Function (Run p m h)+gfnNEquals :: Monad m => Function m gfnNEquals [] = return $ toGVal True gfnNEquals [x] = return $ toGVal True gfnNEquals (x:xs) =@@ -135,7 +169,15 @@         es `areInList` xs = Prelude.all (`isInList` xs) es     return . toGVal $ rawElems `areInList` rawList -looseEquals :: GVal (Run p m h) -> GVal (Run p m h) -> Bool+gfnConcat :: Monad m => Function m+gfnConcat [] =+  return $ toGVal False+gfnConcat [x] =+  return (snd x)+gfnConcat (x:xs) =+  return $ foldl' gappend (snd x) (fmap snd xs)++looseEquals :: GVal m -> GVal m -> Bool looseEquals a b     | isJust (asFunction a) || isJust (asFunction b) = False     | isJust (asList a) /= isJust (asList b) = False@@ -146,44 +188,44 @@     | isNull a || isNull b = asBoolean a == asBoolean b     | otherwise = asText a == asText b -gfnLess :: Monad m => Function (Run p m h)+gfnLess :: Monad m => Function m gfnLess [] = return . toGVal $ False gfnLess xs' =     let xs = fmap snd xs'     in return . toGVal $         Prelude.all (== Just True) (Prelude.zipWith less xs (Prelude.tail xs)) -gfnGreater :: Monad m => Function (Run p m h)+gfnGreater :: Monad m => Function m gfnGreater [] = return . toGVal $ False gfnGreater xs' =     let xs = fmap snd xs'     in return . toGVal $         Prelude.all (== Just True) (Prelude.zipWith greater xs (Prelude.tail xs)) -gfnLessEquals :: Monad m => Function (Run p m h)+gfnLessEquals :: Monad m => Function m gfnLessEquals [] = return . toGVal $ False gfnLessEquals xs' =     let xs = fmap snd xs'     in return . toGVal $         Prelude.all (== Just True) (Prelude.zipWith lessEq xs (Prelude.tail xs)) -gfnGreaterEquals :: Monad m => Function (Run p m h)+gfnGreaterEquals :: Monad m => Function m gfnGreaterEquals [] = return . toGVal $ False gfnGreaterEquals xs' =     let xs = fmap snd xs'     in return . toGVal $         Prelude.all (== Just True) (Prelude.zipWith greaterEq xs (Prelude.tail xs)) -less :: Monad m => GVal (Run p m h) -> GVal (Run p m h) -> Maybe Bool+less :: Monad m => GVal m -> GVal m -> Maybe Bool less a b = (<) <$> asNumber a <*> asNumber b -greater :: Monad m => GVal (Run p m h) -> GVal (Run p m h) -> Maybe Bool+greater :: Monad m => GVal m -> GVal m -> Maybe Bool greater a b = (>) <$> asNumber a <*> asNumber b -lessEq :: Monad m => GVal (Run p m h) -> GVal (Run p m h) -> Maybe Bool+lessEq :: Monad m => GVal m -> GVal m -> Maybe Bool lessEq a b = (<=) <$> asNumber a <*> asNumber b -greaterEq :: Monad m => GVal (Run p m h) -> GVal (Run p m h) -> Maybe Bool+greaterEq :: Monad m => GVal m -> GVal m -> Maybe Bool greaterEq a b = (>=) <$> asNumber a <*> asNumber b  difference :: Prelude.Num a => [a] -> a@@ -205,7 +247,7 @@ capitalize :: Text -> Text capitalize txt = Text.toUpper (Text.take 1 txt) <> Text.drop 1 txt -gfnCenter :: Monad m => Function (Run p m h)+gfnCenter :: Monad m => Function m gfnCenter [] = gfnCenter [(Nothing, toGVal ("" :: Text))] gfnCenter [x] = gfnCenter [x, (Nothing, toGVal (80 :: Int))] gfnCenter [x,y] = gfnCenter [x, y, (Nothing, toGVal (" " :: Text))]@@ -267,7 +309,7 @@             return . toGVal $ Text.replace search replace str         _ -> throwHere $ ArgumentsError (Just "replace") "expected: (str, search, replace)" -gfnMap :: Monad m => Function (Run p m h)+gfnMap :: Monad m => Function m gfnMap args = do     let parsedArgs = extractArgsDefL             [ ("collection", def)@@ -289,7 +331,7 @@         (Nothing, Just key) -> return $ \case             (_, item):_ ->                 return $ lookupLooseDef def (toGVal key) item-            _ -> +            _ ->                 return def         _ -> fail "You have to pass a function or an attribute"     case (dictMay, listMay) of@@ -300,9 +342,9 @@             toGVal <$> mapM (mapFunction . (:[]) . (Nothing,)) items         (Nothing, Nothing) ->             return def-             -gfnSort :: Monad m => Function (Run p m h)++gfnSort :: forall p m h. Monad m => Function (Run p m h) gfnSort args = do     let parsedArgs = extractArgsDefL             [ ("sortee", def)@@ -317,13 +359,13 @@                    , asBoolean reverseG                    )         _ -> throwHere $ ArgumentsError (Just "sort") "expected: (sortee, by, reverse)"-    let -- extractByFunc :: Maybe ((Text, GVal (Run p m h)) -> Run p m h (GVal (Run p m h)))+    let extractByFunc :: Maybe ((Text, GVal (Run p m h)) -> Run p m h (GVal (Run p m h)))         extractByFunc = do             f <- asFunction sortKey             return $ \g ->                 f [(Nothing, snd g)] -    let -- extractByPath :: Maybe ((Text, GVal (Run p m h)) -> Run p m h (GVal (Run p m h)))+    let extractByPath :: Maybe ((Text, GVal (Run p m h)) -> Run p m h (GVal (Run p m h)))         extractByPath = do             keys <- asList sortKey             return $ \g ->@@ -389,7 +431,7 @@         repsR = Prelude.succ charsR `div` Text.length pad         paddingR = Text.take charsR . Text.replicate repsR $ pad -gfnFileSizeFormat :: Monad m => Function (Run p m h)+gfnFileSizeFormat :: Monad m => Function m gfnFileSizeFormat [(_, sizeG)] =     gfnFileSizeFormat [(Nothing, sizeG), (Nothing, def)] gfnFileSizeFormat [(_, sizeG), (_, binaryG)] = do@@ -647,3 +689,19 @@             encoder $             gVal       Left _ -> throwHere $ ArgumentsError (Just "json") "expected: one argument"+++-- Built-in tests+--gfnDefined :: Monad m => Function (Run p m h)+--gfnDefined = unaryFunc $ toGVal . isJust . fmap getVar . fromGVal++gfnDivisibleBy :: Monad m => Function (Run p m h)+gfnDivisibleBy = binaryFunc $ \x y -> toGVal $ divisibleBy <$> (toInteger x) <*> (toInteger y)+  where divisibleBy x y = x `Prelude.mod` y == 0++gfnEven :: Monad m => Function (Run p m h)+gfnEven = unaryFunc $ toGVal . fmap Prelude.even . toInteger++gfnOdd :: Monad m => Function (Run p m h)+gfnOdd = unaryFunc $ toGVal . fmap Prelude.odd . toInteger+
src/Text/Ginger/Run/FuncUtils.hs view
@@ -62,13 +62,26 @@  unaryFunc :: forall m h p. (Monad m) => (GVal (Run p m h) -> GVal (Run p m h)) -> Function (Run p m h) unaryFunc f [] = do-    warn $ ArgumentsError Nothing "expected at least one argument"+    warn $ ArgumentsError Nothing "expected exactly one argument (zero given)"     return def unaryFunc f ((_, x):[]) =     return (f x)-unaryFunc f ((_, x):xs) = do-    warn $ ArgumentsError Nothing "expected exactly one argument"+unaryFunc f ((_, x):_) = do+    warn $ ArgumentsError Nothing "expected exactly one argument (more given)"     return (f x)++binaryFunc :: forall m h p. (Monad m) => (GVal (Run p m h) -> GVal (Run p m h) -> GVal (Run p m h)) -> Function (Run p m h)+binaryFunc f [] = do+    warn $ ArgumentsError Nothing "expected exactly two arguments (zero given)"+    return def+binaryFunc f (_:[]) = do+    warn $ ArgumentsError Nothing "expected exactly two arguments (one given)"+    return def+binaryFunc f ((_, x):(_, y):[]) =+    return (f x y)+binaryFunc f ((_, x):(_, y):_) = do+    warn $ ArgumentsError Nothing "expected exactly two arguments (more given)"+    return (f x y)  ignoreArgNames :: ([a] -> b) -> ([(c, a)] -> b) ignoreArgNames f args = f (Prelude.map snd args)
test/Text/Ginger/SimulationTests.hs view
@@ -19,6 +19,7 @@ import qualified Data.ByteString.Lazy.UTF8 as LUTF8 import qualified Data.ByteString.Lazy as LBS import Data.Time (TimeLocale)+import Control.Exception  simulationTests :: TestTree simulationTests = testGroup "Simulation"@@ -101,8 +102,12 @@         , testGroup "Booleans"             [ testCase "true" $ mkTestHtml                 [] [] "{{ true }}" "1"+            , testCase "True" $ mkTestHtml+                [] [] "{{ True }}" "1"             , testCase "false" $ mkTestHtml                 [] [] "{{ false }}" ""+            , testCase "False" $ mkTestHtml+                [] [] "{{ False }}" ""             ]         , testCase "Null" $ mkTestHtml             [] [] "{{ null }}" ""@@ -218,6 +223,11 @@             mkTestHtml [] [] "{% if false %}yes{% elif false %}maybe{% else %}no{% endif %}" "no"         , testCase "if false then \"yes\" else if true then \"maybe\" else \"no\"" $ do             mkTestHtml [] [] "{% if false %}yes{% elif true %}maybe{% else %}no{% endif %}" "maybe"+        , testCase "if null should be false" $ do+            mkTestHtml [] [] "{% if null %}yes{% else %}no{% endif %}" "no"+--        TODO: Implement "not"+--        , testCase "if not true then \"yes\" else \"no\"" $ do+--            mkTestHtml [] [] "{% if not true %}yes{% else %}no{% endif %}" "no"         ]     , testGroup "Exceptions"         [ testCase "try/catch, no exception" $ do@@ -288,19 +298,31 @@             mkTestHtml [] [] "{% if (null < 1) %}yes{% else %}no{% endif %}" "no"         ]     , testGroup "Boolean AND"-        [ testCase "AND (both)" $ do+        [ testCase "AND (both) (and)" $ do+            mkTestHtml [] [] "{% if 1 and 2 %}yes{% else %}no{% endif %}" "yes"+        , testCase "AND (only one) (and)" $ do+            mkTestHtml [] [] "{% if 1 and 0 %}yes{% else %}no{% endif %}" "no"+        , testCase "AND (neither) (and)" $ do+            mkTestHtml [] [] "{% if 0 and 0 %}yes{% else %}no{% endif %}" "no"+        , testCase "AND (both) (&&)" $ do             mkTestHtml [] [] "{% if 1 && 2 %}yes{% else %}no{% endif %}" "yes"-        , testCase "AND (only one)" $ do+        , testCase "AND (only one) (&&)" $ do             mkTestHtml [] [] "{% if 1 && 0 %}yes{% else %}no{% endif %}" "no"-        , testCase "AND (neither)" $ do+        , testCase "AND (neither) (&&)" $ do             mkTestHtml [] [] "{% if 0 && 0 %}yes{% else %}no{% endif %}" "no"         ]     , testGroup "Boolean OR"-        [ testCase "OR (both)" $ do+        [ testCase "OR (both) (or)" $ do+            mkTestHtml [] [] "{% if 1 or 2 %}yes{% else %}no{% endif %}" "yes"+        , testCase "OR (only one) (or)" $ do+            mkTestHtml [] [] "{% if 1 or 0 %}yes{% else %}no{% endif %}" "yes"+        , testCase "OR (either) (or)" $ do+            mkTestHtml [] [] "{% if 0 or 0 %}yes{% else %}no{% endif %}" "no"+        , testCase "OR (both) (||)" $ do             mkTestHtml [] [] "{% if 1 || 2 %}yes{% else %}no{% endif %}" "yes"-        , testCase "OR (only one)" $ do+        , testCase "OR (only one) (||)" $ do             mkTestHtml [] [] "{% if 1 || 0 %}yes{% else %}no{% endif %}" "yes"-        , testCase "OR (either)" $ do+        , testCase "OR (either) (||)" $ do             mkTestHtml [] [] "{% if 0 || 0 %}yes{% else %}no{% endif %}" "no"         ]     , testGroup "Slicing brackets"@@ -321,7 +343,96 @@                 "{{ 'abcdef'[:2] }}"                 "ab"         ]-    , testGroup "Built-in filters/functions"+    , testGroup "Built-in tests"+--        TODO implement defined+--          testCase "defined(myvar) [defined]" $ do+--            mkTestHtml [] [] "{% set myvar=0 %}{% if defined(myvar) %}yes{% else %}no{% endif %}" "yes"+--        , testCase "defined(myvar) [notdefined]" $ do+--            mkTestHtml [] [] "{% if defined(myvar) %}yes{% else %}no{% endif %}" "no"+        [ testGroup "\"divisibleby\""+            [ testCase "divisibleby(14,7)" $ do+                mkTestHtml [] []+                    "{% if divisibleby(14,7) %}yes{% else %}no{% endif %}"+                    "yes"+            , testCase "divisibleby(14,6)" $ do+                mkTestHtml [] []+                    "{% if divisibleby(14,6) %}yes{% else %}no{% endif %}"+                    "no"+            ]+        , testGroup "\"even\""+            [ testCase "even(3)" $ do+                mkTestHtml [] []+                    "{% if even(3) %}yes{% else %}no{% endif %}"+                    "no"+            , testCase "even(\"2\")" $ do+                mkTestHtml [] []+                    "{% if even(\"2\") %}yes{% else %}no{% endif %}"+                    "yes"+            , testCase "even(\"3\")" $ do+                mkTestHtml [] []+                    "{% if even(\"3\") %}yes{% else %}no{% endif %}"+                    "no"+            , testCase "even(\"two\")" $ do+                mkTestHtml [] []+                   "{% if even(\"two\") %}yes{% else %}no{% endif %}"+                   "no"+            ]+        , testCase "\"eq\"" $ do+            mkTestHtml [] []+                "{% if eq(1,1) %}yes{% else %}no{% endif %}"+                "yes"+        , testCase "\"equalto\"" $ do+            mkTestHtml [] []+                "{% if equalto(1,1) %}yes{% else %}no{% endif %}"+                "yes"+        , testCase "\"ge\"" $ do+            mkTestHtml [] []+                "{% if ge(2,2) %}yes{% else %}no{% endif %}"+                "yes"+        , testCase "\"greaterthan\"" $ do+            mkTestHtml [] []+                "{% if greaterthan(2,1) %}yes{% else %}no{% endif %}"+                "yes"+        , testCase "\"gt\"" $ do+            mkTestHtml [] []+                "{% if ge(2,1) %}yes{% else %}no{% endif %}"+                "yes"+        , testCase "\"le\"" $ do+            mkTestHtml [] []+                "{% if le(2,2) %}yes{% else %}no{% endif %}"+                "yes"+        , testCase "\"lessthan\"" $ do+            mkTestHtml [] []+                "{% if lessthan(2,2) %}yes{% else %}no{% endif %}"+                "no"+        , testCase "\"lt\"" $ do+            mkTestHtml [] []+                "{% if lt(1,2) %}yes{% else %}no{% endif %}"+                "yes"+        , testCase "\"ne\"" $ do+            mkTestHtml [] []+                "{% if ne(1,2) %}yes{% else %}no{% endif %}"+                "yes"+        , testGroup "\"odd\""+            [ testCase "odd(2)" $ do+                mkTestHtml [] []+                    "{% if odd(2) %}yes{% else %}no{% endif %}"+                    "no"+            , testCase "odd(3)" $ do+                mkTestHtml [] []+                    "{% if odd(3) %}yes{% else %}no{% endif %}"+                    "yes"+            , testCase "odd(\"2\")" $ do+                mkTestHtml [] []+                    "{% if odd(\"2\") %}yes{% else %}no{% endif %}"+                    "no"+            , testCase "odd(\"3\")" $ do+                mkTestHtml [] []+                    "{% if odd(\"3\") %}yes{% else %}no{% endif %}"+                    "yes"+            ]+        ]+   , testGroup "Built-in filters/functions"         [ testCase "\"abs\"" $ do             mkTestHtml [] [] "{{ -2|abs }}" "2"         , testGroup "\"any\""@@ -492,8 +603,12 @@                     "&lt;&gt;"             ]         , testGroup "\"equals\""-            [ testCase "all equal" $ do+            [ testCase "two equal" $ do                 mkTestHtml [] []+                    "{% if equals(1, 1) %}yes{% else %}no{% endif %}"+                    "yes"+            , testCase "all equal" $ do+                mkTestHtml [] []                     "{% if equals(1, 1, 1) %}yes{% else %}no{% endif %}"                     "yes"             , testCase "some equal" $ do@@ -797,6 +912,24 @@                     "{{ [1,2,3]|json(false) }}"                     "[1,2,3]"             ]+        , testGroup "\"in\""+            [ testCase "elem in list" $ do+                mkTestHtml [] []+                    "{% if 'foo'|in(['bar', 'baz', 'foo']) %}yes{% else %}no{% endif %}"+                    "yes"+            , testCase "elem not in list" $ do+                mkTestHtml [] []+                    "{% if 'foo'|in(['bar', 'baz', 'fooq']) %}yes{% else %}no{% endif %}"+                    "no"+            , testCase "elem in dict" $ do+                mkTestHtml [] []+                    "{% if 'foo'|in({'bar': false, 'baz': false, 'foo': false}) %}yes{% else %}no{% endif %}"+                    "yes"+            , testCase "elem not in dict" $ do+                mkTestHtml [] []+                    "{% if 'foo'|in({'bar': false, 'baz': false, 'fooq': false}) %}yes{% else %}no{% endif %}"+                    "no"+            ]         ]     , testGroup "Setting variables"         [ testCase "plain" $ do@@ -1234,8 +1367,66 @@                 "{{ do { 'hello'; 'world'; } }}"                 "world"         ]+    , testGroup "overriding delimiters"+        [ testCase "angle brackets" $ do+            mkTestHtmlOpts+              (\o -> o { poDelimiters = angleBracketDelimiters })+              [] []+              "<% for i in [1,2,3] %><# Comment! -#> << i >> <%- endfor %>"+              "123"+        , testCase "evil mode" $ do+            mkTestHtmlOpts+              (\o -> o { poDelimiters = evilDelimiters })+              [] []+              "<?for i in [1,2,3] ?><!-- Comment! ---> <?= i ?> <?- endfor ?>"+              "123"+        ]+    , testGroup "is-tests"+           [ testCase "basic is-test, true" $ do+              mkTestHtml [] []+                "{% if 1 is lt(2) %}true{% else %}false{% endif %}"+                "true"+          , testCase "basic is-test, false" $ do+              mkTestHtml [] []+                "{% if 1 is lt(1) %}true{% else %}false{% endif %}"+                "false"+          , testCase "parens-less argument syntax" $ do+              mkTestHtml [] []+                "{% if 1 is lt 2 %}true{% else %}false{% endif %}"+                "true"+          , testCase "precedence vs booleans" $ do+              mkTestHtml [] []+                "{% if false && 1 is lt(1) %}true{% else %}false{% endif %}"+                "false"+          , testCase "precedence vs addition" $ do+              mkTestHtml [] []+                "{% if 1 + 1 is lt(2) %}true{% else %}false{% endif %}"+                "true"+          ]     ] +angleBracketDelimiters :: Delimiters+angleBracketDelimiters+    = Delimiters+        { delimOpenInterpolation = "<<"+        , delimCloseInterpolation = ">>"+        , delimOpenTag = "<%"+        , delimCloseTag = "%>"+        , delimOpenComment = "<#"+        , delimCloseComment = "#>"+        }++evilDelimiters :: Delimiters+evilDelimiters+    = Delimiters+        { delimOpenInterpolation = "<?="+        , delimCloseInterpolation = "?>"+        , delimOpenTag = "<?"+        , delimCloseTag = "?>"+        , delimOpenComment = "<!--"+        , delimCloseComment = "-->"+        }+ mkTestHtml :: [(VarName, GVal (Run SourcePos IO Html))]            -> [(FilePath, String)]            -> String@@ -1281,17 +1472,24 @@        -> Text -- ^ Expected output        -> Assertion mkTest setOptions mContext valToText contextDict includeLookup src expected = do-    let resolver srcName = return $ lookup srcName includeLookup-    let options = setOptions (mkParserOptions resolver)-    template <- either (fail . show) return =<< parseGinger' options src-    output <- newIORef mempty-    let write h = modifyIORef output (<> h)-    let context = mContext-                    (\key -> return $ fromMaybe def (lookup key contextDict))-                    write-    runGingerT context (optimize template)-    actual <- valToText <$> readIORef output-    assertEqual "" expected actual+  run `catch` handleParserError+  where+    run = do+      let resolver srcName = return $ lookup srcName includeLookup+      let options = setOptions (mkParserOptions resolver)+      template <- either throw return =<< parseGinger' options src+      output <- newIORef mempty+      let write h = modifyIORef output (<> h)+      let context = mContext+                      (\key -> return $ fromMaybe def (lookup key contextDict))+                      write+      runGingerT context (optimize template)+      actual <- valToText <$> readIORef output+      assertEqual "" expected actual++    handleParserError :: ParserError -> IO ()+    handleParserError err = do+      assertBool (formatParserError (Just src) err) False  loadSillyLocale :: IO (Maybe JSON.Value) loadSillyLocale = do