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 +20/−0
- README.md +16/−10
- cli/GingerCLI.hs +29/−3
- ginger.cabal +9/−4
- src/Text/Ginger.hs +6/−3
- src/Text/Ginger/GVal.hs +35/−2
- src/Text/Ginger/Html.hs +2/−2
- src/Text/Ginger/Optimizer.hs +31/−31
- src/Text/Ginger/PHP.hs +113/−0
- src/Text/Ginger/Parse.hs +117/−34
- src/Text/Ginger/Run.hs +40/−1
- src/Text/Ginger/Run/Builtins.hs +82/−24
- src/Text/Ginger/Run/FuncUtils.hs +16/−3
- test/Text/Ginger/SimulationTests.hs +217/−19
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 @@ "<>" ] , 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