Permalink
Browse files

Adds support for macros

  • Loading branch information...
1 parent 572e363 commit cd89b1c85c160623e42f99b57f0c101a4cfe84ba @jamessanders committed May 14, 2011
@@ -1,5 +1,5 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
-module Text.Twine.Interpreter (runEval) where
+{-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings, FlexibleContexts #-}
+module Text.Twine.Interpreter (runEval,getMacros) where
import Control.Monad.Identity
import Control.Monad.State
@@ -9,6 +9,7 @@ import Debug.Trace
import Text.Twine.Interpreter.Builtins
import Text.Twine.Interpreter.Interface
import Text.Twine.Interpreter.Types
+import Text.Twine.Interpreter.ContextWriter
import Text.Twine.Parser.Types
import qualified Data.ByteString.Char8 as C
import qualified Data.Map as M
@@ -18,6 +19,18 @@ import qualified Data.Map as M
type Stack m a = StateT (ContextState m) (WriterT [String] m) a
+
+getMacros = Macros . M.fromList . getMacros'
+ where
+ getMacros' ((Macro name params blocks):xs) = (name, evalMacro params blocks) : getMacros' xs
+ getMacros' (_:xs) = getMacros' xs
+ getMacros' [] = []
+
+evalMacro params blocks args preContext macros = do
+ let localContext = M.fromList (zip params args)
+ let context = (bind $ localContext) <+> preContext
+ runEval' blocks context macros
+
foldCX :: (Monad m) => [TwineElement m] -> TwineElement m
foldCX = foldl (<+>) emptyContext
@@ -36,11 +49,12 @@ lift2 f = lift $ lift $ f
debug _ fn = fn
--debug = trace
-runEval tm cx = runEval' tm (bind $ unContext cx)
+runEval :: (Monad m, Functor m) => Template -> Context m -> m ByteString
+runEval tm cx = runEval' tm (bind $ unContext cx) (getMacros tm)
-runEval' :: (Monad m, Functor m) => Template -> TwineElement m -> m ByteString
-runEval' tm cx = do
- ((r,log),_) <- runStack (eval' tm) (ContextState cx M.empty)
+runEval' :: (Monad m, Functor m) => Template -> TwineElement m -> Macros m -> m ByteString
+runEval' tm cx macros = do
+ ((r,log),_) <- runStack (eval' tm) (ContextState cx macros)
debug (show r) $ do
return $ C.concat r
@@ -58,6 +72,8 @@ eval' = mapM eval
eval :: (Monad m, Functor m) => TemplateCode -> Stack m ByteString
eval (Text x) = return x
+eval (Macro _ _ _) = return (C.empty)
+
eval (Slot x) = debug ("evaluating slot: " ++ show x) $ do
ee <- evalExpr x
st <- case ee of
@@ -74,12 +90,13 @@ eval (Assign k e) = debug ("evaluating assign " ++ show k ++ " = " ++ show e) $
return (C.pack "")
eval (Cond e bls) = do
+ g <- get
ee <- evalExpr e
st <- getCX
case ee of
(TwineNull) -> return (C.pack "")
(TwineBool False) -> return (C.pack "")
- _ -> lift2 $ runEval' bls st
+ _ -> lift2 $ runEval' bls st (getContextMacros g)
eval (Loop e as bls) = do
@@ -102,8 +119,9 @@ eval (Loop e as bls) = do
runLoop x = error $ "Not iterable: " ++ show x
inner v = do
+ g <- get
cx <- getCX
- lift2 $ runEval' bls (bind (M.fromList [(as,v)]) <+> cx)
+ lift2 $ runEval' bls (bind (M.fromList [(as,v)]) <+> cx) (getContextMacros g)
eval x = error $ "Cannot eval: '" ++ (show x) ++ "'"
@@ -131,10 +149,23 @@ evalExpr (Var n) = do g <- getCX
evalExpr (NumberLiteral n) = return . bind $ n
evalExpr (StringLiteral n) = return . bind $ n
+evalExpr (Accessor (Var "macros") expr) = runMacro expr
+
evalExpr acc@(Accessor n expr) = do
g <- getCX
accessObjectInContext g acc
+runMacro :: (Monad m, Functor m) => Expr -> Stack m (TwineElement m)
+runMacro (Func name args) = do
+ g <- get
+ let macros = getContextMacros g
+ case M.lookup name (unMacros macros) of
+ Nothing -> error "Unknown macro"
+ Just macro -> do
+ args' <- mapM evalExpr args
+ x <- lift2 $ macro args' (getContextState g) macros
+ return (TwineString x)
+
accessObjectInContext :: (Monad m, Functor m) => TwineElement m -> Expr -> Stack m (TwineElement m)
accessObjectInContext context (Accessor (Var n) expr) = do
cx <- lift2 $ doLookup' n context
@@ -7,7 +7,7 @@
, OverloadedStrings
, UndecidableInstances
#-}
-module Text.Twine.Interpreter.ContextWriter (makeContext, (=:), merge) where
+module Text.Twine.Interpreter.ContextWriter (mapToContext, makeContext, (=:), merge) where
import Data.ByteString.Char8 (ByteString)
import Data.Maybe
@@ -32,4 +32,6 @@ makeContext cw = do
--(=:) :: (MonadWriter (Map ByteString (TwineElement m)) m, Convertible a (TwineElement m)) => String -> a -> m ()
k =: v = tell $ Context (M.fromList [(C.pack k, bind v)])
-merge a b = Context (unContext a `M.union` unContext b)
+merge a b = Context (unContext a `M.union` unContext b)
+
+mapToContext = Context
@@ -55,9 +55,13 @@ newtype CXInteger = CXInteger { unCXInteger :: Integer }
type BuiltinFunc m = [TwineElement m] -> m (TwineElement m)
+data Macros m = Macros {
+ unMacros :: Map ByteString ([TwineElement m] -> TwineElement m -> Macros m -> m ByteString)
+}
+
data ContextState m = ContextState {
- getContextState :: (TwineElement m)
- , getContextFuns :: Map C.ByteString (BuiltinFunc m)
+ getContextState :: TwineElement m
+ ,getContextMacros :: Macros m
}
data Object m = Object {
View
@@ -1,5 +1,5 @@
{-# LANGUAGE NoMonomorphismRestriction #-}
-module Text.Twine.Parser (loadTemplateFromFile, loadTemplateFromString) where
+module Text.Twine.Parser (loadTemplateFromFile, loadTemplateFromString, Template) where
import Data.ByteString.Char8 (ByteString, pack)
import Debug.Trace
@@ -16,26 +16,40 @@ token t = do
template = templateEntities <|> textBlock
-templateEntities = try slot <|> try conditional <|> try loop <|> try assign <|> include <?> "Template entity"
+templateEntities = try slot <|> try conditional <|> try macro <|> try loop <|> try assign <|> include <?> "Template entity"
startOfEntities = try (string "{{")
<|> try (string "{@")
<|> try (string "{|")
<|> try (string "{+")
<|> try (string "{?")
+ <|> try (string "{=")
<?> "start of entity"
endOfEntities = try (string "}}")
<|> try (string "@}")
<|> try (string "|}")
<|> try (string "+}")
<|> try (string "?}")
+ <|> try (string "=}")
<?> "end of entity"
textBlock = do
text <- manyTill anyChar ((lookAhead startOfEntities >> return ()) <|> (lookAhead endOfEntities >> return ()) <|> eof)
return (Text $ pack text)
+macro = do
+ token "{=" <?> "Start of macro"
+ token "|" <?> "Start of macro signature"
+ ident <- name
+ spaces
+ token "("
+ names <- sepBy name (token ",")
+ token ")"
+ token "|" <?> "end of macro signature"
+ blocks <- manyTill template (string "=}")
+ return (Macro ident names blocks)
+
slot = do
token "{{" <?> "Start of slot"
spaces
@@ -21,6 +21,6 @@ data TemplateCode =
| Cond Expr [TemplateCode]
| Incl FilePath
| Assign Key Expr
+ | Macro Name [Name] [TemplateCode]
deriving (Show)
-

0 comments on commit cd89b1c

Please sign in to comment.