ginger 0.8.4.1 → 0.10.6.0
raw patch · 13 files changed
Files
- CHANGELOG.md +6/−0
- cli/GingerCLI.hs +2/−1
- cli/Options.hs +1/−0
- ginger.cabal +33/−46
- src/Text/Ginger/GVal.hs +94/−1
- src/Text/Ginger/Parse.hs +15/−5
- src/Text/Ginger/Run.hs +16/−18
- src/Text/Ginger/Run/Builtins.hs +66/−17
- src/Text/Ginger/Run/Type.hs +12/−11
- src/Text/PrintfA.hs +1/−1
- test/Spec.hs +1/−0
- test/Text/Ginger/PropertyTests.hs +10/−0
- test/Text/Ginger/SimulationTests.hs +30/−0
CHANGELOG.md view
@@ -1,3 +1,9 @@+## 0.9.0.0++- Added `split()` builtin+- Added support for byte arrays, represented as `ByteString` on the Haskell+ side+ ## 0.8.4.0 - Added builtin `apply`, making it possible to pass argument lists as arrays
cli/GingerCLI.hs view
@@ -8,7 +8,8 @@ import Text.Ginger import Text.Ginger.Html-import Data.Text as Text+import Data.Text (Text)+import qualified Data.Text as Text import qualified Data.Aeson as JSON import qualified Data.Yaml as YAML import Data.Maybe
cli/Options.hs view
@@ -1,6 +1,7 @@ module Options where +import Data.Semigroup ( (<>) ) -- needed for GHC 8.0 and 8.2 import Options.Applicative
ginger.cabal view
@@ -1,8 +1,6 @@--- Initial ginger.cabal generated by cabal init. For further--- documentation, see http://haskell.org/cabal/users-guide/-+cabal-version: 2.2 name: ginger-version: 0.8.4.1+version: 0.10.6.0 synopsis: An implementation of the Jinja2 template language in Haskell description: Ginger is Jinja, minus the most blatant pythonisms. Wants to be feature complete, but isn't quite there yet.@@ -17,14 +15,26 @@ extra-source-files: README.md , CHANGELOG.md data-files: test/fixtures/*.json-cabal-version: >=1.10 bug-reports: https://github.com/tdammers/ginger/issues source-repository head type: git location: https://github.com/tdammers/ginger +common deps+ build-depends: base >=4.8 && <5+ , aeson >=1.4.2.0 && <2.3+ , bytestring >=0.10.8.2 && <0.13+ , data-default >= 0.5 && <0.9+ , mtl >= 2.2 && <2.4+ , text >=1.2.3.1 && <2.2+ , time >= 0.1.6.0 && <1.15+ , transformers >= 0.3 && <0.7+ , unordered-containers >= 0.2.5 && <0.3+ , utf8-string >=1.0.1.1 && <1.1+ library+ import: deps exposed-modules: Text.Ginger , Text.Ginger.AST , Text.Ginger.GVal@@ -39,65 +49,42 @@ , Text.Ginger.Run.FuncUtils -- other-modules: -- other-extensions:- build-depends: base >=4.8 && <5- , aeson >=1.4.2.0 && <1.5- , aeson-pretty >=0.8.7 && <0.9- , bytestring >=0.10.8.2 && <0.11- , data-default >= 0.5- , filepath >= 1.3- , http-types >= 0.8 && (< 0.11 || >= 0.12)- , mtl >= 2.2- , parsec >= 3.0- , regex-tdfa >=1.2.3 && <=1.3- , safe >= 0.3- , scientific >= 0.3- , text >=1.2.3.1 && <1.3- , time >= 0.1.6.0- , transformers >= 0.3- , unordered-containers >= 0.2.5- , utf8-string >=1.0.1.1 && <1.1- , vector >=0.12.0.2 && <0.13+ build-depends: aeson-pretty >=0.8.7 && <0.9+ , containers >=0.6.4 && <0.8+ , filepath >= 1.3 && <1.6+ , http-types >= 0.8 && (< 0.11 || >= 0.12) && <0.13+ , parsec >= 3.0 && <3.2+ , regex-tdfa >=1.2.3 && <=1.4+ , safe >= 0.3 && <0.4+ , scientific >= 0.3 && <0.4+ , vector >=0.12.0.2 && <0.14 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.* hs-source-dirs: src default-language: Haskell2010 executable ginger+ import: deps+ if impl(ghcjs)+ buildable: False main-is: GingerCLI.hs other-modules: Options hs-source-dirs: cli default-language: Haskell2010- build-depends: base >= 4.8 && <5- , ginger- , aeson >=1.4.2.0 && <1.5- , bytestring >=0.10.8.2 && <0.11- , data-default >= 0.5- , optparse-applicative >=0.14.3.0 && <0.15+ build-depends: ginger+ , optparse-applicative >=0.14.3.0 && <0.19 , process >=1.6.5.0 && <1.7- , text >=1.2.3.1 && <1.3- , transformers >=0.5.6.2 && <0.6- , unordered-containers >= 0.2.5- , utf8-string >=1.0.1.1 && <1.1 , yaml >=0.11.0.0 && <0.12 test-suite tests+ import: deps type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Text.Ginger.PropertyTests , Text.Ginger.SimulationTests hs-source-dirs: test default-language: Haskell2010- build-depends: base >=4.8 && <5- , ginger- , aeson >=1.4.2.0 && <1.5- , bytestring >=0.10.8.2 && <0.11- , data-default >=0.5- , mtl >=2.2.2 && <2.3- , tasty >=1.2.1 && <1.3+ build-depends: ginger+ , tasty >=1.2 && <1.6 , tasty-hunit >=0.10.0.1 && <0.11- , tasty-quickcheck >=0.10 && <0.11- , text >=1.2.3.1 && <1.3- , time >= 0.1.6.0- , transformers >=0.5.6.2 && <0.6- , unordered-containers >= 0.2.5- , utf8-string >=1.0.1.1 && <1.1+ , tasty-quickcheck >=0.10 && <0.12
src/Text/Ginger/GVal.hs view
@@ -1,3 +1,4 @@+{-#LANGUAGE CPP #-} {-#LANGUAGE OverloadedStrings #-} {-#LANGUAGE MultiParamTypeClasses #-} {-#LANGUAGE FlexibleInstances #-}@@ -38,6 +39,7 @@ , Monad , Functor )+import Control.Monad.Fail (MonadFail) import qualified Prelude import Data.Maybe ( fromMaybe, catMaybes, isJust, mapMaybe ) import Data.Text (Text)@@ -58,8 +60,14 @@ import Data.Fixed (Fixed (..), Pico) import Control.Applicative import qualified Data.Aeson as JSON+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.Key as AK+import qualified Data.Aeson.KeyMap as AKM+#endif import qualified Data.HashMap.Strict as HashMap import Data.HashMap.Strict (HashMap)+import qualified Data.Map.Strict as Map+import Data.Map.Strict (Map) import qualified Data.Vector as Vector import Control.Monad ((<=<), forM, mapM) import Control.Monad.Trans (MonadTrans, lift)@@ -78,6 +86,11 @@ , TimeZone (..) , TimeLocale (..) )+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.Text.Encoding (encodeUtf8, decodeUtf8)+import qualified Data.Text.Lazy.Encoding as LText import Text.Ginger.Html @@ -106,6 +119,7 @@ , asBoolean :: Bool -- ^ Get value's truthiness , asNumber :: Maybe Scientific -- ^ Convert value to a number, if possible , asFunction :: Maybe (Function m) -- ^ Access value as a callable function, if it is one+ , asBytes :: Maybe ByteString -- ^ Access as raw bytes , length :: Maybe Int -- ^ Get length of value, if it is a collection (list/dict) , isNull :: Bool -- ^ Check if the value is null , asJSON :: Maybe JSON.Value -- ^ Provide a custom JSON representation of the value@@ -122,6 +136,7 @@ return $ \k -> lookupA k <|> lookupB k , asHtml = asHtml a <> asHtml b , asText = asText a <> asText b+ , asBytes = asBytes a <> asBytes b , asBoolean = (asBoolean a || asBoolean b) && not (isNull a || isNull b) , asNumber = readMay . Text.unpack $ (asText a <> asText b) , asFunction = Nothing@@ -148,6 +163,7 @@ , asLookup = fmap (fmap marshalGVal .) (asLookup g) , asHtml = asHtml g , asText = asText g+ , asBytes = asBytes g , asBoolean = asBoolean g , asNumber = asNumber g , asFunction = Nothing@@ -173,6 +189,7 @@ , asLookup = fmap (fmap (marshalGValEx hoist unhoist) .) (asLookup g) , asHtml = asHtml g , asText = asText g+ , asBytes = asBytes g , asBoolean = asBoolean g , asNumber = asNumber g , asFunction = marshalFunction hoist unhoist <$> asFunction g@@ -202,6 +219,7 @@ , asLookup = Nothing , asHtml = unsafeRawHtml "" , asText = ""+ , asBytes = Nothing , asBoolean = False , asNumber = Nothing , asFunction = Nothing@@ -323,6 +341,7 @@ def { asHtml = mconcat . Prelude.map asHtml $ xs , asText = mconcat . Prelude.map asText $ xs+ , asBytes = mconcat . Prelude.map asBytes $ xs , asBoolean = not . List.null $ xs , isNull = False , asList = Just $ Prelude.map toGVal xs@@ -338,12 +357,29 @@ def { asHtml = mconcat . Prelude.map asHtml . HashMap.elems $ xs , asText = mconcat . Prelude.map asText . HashMap.elems $ xs+ , asBytes = mconcat . Prelude.map asBytes . HashMap.elems $ xs , asBoolean = not . HashMap.null $ xs , isNull = False , asLookup = Just (`HashMap.lookup` xs) , asDictItems = Just $ HashMap.toList xs } +-- | 'Map' of 'Text' becomes a dictionary-like 'GVal'+instance ToGVal m v => ToGVal m (Map Text v) where+ toGVal xs = helper (Map.map toGVal xs)+ where+ helper :: Map Text (GVal m) -> GVal m+ helper xs =+ def+ { asHtml = mconcat . Prelude.map asHtml . Map.elems $ xs+ , asText = mconcat . Prelude.map asText . Map.elems $ xs+ , asBytes = mconcat . Prelude.map asBytes . Map.elems $ xs+ , asBoolean = not . Map.null $ xs+ , isNull = False+ , asLookup = Just (`Map.lookup` xs)+ , asDictItems = Just $ Map.toAscList xs+ }+ instance ToGVal m Int where toGVal x = def@@ -359,6 +395,7 @@ def { asHtml = html . Text.pack . show $ x , asText = Text.pack . show $ x+ , asBytes = Just . encodeUtf8 . Text.pack . show $ x , asBoolean = x /= 0 , asNumber = Just . fromIntegral $ x , isNull = False@@ -369,6 +406,7 @@ def { asHtml = html $ scientificToText x , asText = scientificToText x+ , asBytes = Just . encodeUtf8 . scientificToText $ x , asBoolean = x /= 0 , asNumber = Just x , isNull = False@@ -382,6 +420,7 @@ in (orderedDict dayDict) { asHtml = html $ formatted , asText = formatted+ , asBytes = Just . encodeUtf8 $ formatted , asBoolean = True , asNumber = Just . fromIntegral $ julian , asList = Just (List.map snd dayDict)@@ -402,6 +441,7 @@ in (orderedDict timeDict) { asHtml = html $ formatted , asText = formatted+ , asBytes = Just . encodeUtf8 $ formatted , asBoolean = True , asNumber = Nothing , asList = Just (List.map snd timeDict)@@ -425,6 +465,7 @@ ]) { asHtml = html $ formatted , asText = formatted+ , asBytes = Just . encodeUtf8 $ formatted , asBoolean = True , asNumber = Nothing , asList = Just (List.map snd dtDict)@@ -455,6 +496,7 @@ in (dict timeLocaleDict) { asHtml = html $ formattedExample , asText = formattedExample+ , asBytes = Just . encodeUtf8 $ formattedExample , asBoolean = True , asNumber = Nothing }@@ -481,6 +523,7 @@ in (dict dtDict) { asHtml = html $ formatted , asText = formatted+ , asBytes = Just . encodeUtf8 $ formatted , asBoolean = True , asNumber = Nothing }@@ -513,6 +556,7 @@ { asHtml = if x then html "1" else html "" , asText = if x then "1" else "" , asBoolean = x+ , asBytes = Just $ if x then "1" else "0" , asNumber = Just $ if x then 1 else 0 , isNull = False , asJSON = Just (JSON.Bool x)@@ -527,6 +571,7 @@ def { asHtml = html . Text.pack $ x , asText = Text.pack x+ , asBytes = Just . encodeUtf8 . Text.pack $ x , asBoolean = not $ Prelude.null x , asNumber = readMay x , isNull = False@@ -542,6 +587,7 @@ def { asHtml = html x , asText = x+ , asBytes = Just . encodeUtf8 $ x , asBoolean = not $ Text.null x , asNumber = readMay . Text.unpack $ x , isNull = False@@ -552,11 +598,34 @@ def { asHtml = html (LText.toStrict x) , asText = LText.toStrict x+ , asBytes = Just . LBS.toStrict . LText.encodeUtf8 $ x , asBoolean = not $ LText.null x , asNumber = readMay . LText.unpack $ x , isNull = False } +instance ToGVal m ByteString where+ toGVal x =+ def+ { asHtml = html (decodeUtf8 x)+ , asText = decodeUtf8 x+ , asBytes = Just x+ , asBoolean = not $ BS.null x+ , asNumber = readMay . Text.unpack . decodeUtf8 $ x+ , isNull = False+ }++instance ToGVal m LBS.ByteString where+ toGVal x =+ def+ { asHtml = html . LText.toStrict . LText.decodeUtf8 $ x+ , asText = LText.toStrict . LText.decodeUtf8 $ x+ , asBytes = Just . LBS.toStrict $ x+ , asBoolean = not $ LBS.null x+ , asNumber = readMay . LText.unpack . LText.decodeUtf8 $ x+ , isNull = False+ }+-- -- | This instance is slightly wrong; the 'asBoolean', 'asNumber', and 'asText' -- methods all treat the HTML source as plain text. We do this to avoid parsing -- the HTML back into a 'Text' (and dealing with possible parser errors); the@@ -595,6 +664,24 @@ rawJSONToGVal (JSON.Array a) = toGVal $ Vector.toList a rawJSONToGVal (JSON.Object o) = toGVal o +#if MIN_VERSION_aeson(2,0,0)+-- | 'AKM.KeyMap' of 'JSON.Value' becomes a dictionary-like 'GVal'+instance ToGVal m (AKM.KeyMap JSON.Value) where+ toGVal xs = helper (AKM.map toGVal xs)+ where+ helper :: AKM.KeyMap (GVal m) -> GVal m+ helper xs =+ def+ { asHtml = mconcat . List.map (asHtml . snd) . AKM.toList $ xs+ , asText = mconcat . List.map (asText . snd) . AKM.toList $ xs+ , asBytes = mconcat . List.map (asBytes . snd) . AKM.toList $ xs+ , asBoolean = not . AKM.null $ xs+ , isNull = False+ , asLookup = Just $ (`AKM.lookup` xs) . AK.fromText+ , asDictItems = Just . List.map (\(k,v) -> (AK.toText k, v)) . AKM.toList $ xs+ }+#endif+ -- | Turn a 'Function' into a 'GVal' fromFunction :: Function m -> GVal m fromFunction f =@@ -777,7 +864,7 @@ fromGVal :: GVal m -> Maybe a fromGVal = Prelude.either (const Nothing) Just . fromGValEither -fromGValM :: (Monad m, FromGVal m a) => GVal m -> m a+fromGValM :: (MonadFail m, FromGVal m a) => GVal m -> m a fromGValM = Prelude.either Prelude.fail return . fromGValEither instance FromGVal m Int where@@ -794,6 +881,12 @@ instance FromGVal m (GVal m) where fromGVal = Just++instance FromGVal m ByteString where+ fromGVal = asBytes++instance FromGVal m LBS.ByteString where+ fromGVal = fmap LBS.fromStrict . asBytes instance FromGVal m a => FromGVal m (Maybe a) where fromGVal = \g ->
src/Text/Ginger/Parse.hs view
@@ -37,7 +37,7 @@ , runParserT , try, lookAhead , manyTill, oneOf, string, notFollowedBy, between, sepBy- , eof, spaces, anyChar, noneOf, char+ , eof, space, spaces, anyChar, noneOf, char , choice, option, optionMaybe , unexpected , digit@@ -439,15 +439,25 @@ literalStmtP :: Monad m => Parser m (Statement SourcePos) literalStmtP = do pos <- getPosition- txt <- manyTill literalCharP endOfLiteralP+ txt <- concat <$> manyTill literalCharsP endOfLiteralP case txt of [] -> unexpected "{{" _ -> return . LiteralS pos . unsafeRawHtml . Text.pack $ txt -literalCharP :: Monad m => Parser m Char-literalCharP =- literalNewlineP <|> anyChar+literalCharsP :: Monad m => Parser m [Char]+literalCharsP = do+ dlims <- psDelimiters <$> getState+ let forbiddenChars =+ nub . sort $+ " \t\r\n" +++ delimOpenInterpolation dlims +++ delimOpenComment dlims +++ delimOpenTag dlims+ (some $ noneOf forbiddenChars) <|>+ (fmap (:[]) literalNewlineP) <|>+ some space <|>+ (fmap (:[]) anyChar) literalNewlineP :: Monad m => Parser m Char literalNewlineP = do
src/Text/Ginger/Run.hs view
@@ -95,7 +95,7 @@ import Text.Printf import Text.PrintfA import Text.Ginger.Parse (parseGinger, ParserError)-import Control.Monad.Except (runExceptT, throwError, catchError)+import Control.Monad.Trans.Except (runExceptT, catchE) import Data.Text (Text) import Data.String (fromString)@@ -109,6 +109,8 @@ import Control.Applicative import qualified Data.HashMap.Strict as HashMap import Data.HashMap.Strict (HashMap)+import qualified Data.Map.Strict as Map+import Data.Map.Strict (Map) import Data.Scientific (Scientific, formatScientific) import qualified Data.Scientific as Scientific import Data.Default (def)@@ -116,6 +118,7 @@ import Network.HTTP.Types (urlEncode) import Debug.Trace (trace) import Data.List (lookup, zipWith, unzip)+import Data.Monoid (Monoid (..), (<>)) import Data.Aeson as JSON defaultScope :: forall m h p@@ -183,10 +186,12 @@ , ("product", fromFunction . variadicNumericFunc 1 $ Prelude.product) , ("ratio", fromFunction . variadicNumericFunc 1 $ Scientific.fromFloatDigits . ratio . Prelude.map Scientific.toRealFloat) , ("replace", fromFunction gfnReplace)+ , ("reverse", fromFunction gfnReverse) , ("round", fromFunction . unaryNumericFunc 0 $ Prelude.fromIntegral . Prelude.round) , ("show", fromFunction . unaryFunc $ fromString . show) , ("slice", fromFunction gfnSlice) , ("sort", fromFunction gfnSort)+ , ("split", fromFunction gfnSplit) , ("str", fromFunction . unaryFunc $ toGVal . asText) , ("sum", fromFunction . variadicNumericFunc 0 $ Prelude.sum) , ("truncate", fromFunction . unaryNumericFunc 0 $ Prelude.fromIntegral . Prelude.truncate)@@ -280,8 +285,6 @@ , ToGVal (Run p m h) p , Monoid h , Monad m- , Applicative m- , Functor m ) => GingerContext p m h -> Template p@@ -301,8 +304,6 @@ , ToGVal (Run p m h) p , Monoid h , Monad m- , Applicative m- , Functor m ) => Template p -> Run p m h (GVal (Run p m h))@@ -310,7 +311,7 @@ runStatement . templateBody . baseTemplate -- | Run an action within a different template context.-withTemplate :: (Monad m, Applicative m, Functor m)+withTemplate :: Monad m => Template p -> Run p m h a -> Run p m h a@@ -323,7 +324,7 @@ return result -- | Run an action within a block context-withBlockName :: (Monad m, Applicative m, Functor m)+withBlockName :: Monad m => VarName -> Run p m h a -> Run p m h a@@ -334,7 +335,7 @@ modify (\s -> s { rsCurrentBlockName = oldBlockName }) return result -lookupBlock :: (Monad m, Applicative m, Functor m) => VarName -> Run p m h (Block p)+lookupBlock :: Monad m => VarName -> Run p m h (Block p) lookupBlock blockName = do tpl <- gets rsCurrentTemplate let blockMay = resolveBlock blockName tpl@@ -356,7 +357,6 @@ , ToGVal (Run p m h) p , Monoid h , Monad m- , Functor m ) => Statement p -> Run p m h (GVal (Run p m h))@@ -370,7 +370,6 @@ , ToGVal (Run p m h) p , Monoid h , Monad m- , Functor m ) => Statement p -> Run p m h (GVal (Run p m h))@@ -432,7 +431,7 @@ runStatement' (ScopedS _ body) = withLocalScope runInner where- runInner :: (Functor m, Monad m) => Run p m h (GVal (Run p m h))+ runInner :: Monad m => Run p m h (GVal (Run p m h)) runInner = runStatement body runStatement' (ForS _ varNameIndex varNameValue itereeExpr body) = do@@ -487,7 +486,7 @@ withTemplate tpl $ runTemplate tpl runStatement' (TryCatchS _ tryS catchesS finallyS) = do- result <- (runStatement tryS) `catchError` handle catchesS+ result <- (runStatement tryS) `catchE` handle catchesS runStatement finallyS return result where@@ -509,7 +508,6 @@ . ( ToGVal (Run p m h) h , ToGVal (Run p m h) p , Monoid h- , Functor m , Monad m ) => Macro p -> GVal (Run p m h) macroToGVal (Macro argNames body) =@@ -553,7 +551,7 @@ l <- asText <$> runExpression a r <- runExpression b return (l, r)- return . toGVal . HashMap.fromList $ items+ return . toGVal . Map.fromList $ items runExpression' (MemberLookupE _ baseExpr indexExpr) = do base <- runExpression baseExpr index <- runExpression indexExpr@@ -583,7 +581,7 @@ -- | Helper function to output a HTML value using whatever print function the -- context provides.-echo :: (Monad m, Applicative m, Functor m, Monoid h)+echo :: (Monad m, Monoid h) => GVal (Run p m h) -> Run p m h () echo src = do e <- asks contextEncode@@ -604,20 +602,20 @@ rsAtLineStart = endsWithNewline newlines l } -indented :: (Monad m, Applicative m, Functor m, Monoid h)+indented :: (Monad m, Monoid h) => h -> Run p m h a -> Run p m h a indented i action = do pushIndent i *> action <* popIndent -pushIndent :: (Monad m, Applicative m, Functor m, Monoid h)+pushIndent :: (Monad m, Monoid h) => h -> Run p m h () pushIndent i = modify $ \state -> state { rsIndentation = increaseIndent i (rsIndentation state) }-popIndent :: (Monad m, Applicative m, Functor m, Monoid h)+popIndent :: (Monad m, Monoid h) => Run p m h () popIndent = modify $ \state ->
src/Text/Ginger/Run/Builtins.hs view
@@ -1,5 +1,7 @@+{-#LANGUAGE DerivingStrategies #-} {-#LANGUAGE FlexibleContexts #-} {-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE GeneralizedNewtypeDeriving #-} {-#LANGUAGE OverloadedStrings #-} {-#LANGUAGE TupleSections #-} {-#LANGUAGE TypeSynonymInstances #-}@@ -55,11 +57,10 @@ import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.Lazy as LBS import Control.Monad-import Control.Monad.Identity import Control.Monad.Writer import Control.Monad.Reader import Control.Monad.State-import Control.Monad.Except (throwError)+import Control.Monad.Except (throwError, MonadError) import Control.Applicative import qualified Data.HashMap.Strict as HashMap import Data.HashMap.Strict (HashMap)@@ -70,6 +71,7 @@ import Network.HTTP.Types (urlEncode) import Debug.Trace (trace) import Data.List (lookup, zipWith, unzip, foldl')+import Data.Monoid (Monoid (..), (<>)) import Data.Time ( defaultTimeLocale , formatTime , LocalTime (..)@@ -339,14 +341,31 @@ return . toGVal $ Text.replace search replace str _ -> throwHere $ ArgumentsError (Just "replace") "expected: (str, search, replace)" +gfnSplit :: Monad m => Function (Run p m h)+gfnSplit args =+ let argValues =+ extractArgsDefL+ [ ("str", def)+ , ("sep", def)+ ]+ args+ in case argValues of+ Right [strG, sepG] -> do+ let search = asText strG+ split = case asText sepG of+ "" -> Text.words+ sep -> Text.splitOn sep+ return . toGVal . split $ search+ _ -> throwHere $ ArgumentsError (Just "split") "expected: (str, sep=null)"+ gfnCompose :: forall m p h. Monad m => Function (Run p m h)-gfnCompose [] = fail "Invalid arguments to compose()"+gfnCompose [] = throwError $ ArgumentsError (Just "compose") "" gfnCompose [(_, fG)] = return fG gfnCompose ((_, fG):xs) = do gG <- gfnCompose xs case (asFunction fG, asFunction gG) of- (Nothing, _) -> fail $ "Argument to compose() is not a function"- (_, Nothing) -> fail $ "PANIC: Composition of functions is not a function"+ (Nothing, _) -> throwError NotAFunctionError+ (_, Nothing) -> throwError NotAFunctionError (Just f, Just g) -> do let h args = do arg' <- g args@@ -354,10 +373,10 @@ return $ fromFunction h gfnPartial :: forall m p h. Monad m => Function (Run p m h)-gfnPartial [] = fail "Invalid arguments to partial()"+gfnPartial [] = throwError $ ArgumentsError (Just "partial") "" gfnPartial ((_, fG):args) = do case asFunction fG of- Nothing -> fail "Argument to partial() is not a function"+ Nothing -> throwError $ ArgumentsError (Just "partial") "Argument must be a function" Just f -> do let h args' = do f (args ++ args')@@ -383,7 +402,7 @@ gfnZipWith :: forall m p h. Monad m => Function (Run p m h) gfnZipWith ((Nothing, gfn):args) = do zipFunction <- case asFunction gfn of- Nothing -> fail $ "Invalid args to zipwith"+ Nothing -> throwError $ ArgumentsError (Just "zipwith") "" Just fn -> return fn toGVal <$> go zipFunction (fmap fst args) (fmap (fromMaybe [] . asList . snd) args) where@@ -400,7 +419,7 @@ return $ currentVal : tailVals -gfnMap :: Monad m => Function m+gfnMap :: (Monad m, MonadError (RuntimeError a) m) => Function m gfnMap args = do let parsedArgs = extractArgsDefL [ ("collection", def)@@ -416,7 +435,7 @@ , Just (asText attribute) ) _ ->- fail "Invalid args to map()"+ throwError $ ArgumentsError (Just "map") "" mapFunction <- case (functionMay, attributeMay) of (Just f, _) -> return f (Nothing, Just key) -> return $ \case@@ -424,7 +443,7 @@ return $ lookupLooseDef def (toGVal key) item _ -> return def- _ -> fail "You have to pass a function or an attribute"+ _ -> throwError $ ArgumentsError (Just "map") "You have to pass a function or an attribute" case (dictMay, listMay) of (Just items, _) -> dict <$> forM items@@ -434,6 +453,17 @@ (Nothing, Nothing) -> return def +gfnReverse :: forall p m h. Monad m => Function (Run p m h)+gfnReverse args = do+ let parsedArgs = extractArgsDefL+ [ ("reversee", def)+ ]+ args+ reversee <- case parsedArgs of+ Right [reversee] -> return reversee+ _ -> throwHere $ ArgumentsError (Just "reverse") "expected: (reversee)"+ return . toGVal $ List.reverse <$> asList reversee+ gfnSort :: forall p m h. Monad m => Function (Run p m h) gfnSort args = do@@ -635,10 +665,10 @@ lt <- parseTimeM True defaultTimeLocale fmt input return $ ZonedTime lt defTZ formats =- [ (ztparse, "%Y-%m-%dT%H:%M:%S%Z")- , (utcparse, "%Y-%m-%d %H:%M:%S")- , (ztparse, "%Y-%m-%d %H:%M:%S%z")- , (ztparse, "%Y-%m-%d %H:%M:%S%Z")+ [ (ztparse, "%Y-%m-%dT%H:%M:%S%Q%Z")+ , (utcparse, "%Y-%m-%d %H:%M:%S%Q")+ , (ztparse, "%Y-%m-%d %H:%M:%S%Q%z")+ , (ztparse, "%Y-%m-%d %H:%M:%S%Q%Z") , (utcparse, "%Y-%m-%d") ] @@ -834,9 +864,14 @@ 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)+ let reM = runFailToEither $+ RE.makeRegexOptsM opts RE.defaultExecOpt (Text.unpack . asText $ reG) haystack = Text.unpack . asText $ haystackG- return $ matchFunc re haystack+ case reM of+ Left err ->+ throwHere $ ArgumentsError (Just "re.match") $ "invalid regex: " <> Text.pack err+ Right re ->+ return $ matchFunc re haystack _ -> barf barf = do throwHere $ ArgumentsError (Just "re.match") "expected: regex, haystack, [opts]"@@ -855,3 +890,17 @@ ) RE.blankCompOpt str++-- | This type provides an easy way to use 'RE.makeRegexOptsM' without having+-- to add a new dependency.+newtype FailToEither a+ = FailToEither+ { runFailToEither :: Either String a+ }+ deriving newtype (Applicative, Functor, Monad)++instance MonadFail FailToEither where+ fail = FailToEither . Left+ {-# INLINE fail #-}++-- vim: sw=4 ts=4 expandtab
src/Text/Ginger/Run/Type.hs view
@@ -80,7 +80,7 @@ import Text.Printf import Text.PrintfA import Data.Scientific (formatScientific)-import Control.Monad.Except (ExceptT (..))+import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Default (Default (..), def) import Data.Char (isSpace)@@ -104,6 +104,7 @@ import Network.HTTP.Types (urlEncode) import Debug.Trace (trace) import Data.Maybe (isNothing)+import Data.Monoid (Monoid (..), (<>)) import Data.List (lookup, zipWith, unzip) -- | Execution context. Determines how to look up variables from the@@ -193,7 +194,7 @@ -- based on a lookup key, and a writer function (outputting HTML by whatever -- means the carrier monad provides, e.g. @putStr@ for @IO@, or @tell@ for -- @Writer@s).-makeContextM' :: (Monad m, Functor m)+makeContextM' :: Monad m => (VarName -> Run p m h (GVal (Run p m h))) -> (h -> m ()) -> (GVal (Run p m h) -> h)@@ -202,7 +203,7 @@ makeContextM' lookupFn writeFn encodeFn newlines = makeContextExM' lookupFn writeFn (Prelude.const $ return ()) encodeFn newlines -makeContextExM' :: (Monad m, Functor m)+makeContextExM' :: Monad m => (VarName -> Run p m h (GVal (Run p m h))) -> (h -> m ()) -> (RuntimeError p -> m ())@@ -249,7 +250,7 @@ makeContext = makeContextHtml {-#DEPRECATED makeContextM "Compatibility alias for makeContextHtmlM" #-}-makeContextM :: (Monad m, Functor m)+makeContextM :: Monad m => (VarName -> Run p m Html (GVal (Run p m Html))) -> (Html -> m ()) -> GingerContext p m Html@@ -259,13 +260,13 @@ -> GingerContext p (Writer Html) Html makeContextHtml l = makeContext' l toHtml (Just htmlNewlines) -makeContextHtmlM :: (Monad m, Functor m)+makeContextHtmlM :: Monad m => (VarName -> Run p m Html (GVal (Run p m Html))) -> (Html -> m ()) -> GingerContext p m Html makeContextHtmlM l w = makeContextM' l w toHtml (Just htmlNewlines) -makeContextHtmlExM :: (Monad m, Functor m)+makeContextHtmlExM :: Monad m => (VarName -> Run p m Html (GVal (Run p m Html))) -> (Html -> m ()) -> (RuntimeError p -> m ())@@ -276,13 +277,13 @@ -> GingerContext p (Writer Text) Text makeContextText l = makeContext' l asText (Just textNewlines) -makeContextTextM :: (Monad m, Functor m)+makeContextTextM :: Monad m => (VarName -> Run p m Text (GVal (Run p m Text))) -> (Text -> m ()) -> GingerContext p m Text makeContextTextM l w = makeContextM' l w asText (Just textNewlines) -makeContextTextExM :: (Monad m, Functor m)+makeContextTextExM :: Monad m => (VarName -> Run p m Text (GVal (Run p m Text))) -> (Text -> m ()) -> (RuntimeError p -> m ())@@ -521,13 +522,13 @@ warnFromMaybe err d Nothing = warn err >> return d warnFromMaybe _ d (Just x) = return x -setSourcePos :: (Monad m, Applicative m, Functor m)+setSourcePos :: Monad m => p -> Run p m h () setSourcePos pos = modify (\s -> s { rsCurrentSourcePos = pos }) -getSourcePos :: (Monad m, Applicative m, Functor m)+getSourcePos :: Monad m => Run p m h p getSourcePos = gets rsCurrentSourcePos @@ -539,7 +540,7 @@ -- | @withSourcePos pos action@ runs @action@ in a context where the -- current source location is set to @pos@. The original source position is -- restored when @action@ finishes.-withSourcePos :: (Monad m, Applicative m, Functor m)+withSourcePos :: Monad m => p -> Run p m h a -> Run p m h a
src/Text/PrintfA.hs view
@@ -9,4 +9,4 @@ data PrintfTypeT = T { unT :: forall r. PrintfType r => r } printfa :: PrintfType t => String -> [ PrintfArgT ] -> t-printfa format = unT . foldl (\(T r) (P a) -> T $ r a ) (T $ printf format)+printfa format = (\(T t) -> t) . foldl (\(T r) (P a) -> T $ r a ) (T $ printf format)
test/Spec.hs view
@@ -13,3 +13,4 @@ [ simulationTests , propertyTests ]+
test/Text/Ginger/PropertyTests.hs view
@@ -8,6 +8,9 @@ import Test.Tasty.QuickCheck import Data.Text (Text) import qualified Data.Text as Text+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS import Data.Default (def) import qualified Data.HashMap.Strict as HashMap import Control.Exception@@ -21,6 +24,12 @@ instance Arbitrary Text where arbitrary = Text.pack <$> arbitrary +instance Arbitrary ByteString where+ arbitrary = BS.pack <$> arbitrary++instance Arbitrary LBS.ByteString where+ arbitrary = LBS.pack <$> arbitrary+ instance Arbitrary Html where arbitrary = oneof [ html <$> arbitrary@@ -100,6 +109,7 @@ , testProperty "Bool" (roundTripGValP :: Bool -> Bool) , testProperty "[Text]" (roundTripGValP :: [Text] -> Bool) , testProperty "Maybe Text" (roundTripGValP :: Maybe Text -> Bool)+ , testProperty "ByteString" (roundTripGValP :: Maybe ByteString -> Bool) , testProperty "Text" (roundTripGValP :: Text -> Bool) , testProperty "LocalTime" (roundTripGValP :: LocalTime -> Bool) , testProperty "TimeZone" (roundTripGValP :: TimeZone -> Bool)
test/Text/Ginger/SimulationTests.hs view
@@ -549,6 +549,22 @@ mkTestHtml [] [] "{{ '2015-06-13T12:05:43Z'|date('%Y-%m-%d %H:%M:%S') }}" "2015-06-13 12:05:43"+ , testCase "format a string with fractional seconds as a date (all variants)" $ do+ mkTestHtml [] []+ "{{ '2015-06-13T12:05:43.271828Z'|date('%Y-%m-%d %H:%M:%S%Q') }}"+ "2015-06-13 12:05:43.271828"+ mkTestHtml [] []+ "{{ '2015-06-13 12:05:43.271828'|date('%Y-%m-%d %H:%M:%S%Q') }}"+ "2015-06-13 12:05:43.271828"+ mkTestHtml [] []+ "{{ '2015-06-13 12:05:43.271828z'|date('%Y-%m-%d %H:%M:%S%Q') }}"+ "2015-06-13 12:05:43.271828"+ mkTestHtml [] []+ "{{ '2015-06-13 12:05:43.271828Z'|date('%Y-%m-%d %H:%M:%S%Q') }}"+ "2015-06-13 12:05:43.271828"+ mkTestHtml [] []+ "{{ '2015-06-13 12:05:43.271828+0200'|date('%Y-%m-%d %H:%M:%S%Q%z') }}"+ "2015-06-13 12:05:43.271828+0200" , testCase "format a string as a time-of-day" $ do mkTestHtml [] [] "{{ '2015-06-13 12:05:43'|date('%H-%M-%S') }}"@@ -903,6 +919,20 @@ mkTestHtml [] [] "{{ \"12345\"|slice(1,3) }}" "234"+ ]+ , testGroup "\"split\""+ [ testCase "word-splitting" $ do+ mkTestText [] []+ "{{ split('foo bar')|json(pretty=0) }}"+ "[\"foo\",\"bar\"]"+ , testCase "word-splitting, more spaces" $ do+ mkTestText [] []+ "{{ split(' foo bar ')|json(pretty=0) }}"+ "[\"foo\",\"bar\"]"+ , testCase "word-splitting, more spaces, explicit delim" $ do+ mkTestText [] []+ "{{ split(' foo bar ','')|json(pretty=0) }}"+ "[\"foo\",\"bar\"]" ] , testGroup "\"replace\"" [ testCase "simple case" $ do