diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +## 0.6.0.0 + +- Exceptions / exception handling. + +## 0.5.3.0 + +- Marshalling and hoisting: it is now possible to fully marshal `GVal`s between + arbitrary carrier monads, as long as suitable conversion functions are + provided. + ## 0.5.2.0 - Added map(), upper(), lower() functions diff --git a/cli/GingerCLI.hs b/cli/GingerCLI.hs --- a/cli/GingerCLI.hs +++ b/cli/GingerCLI.hs @@ -84,7 +84,7 @@ printParserError tplSource err Right t -> do let context = makeContextHtmlM contextLookup (putStr . Text.unpack . htmlSource) - runGingerT context t >>= hPutStrLn stderr . show + runGingerT context t >>= either (hPutStrLn stderr . show) (putStr . show) printParserError :: Maybe String -> ParserError -> IO () printParserError srcMay = putStrLn . formatParserError srcMay 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.5.3.0 +version: 0.6.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. diff --git a/src/Text/Ginger/AST.hs b/src/Text/Ginger/AST.hs --- a/src/Text/Ginger/AST.hs +++ b/src/Text/Ginger/AST.hs @@ -48,7 +48,17 @@ | BlockRefS VarName | PreprocessedIncludeS Template -- ^ {% include "template" %} | NullS -- ^ The do-nothing statement (NOP) + | TryCatchS Statement [CatchBlock] Statement -- ^ Try / catch / finally deriving (Show) + +-- | A @catch@ block +data CatchBlock = + Catch + { catchWhat :: Maybe Text + , catchCaptureAs :: Maybe VarName + , catchBody :: Statement + } + deriving (Show) -- | Expressions, building blocks for the expression minilanguage. data Expression diff --git a/src/Text/Ginger/Parse.hs b/src/Text/Ginger/Parse.hs --- a/src/Text/Ginger/Parse.hs +++ b/src/Text/Ginger/Parse.hs @@ -242,6 +242,7 @@ statementP :: Monad m => Parser m Statement statementP = interpolationStmtP <|> commentStmtP + <|> tryCatchStmtP <|> ifStmtP <|> switchStmtP <|> setStmtP @@ -408,6 +409,55 @@ spacesOrComment falseStmt <- scriptElifP <|> scriptElseP <|> return NullS return $ IfS condExpr trueStmt falseStmt + +tryCatchStmtP :: Monad m => Parser m Statement +tryCatchStmtP = do + try $ simpleTagP "try" + tryS <- statementsP + catchesS <- many catchBranchP + finallyS <- finallyBranchP <|> return NullS + simpleTagP "endtry" + return $ TryCatchS tryS catchesS finallyS + +catchBranchP :: Monad m => Parser m CatchBlock +catchBranchP = do + (what, captureName) <- try $ + fancyTagP "catch" (try catchHeaderP <|> return (Nothing, Nothing)) + body <- statementsP + return $ Catch what captureName body + +suchThat :: Monad m => (a -> Bool) -> Parser m a -> Parser m a +suchThat p action = do + val <- action + if p val then return val else fail "Requirement not met" + +catchHeaderP :: Monad m => Parser m (Maybe Text, Maybe VarName) +catchHeaderP = do + spaces + what <- catchWhatP + spaces + captureName <- catchCaptureP + return $ (what, captureName) + +catchWhatP :: Monad m => Parser m (Maybe Text) +catchWhatP = + (Nothing <$ char '*') <|> + (Just . Text.pack <$> try stringLiteralP) <|> + (Just <$> try identifierP) + +catchCaptureP :: Monad m => Parser m (Maybe VarName) +catchCaptureP = optionMaybe $ do + try (string "as" >> notFollowedBy identCharP) + spaces + identifierP + +finallyBranchP :: Monad m => Parser m Statement +finallyBranchP = do + try $ simpleTagP "finally" + statementsP + +-- TODO: try/catch/finally in script mode + switchStmtP :: Monad m => Parser m Statement switchStmtP = do 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 @@ -86,7 +86,8 @@ import Text.Ginger.Run.VM import Text.Printf import Text.PrintfA -import Text.Ginger.Parse (parseGinger) +import Text.Ginger.Parse (parseGinger, ParserError) +import Control.Monad.Except (runExceptT, throwError, catchError) import Data.Text (Text) import Data.String (fromString) @@ -174,7 +175,10 @@ , ToGVal (Run m h) v , ToGVal (Run m h) h ) - => (h -> m ()) -> v -> Template -> m (GVal (Run m h)) + => (h -> m ()) + -> v + -> Template + -> m (Either RuntimeError (GVal (Run m h))) easyRenderM emit context template = runGingerT (easyContext emit context) template @@ -197,15 +201,20 @@ -- | Purely expand a Ginger template. The underlying carrier monad is 'Writer' -- 'h', which is used to collect the output and render it into a 'h' -- value. -runGinger :: (ToGVal (Run (Writer h) h) h, Monoid h) => GingerContext (Writer h) h -> Template -> h -runGinger context template = execWriter $ runGingerT context template +runGinger :: (ToGVal (Run (Writer h) h) h, Monoid h) + => GingerContext (Writer h) h + -> Template + -> h +runGinger context template = + execWriter $ runGingerT context template -- | Monadically run a Ginger template. The @m@ parameter is the carrier monad. runGingerT :: (ToGVal (Run m h) h, Monoid h, Monad m, Functor m) => GingerContext m h -> Template - -> m (GVal (Run m h)) -runGingerT context tpl = runReaderT (evalStateT (runTemplate tpl) (defRunState tpl)) context + -> m (Either RuntimeError (GVal (Run m h))) +runGingerT context tpl = + runReaderT (evalStateT (runExceptT (runTemplate tpl)) (defRunState tpl)) context -- | Find the effective base template of an inheritance chain baseTemplate :: Template -> Template @@ -218,7 +227,8 @@ runTemplate :: (ToGVal (Run m h) h, Monoid h, Monad m, Functor m) => Template -> Run m h (GVal (Run m h)) -runTemplate = runStatement . templateBody . baseTemplate +runTemplate = + runStatement . templateBody . baseTemplate -- | Run an action within a different template context. withTemplate :: (Monad m, Functor m) @@ -250,7 +260,7 @@ tpl <- gets rsCurrentTemplate let blockMay = resolveBlock blockName tpl case blockMay of - Nothing -> fail $ "Block " <> Text.unpack blockName <> " not defined" + Nothing -> throwError $ UndefinedBlockError blockName Just block -> return block where resolveBlock :: VarName -> Template -> Maybe Block @@ -348,7 +358,7 @@ . fmap snd $ args loop :: [(Maybe Text, GVal (Run m h))] -> Run m h (GVal (Run m h)) - loop [] = fail "Invalid call to `loop`; at least one argument is required" + loop [] = throwError $ ArgumentsError "loop" "at least one argument is required" loop ((_, loopee):_) = go (Prelude.succ recursionDepth) loopee iteration :: (Int, (GVal (Run m h), GVal (Run m h))) -> Run m h (GVal (Run m h)) @@ -379,6 +389,24 @@ runStatement (PreprocessedIncludeS tpl) = withTemplate tpl $ runTemplate tpl +runStatement (TryCatchS tryS catchesS finallyS) = do + result <- (runStatement tryS) `catchError` handle catchesS + runStatement finallyS + return result + where + handle [] e = return def + handle ((Catch whatMay varNameMay catchS):catches) e = do + let what = runtimeErrorWhat e + if whatMay == Just what || whatMay == Nothing + then + withLocalScope $ do + case varNameMay of + Nothing -> return () + Just varName -> setVar varName (toGVal e) + runStatement catchS + else + handle catches e + -- | Deeply magical function that converts a 'Macro' into a Function. macroToGVal :: forall m h . ( ToGVal (Run m h) h @@ -521,14 +549,14 @@ ] args in case extracted of - Left _ -> fail "Invalid arguments to 'dictsort'" + Left _ -> throwError $ ArgumentsError "eval" "expected: (src, context)" Right [gSrc, gContext] -> do result <- parseGinger (Prelude.const . return $ Nothing) -- include resolver Nothing -- source name (Text.unpack . asText $ gSrc) -- source code tpl <- case result of - Left err -> fail $ "Error in evaluated code: " ++ show err + Left err -> throwError $ EvalParseError err Right t -> return t let localLookup varName = return $ lookupLooseDef def (toGVal varName) gContext 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 @@ -51,6 +51,7 @@ import Control.Monad.Writer import Control.Monad.Reader import Control.Monad.State +import Control.Monad.Except (throwError) import Control.Applicative import qualified Data.HashMap.Strict as HashMap import Data.HashMap.Strict (HashMap) @@ -241,7 +242,7 @@ Nothing -> return . toGVal . Text.pack $ slice (Text.unpack $ asText slicee) startInt lengthInt - _ -> fail "Invalid arguments to 'slice'" + _ -> throwError $ ArgumentsError "slice" "expected: (slicee, start=0, length=null)" gfnReplace :: Monad m => Function (Run m h) gfnReplace args = @@ -258,7 +259,7 @@ search = asText searchG replace = asText replaceG return . toGVal $ Text.replace search replace str - _ -> fail "Invalid arguments to 'replace'" + _ -> throwError $ ArgumentsError "replace" "expected: (str, search, replace)" gfnMap :: Monad m => Function (Run m h) gfnMap args = do @@ -307,8 +308,7 @@ , sortKey , asBoolean reverseG ) - _ -> - fail "Invalid args to sort()" + _ -> throwError $ ArgumentsError "sort" "expected: (sortee, by, reverse)" let -- extractByFunc :: Maybe ((Text, GVal (Run m h)) -> Run m h (GVal (Run m h))) extractByFunc = do f <- asFunction sortKey @@ -554,7 +554,7 @@ return . toGVal $ formatTime locale fmt . convertTZ tzMay <$> dateMay Nothing -> do return . toGVal $ convertTZ tzMay <$> dateMay - _ -> fail "Invalid arguments to 'date'" + _ -> throwError $ ArgumentsError "date" "expected: (date, format, tz=null, locale=null)" where convertTZ :: Maybe TimeZone -> ZonedTime -> ZonedTime convertTZ Nothing = id @@ -576,7 +576,7 @@ gfnFilter [] = return def gfnFilter [(_, xs)] = return xs gfnFilter ((_, xs):(_, p):args) = do - pfnG <- maybe (fail "Not a function") return (asFunction p) + pfnG <- maybe (throwError NotAFunctionError) return (asFunction p) let pfn x = asBoolean <$> pfnG ((Nothing, x):args) xsl = fromMaybe [] (asList xs) filtered <- filterM pfn xsl @@ -602,10 +602,14 @@ "key" -> return True "value" -> return False "val" -> return False - x -> fail $ "Invalid value for 'dictsort()' argument 'by': " ++ show x + x -> throwError $ ArgumentsError "dictsort" + ( "argument 'by' must be one of 'key', 'value', 'val', " <> + "but found '" <> + x <> "'" + ) let items = fromMaybe [] $ asDictItems gDict let projection = (if caseSensitive then id else Text.toUpper) . (if sortByKey then fst else (asText . snd)) return . orderedDict . List.sortOn projection $ items - _ -> fail "Invalid arguments to 'dictsort'" + _ -> throwError $ ArgumentsError "dictsort" "expected: (dict, case_sensitive=false, by=null)" diff --git a/src/Text/Ginger/Run/Type.hs b/src/Text/Ginger/Run/Type.hs --- a/src/Text/Ginger/Run/Type.hs +++ b/src/Text/Ginger/Run/Type.hs @@ -21,6 +21,8 @@ , liftRun2 , Run (..) , RunState (..) +, RuntimeError (..) +, runtimeErrorWhat -- * The Newlines type -- | Required for handling indentation , Newlines (..) @@ -58,9 +60,12 @@ import Text.Ginger.AST import Text.Ginger.Html import Text.Ginger.GVal +import Text.Ginger.Parse (ParserError (..)) import Text.Printf import Text.PrintfA import Data.Scientific (formatScientific) +import Control.Monad.Except (ExceptT (..)) +import Data.Default (Default (..), def) import Data.Char (isSpace) import Data.Text (Text) @@ -72,6 +77,7 @@ import Control.Monad.Writer import Control.Monad.Reader import Control.Monad.State +import Control.Monad.Except import Control.Applicative import qualified Data.HashMap.Strict as HashMap import Data.HashMap.Strict (HashMap) @@ -303,12 +309,69 @@ , rsAtLineStart = rsAtLineStart rs } +data RuntimeError = RuntimeError Text -- ^ Generic runtime error + | UndefinedBlockError Text -- ^ Tried to use a block that isn't defined + | ArgumentsError -- ^ Invalid arguments to function + Text -- ^ name of function being called + Text -- ^ explanation + | EvalParseError ParserError + | NotAFunctionError + deriving (Show) + +instance Default RuntimeError where + def = RuntimeError "" + +instance ToGVal m RuntimeError where + toGVal = runtimeErrorToGVal + +runtimeErrorWhat :: RuntimeError -> Text +runtimeErrorWhat (ArgumentsError funcName explanation) = "ArgumentsError" +runtimeErrorWhat (EvalParseError e) = "EvalParseError" +runtimeErrorWhat (RuntimeError msg) = "RuntimeError" +runtimeErrorWhat (UndefinedBlockError blockName) = "UndefinedBlockError" +runtimeErrorWhat NotAFunctionError = "NotAFunctionError" + +runtimeErrorToGVal :: RuntimeError -> GVal m +runtimeErrorToGVal (RuntimeError msg) = + rteGVal "RuntimeError" + msg [] +runtimeErrorToGVal (UndefinedBlockError blockName) = + rteGVal "UndefinedBlockError" + ("undefined block: '" <> blockName <> "'") + [ "block" ~> blockName + ] +runtimeErrorToGVal (ArgumentsError funcName explanation) = + rteGVal "ArgumentsError" + ("invalid arguments to function '" <> funcName <> "': " <> explanation) + [ "explanation" ~> explanation + , "function" ~> funcName + ] +runtimeErrorToGVal (EvalParseError e) = + rteGVal "EvalParseError" + ("error parsing eval()-ed code: " <> Text.pack (peErrorMessage e)) + [ "errorMessage" ~> peErrorMessage e + , "sourceFile" ~> peSourceName e + , "line" ~> peSourceLine e + , "col" ~> peSourceColumn e + ] +runtimeErrorToGVal NotAFunctionError = + rteGVal "NotAFunctionError" + ("attempted to call something that is not a function") + [] + +rteGVal :: Text -> Text -> [(Text, GVal m)] -> GVal m +rteGVal what msg extra = + (dict $ + [ "what" ~> what + , "message" ~> msg + ] ++ extra) { asText = msg } + -- | Internal type alias for our template-runner monad stack. -type Run m h = StateT (RunState m h) (ReaderT (GingerContext m h) m) +type Run m h = ExceptT RuntimeError (StateT (RunState m h) (ReaderT (GingerContext m h) m)) -- | Lift a value from the host monad @m@ into the 'Run' monad. liftRun :: Monad m => m a -> Run m h a -liftRun = lift . lift +liftRun = lift . lift . lift -- | Lift a function from the host monad @m@ into the 'Run' monad. liftRun2 :: Monad m => (a -> m b) -> a -> Run m h b @@ -324,7 +387,7 @@ let contextH = hoistContext rev fwd contextT stateT <- get let stateH = hoistRunState rev fwd stateT - (x, stateH') <- lift . lift $ runReaderT (runStateT action stateH) contextH + (x, stateH') <- lift . lift . lift $ runReaderT (runStateT (runExceptT action) stateH) contextH let stateT' = hoistRunState fwd rev stateH' put stateT' - return x + Prelude.either throwError return x 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 @@ -171,6 +171,43 @@ , testCase "if false then \"yes\" else if true then \"maybe\" else \"no\"" $ do mkTestHtml [] [] "{% if false %}yes{% elif true %}maybe{% else %}no{% endif %}" "maybe" ] + , testGroup "Exceptions" + [ testCase "try/catch, no exception" $ do + mkTestHtml + [] [] + "{% try %}Hello{% catch %}World{% endtry %}" + "Hello" + , testCase "try/finally, no exception" $ do + mkTestHtml + [] [] + "{% try %}Hello{% finally %} world{% endtry %}" + "Hello world" + , testCase "try/catch, trigger arguments exception" $ do + mkTestHtml + [] [] + "{% try %}{{ dictsort(1, 2, 3, 4, 5) }}{% catch * as exception %}Caught: {{ exception.what }}{% endtry %}" + "Caught: ArgumentsError" + , testCase "try/finally, trigger arguments exception" $ do + mkTestHtml + [] [] + "{% try %}{{ dictsort(1, 2, 3, 4, 5) }} Nope!{% finally %}All clear{% endtry %}" + "All clear" + , testCase "try/catch, catch selectively (string syntax)" $ do + mkTestHtml + [] [] + "{% try %}{{ dictsort(1, 2, 3, 4, 5) }}{% catch * as exception %}Caught: {{ exception.what }}{% endtry %}" + "Caught: ArgumentsError" + , testCase "try/catch, catch selectively (identifier syntax)" $ do + mkTestHtml + [] [] + "{% try %}{{ dictsort(1, 2, 3, 4, 5) }}{% catch 'ArgumentsError' as exception %}Caught: {{ exception.what }}{% endtry %}" + "Caught: ArgumentsError" + , testCase "try/catch, skip non-matching catches" $ do + mkTestHtml + [] [] + "{% try %}{{ dictsort(1, 2, 3, 4, 5) }}{% catch 'SomeOtherError' as exception %}This is wrong{% catch * as exception %}Caught: {{ exception.what }}{% endtry %}" + "Caught: ArgumentsError" + ] , testGroup "Switch" [ testCase "switch 1 of 1, 2, default" $ do mkTestHtml [] []