diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,16 @@ +## 0.8.3.0 + +- Added builtin `regex` module for POSIX regular expressions support + +## 0.8.2.0 + +- Expose some internals of the `Run` type and the default implementations of + built-in functions / filters + +## 0.8.1.0 + +- Added built-ins: `partial`, `zip`, `zipwith`, `compose` + ## 0.8.0.0 - Now compiles on GHC 8.4 diff --git a/ginger.cabal b/ginger.cabal --- a/ginger.cabal +++ b/ginger.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: ginger -version: 0.8.2.0 +version: 0.8.3.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. @@ -44,6 +44,7 @@ , http-types >= 0.8 && (< 0.11 || >= 0.12) , mtl >= 2.2 , parsec >= 3.0 + , regex-tdfa >=1.2.3.1 && <=1.3 , safe >= 0.3 , scientific >= 0.3 , text diff --git a/src/Text/Ginger/GVal.hs b/src/Text/Ginger/GVal.hs --- a/src/Text/Ginger/GVal.hs +++ b/src/Text/Ginger/GVal.hs @@ -133,6 +133,7 @@ (JSON.Null, b) -> Just $ b (a, JSON.Null) -> Just $ a _ -> Nothing -- If JSON tags mismatch, use default toJSON impl + , length = (+) <$> length a <*> length b } -- | Marshal a GVal between carrier monads. diff --git a/src/Text/Ginger/Run.hs b/src/Text/Ginger/Run.hs --- a/src/Text/Ginger/Run.hs +++ b/src/Text/Ginger/Run.hs @@ -201,6 +201,8 @@ , ("in", fromFunction gfnIn) , ("escaped", fromFunction gfnEscaped) + , ("regex", gfoRegex) + -- 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 diff --git a/src/Text/Ginger/Run/Builtins.hs b/src/Text/Ginger/Run/Builtins.hs --- a/src/Text/Ginger/Run/Builtins.hs +++ b/src/Text/Ginger/Run/Builtins.hs @@ -34,6 +34,8 @@ , Either (..) , id , flip + , const + , either ) import qualified Prelude import Data.Maybe (fromMaybe, isJust, isNothing) @@ -82,9 +84,10 @@ , TimeLocale (..) , TimeZone (..) ) -import Data.Foldable (asum) +import Data.Foldable (asum, toList) import qualified Data.Aeson as JSON import qualified Data.Aeson.Encode.Pretty as JSON +import qualified Text.Regex.TDFA as RE tshow :: Show a => a -> Text tshow = Text.pack . show @@ -771,3 +774,62 @@ gfnOdd :: Monad m => Function (Run p m h) gfnOdd = unaryFunc $ toGVal . fmap Prelude.odd . toInteger +gfoRegex :: Monad m => GVal (Run p m h) +gfoRegex = + dict + [ ("match", fromFunction gfnReMatchOne) + , ("matches", fromFunction gfnReMatch) + , ("test", fromFunction gfnReTest) + ] + +gfnReMatchOne :: forall p m h. Monad m => Function (Run p m h) +gfnReMatchOne args = + toGVal . fmap (\(_, m, _) -> matchTextToGVal m :: GVal (Run p m h)) <$> fnReMatch RE.matchOnceText args + +gfnReMatch :: forall p m h. Monad m => Function (Run p m h) +gfnReMatch args = + toGVal . fmap (matchTextToGVal :: RE.MatchText String -> GVal (Run p m h)) <$> fnReMatch RE.matchAllText args + +gfnReTest :: Monad m => Function (Run p m h) +gfnReTest args = + toGVal <$> fnReMatch RE.matchTest args + +matchTextToGVal :: Monad m => RE.MatchText String -> GVal m +matchTextToGVal matchArr = + let base = toGVal . toList . fmap (Text.pack . fst) $ matchArr + textRepr = fromMaybe "" . fmap (Text.pack . fst) . headMay . toList $ matchArr + in base + { asText = textRepr + , asHtml = html textRepr + } + +fnReMatch matchFunc args = + let gArgs = extractArgsL ["re", "haystack", "opts"] args + in either (const barf) go gArgs + where + go = \case + [r, h, Nothing] -> + go [r, h, Just def] + [Just reG, Just haystackG, Just optsG] -> do + opts <- parseCompOpts optsG + let re = RE.makeRegexOpts opts RE.defaultExecOpt (Text.unpack . asText $ reG) + haystack = Text.unpack . asText $ haystackG + return $ matchFunc re haystack + _ -> barf + barf = do + throwHere $ ArgumentsError (Just "re.match") "expected: regex, haystack, [opts]" + +parseCompOpts :: Monad m => GVal (Run p m h) -> Run p m h RE.CompOption +parseCompOpts g = do + let str = Text.unpack . asText $ g + foldM + (\x -> + \case + 'i' -> return x { RE.caseSensitive = False } + 'm' -> return x { RE.multiline = True } + c -> do + warn $ ArgumentsError Nothing $ "unexpected regex modifier: " <> tshow c + return x + ) + RE.blankCompOpt + str diff --git a/test/Text/Ginger/SimulationTests.hs b/test/Text/Ginger/SimulationTests.hs --- a/test/Text/Ginger/SimulationTests.hs +++ b/test/Text/Ginger/SimulationTests.hs @@ -5,6 +5,7 @@ import Text.Ginger import Text.Ginger.Html +import Text.Ginger.Run.Type (GingerContext (..)) import Test.Tasty import Test.Tasty.HUnit import Data.Default (def) @@ -1424,6 +1425,38 @@ "{% if 1 + 1 is lt(2) %}true{% else %}false{% endif %}" "true" ] + , testGroup "regex module" + [ testGroup "regex.test" + [ testCase "simple match" $ do + mkTestText [] [] + "{{ regex.test('[a-z]', 'abcde') ? 'yes' : 'no' }}" + "yes" + , testCase "simple match" $ do + mkTestText [] [] + "{{ regex.test('[a-z]', '12345') ? 'yes' : 'no' }}" + "no" + ] + , testGroup "regex.match" + [ testCase "simple match" $ do + mkTestText [] [] + "{{ regex.match('[a-z]', 'abcde') }}" + "a" + , testCase "string representation of multiple matches returns only whole match" $ do + mkTestText [] [] + "{{ regex.match('(foo)(bar)', 'foobar') }}" + "foobar" + , testCase "html representation of multiple matches returns only whole match" $ do + mkTestHtml [] [] + "{{ regex.match('(foo)(bar)', 'foobar') }}" + "foobar" + ] + , testGroup "regex.matches" + [ testCase "simple match" $ do + mkTestText [] [] + "{{ regex.matches('[a-z]', 'abc')|json(pretty=false) }}" + "[[\"a\"],[\"b\"],[\"c\"]]" + ] + ] ] angleBracketDelimiters :: Delimiters @@ -1501,9 +1534,10 @@ template <- either throw return =<< parseGinger' options src output <- newIORef mempty let write h = modifyIORef output (<> h) - let context = mContext + let context' = mContext (\key -> return $ fromMaybe def (lookup key contextDict)) write + context = context' { contextWarn = liftRun2 $ print } runGingerT context (optimize template) actual <- valToText <$> readIORef output assertEqual "" expected actual