Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Simplified the interface for creating ContextLookup functions

  • Loading branch information...
commit 41052602815a05991de4b8a148952d05ace62f47 1 parent 500488d
@jamessanders authored
View
2  rstemplate.cabal
@@ -1,5 +1,5 @@
name: rstemplate
-version: 0.9.6
+version: 0.9.7
synopsis: very simple template system
description: very simple template system
category: Data
View
67 src/Text/RSTemplate/Eval.hs
@@ -3,6 +3,7 @@ module Text.RSTemplate.Eval (runEval) where
--import Text.RSTemplate
import Control.Monad.State
+import Control.Monad.Writer
import Control.Monad.Identity
import Text.RSTemplate.Eval.Types
@@ -13,19 +14,24 @@ import qualified Data.ByteString.Char8 as C
import Debug.Trace
import qualified Data.Map as M
-type Stack m a = StateT (ContextState m) m a
+type Stack m a = StateT (ContextState m) (WriterT [String] m) a
-runStack = runStateT
+runStack run state = runWriterT (runStateT run state)
+
+lift2 f = lift $ lift $ f
+debug _ fn = fn
runEval :: (Monad m, Functor m) => [TemplateCode] -> ContextItem m -> m ByteString
runEval tm cx = do
- (r,_) <- runStack (eval' tm) (ContextState cx builtins)
- return $ C.concat r
+ ((r,log),_) <- runStack (eval' tm) (ContextState cx builtins)
+ debug (show r) $ do
+ return $ C.concat r
getCX :: (Monad m) => Stack m (ContextItem m)
getCX = do s <- get
return (getContextState s)
+putCX :: (Monad m) => ContextItem m -> Stack m ()
putCX cx = do s <- get
put $ s { getContextState = cx }
@@ -35,15 +41,16 @@ eval' = mapM eval
eval :: (Monad m, Functor m) => TemplateCode -> Stack m ByteString
eval (Text x) = return x
-eval (Slot x) = do
+eval (Slot x) = debug ("evaluating slot: " ++ show x) $ do
ee <- evalExpr x
case ee of
- Just (ContextValue x) -> return x
- Just x -> return (C.pack . show $ x)
- Nothing -> return (C.pack "")
+ (ContextValue x) -> return x
+ (ContextNull) -> return (C.pack "")
+ x -> return (C.pack . show $ x)
+
-eval (Assign k e) = do
- Just ee <- evalExpr e
+eval (Assign k e) = debug ("evaluating assign " ++ show k ++ " = " ++ show e) $ do
+ ee <- evalExpr e
st <- getCX
putCX (toContext [(k,ee)] <+> st)
return (C.pack "")
@@ -52,43 +59,48 @@ eval (Cond e bls) = do
ee <- evalExpr e
st <- getCX
case ee of
- Just x -> case x of
- ContextBool False -> return (C.pack "")
- _ -> lift $ runEval bls st
- Nothing -> return (C.pack "")
+ (ContextNull) -> return (C.pack "")
+ (ContextBool False) -> return (C.pack "")
+ _ -> lift2 $ runEval bls st
+
eval (Loop e as bls) = do
ee <- evalExpr e
case ee of
- Just a -> runLoop a
- Nothing -> return (C.pack "")
+ ContextNull -> return (C.pack "")
+ a -> runLoop a
where runLoop (ContextList ls) = fmap (C.concat) $ mapM inner ls
inner v = do cx <- getCX
- lift $ runEval bls (toContext [(as,v)] <+> cx)
+ lift2 $ runEval bls (toContext [(as,v)] <+> cx)
eval x = error $ "Cannot eval: '" ++ (show x) ++ "'"
-evalExpr :: (Monad m, Functor m) => Expr -> Stack m (Maybe (ContextItem m))
+fromMaybeToContext (Just a) = a
+fromMaybeToContext Nothing = ContextNull
+
+
+evalExpr :: (Monad m, Functor m) => Expr -> Stack m (ContextItem m)
evalExpr (Func n a) = do
cx <- getCX
case M.lookup n builtins of
Just f -> do args <- mapM evalExpr a
- lift $ f args
- Nothing -> do ll <- lift $ doLookup n cx
+ lift2 $ f args
+ Nothing -> do ll <- lift2 $ doLookup n cx
case ll of
Just (ContextFunction f) -> do
args <- mapM evalExpr a
- lift $ f args
+ lift2 $ f args
_ -> error $ (C.unpack n) ++ " is not a function. "
evalExpr (Var n) = do g <- getCX
- r <- lift $ doLookup n g
+ r <- lift2 $ doLookup n g
case r of
- Just a -> return r
+ Just a -> return a
Nothing-> case M.lookup n builtins of
- Just f -> lift $ f []
- Nothing -> return Nothing
+ Just f -> lift2 $ f []
+ Nothing -> return ContextNull
+
evalExpr (NumberLiteral n) = return . justcx . C.pack . show $ n
evalExpr (StringLiteral n) = return . justcx $ n
@@ -107,8 +119,9 @@ doLookup' st (ContextPairs (x:xs)) = do
let cx = getContext x
s <- cx st
case s of
- Just a -> return (Just a)
- Nothing -> doLookup' st (ContextPairs xs)
+ ContextNull -> doLookup' st (ContextPairs xs)
+ a -> return (Just a)
+
doLookup' st (ContextBool True) = return (Just $ ContextValue $ pack "True")
doLookup' st (ContextBool False) = return Nothing
doLookup' st x = error $ "Context not searchable when looking up '" ++ unpack st ++ "' in " ++ show x
View
88 src/Text/RSTemplate/Eval/Builtins.hs
@@ -12,70 +12,70 @@ import qualified Data.Map as M
myId [x] = return . id $ x
myId x = return . justcx . C.pack . show $ x
-myUpper [Just (ContextValue x)] = return . justcx $ (C.map toUpper x)
-myUpper [Nothing] = return Nothing
+myUpper [ContextValue x] = return . justcx $ (C.map toUpper x)
+myUpper _ = return ContextNull
-myLower [Just (ContextValue x)] = return $ justcx (C.map toLower x)
-myLower [Nothing] = return Nothing
+myLower [ContextValue x] = return $ justcx (C.map toLower x)
+myLower _ = return ContextNull
-myCapitalize [Just (ContextValue x)] = return $ justcx (toUpper (C.head x) `C.cons` C.map toLower (C.tail x))
+myCapitalize [ContextValue x] = return $ justcx (toUpper (C.head x) `C.cons` C.map toLower (C.tail x))
-myLength [Just (ContextValue x)] = return . justcx . C.pack . show . C.length $ x
-myLength [Just (ContextList x)] = return . justcx . C.pack . show . length $ x
-myLength [Just (ContextPairs x)] = return . justcx . C.pack . show . length $ x
-myLength [Nothing] = return $ justcx ("0" :: C.ByteString)
+myLength [ContextValue x] = return . justcx . C.pack . show . C.length $ x
+myLength [ContextList x] = return . justcx . C.pack . show . length $ x
+myLength [ContextPairs x] = return . justcx . C.pack . show . length $ x
+myLength _ = return $ justcx ("0" :: C.ByteString)
-myEven [Just (ContextValue x)] = return . boolcx . even . read . C.unpack $ x
-myOdd [Just (ContextValue x)] = return . boolcx . odd . read . C.unpack $ x
+myEven [ContextValue x] = return . boolcx . even . read . C.unpack $ x
+myOdd [ContextValue x] = return . boolcx . odd . read . C.unpack $ x
-myNot [Just _] = return Nothing
-myNot [Nothing] = return $ boolcx True
+myNot [ContextBool True] = return $ boolcx False
+myNot [ContextBool False] = return $ boolcx True
-myEq [Just (ContextValue a)
- ,Just (ContextValue b)] = if a == b
- then return $ boolcx True
- else return $ boolcx False
+myEq [ContextValue a
+ ,ContextValue b] = if a == b
+ then return $ boolcx True
+ else return $ boolcx False
-myZip [Just (ContextList a),Just (ContextList b)] =
- return $ justcx [[x,y] | x <- a , y <- b]
+myZip [ContextList a
+ ,ContextList b] = return $ justcx [[x,y] | x <- a , y <- b]
-myRange [Just (ContextValue a),Just (ContextValue b)] =
+myRange [ContextValue a ,ContextValue b] =
return $ justcx $ map (C.pack . show) [read (C.unpack a) :: Int .. read (C.unpack b) - 1 :: Int]
-myEnum [Just (ContextList a)] = return . justcx $ map (C.pack . show) $ [0..length a - 1]
+myEnum [ContextList a] = return . justcx $ map (C.pack . show) $ [0..length a - 1]
myEnum _ = error "enum: not a list"
-myElem [Just x, Just (ContextList y)] = return $ boolcx (x `elem` y)
+myElem [x, ContextList y] = return $ boolcx (x `elem` y)
-myGetItem [Just (ContextList a)
- ,Just (ContextValue b)] = let b' = read $ C.unpack b in
- if b' < length a
- then return $ Just $ a !! b'
- else return Nothing
+myGetItem [ContextList a
+ ,ContextValue b] = let b' = read $ C.unpack b in
+ if b' < length a
+ then return $ a !! b'
+ else return ContextNull
-mySucc [Just (ContextValue a)] = let str = C.unpack a
- in if not (number str)
- then error "succ: Argument is not a number"
- else return $ justcx . C.pack . show $ succ (read str :: Integer)
+mySucc [ContextValue a] = let str = C.unpack a
+ in if not (number str)
+ then error "succ: Argument is not a number"
+ else return $ justcx . C.pack . show $ succ (read str :: Integer)
-mathOn f [Just (ContextValue a)
- ,Just (ContextValue b)] = let a' = C.unpack $ a
- b' = C.unpack $ b in
- if number a' && number b'
- then return . justcx . C.pack $ show (read a' `f` read b')
- else error "math: Argumuent is not a number"
+mathOn f [ContextValue a
+ ,ContextValue b] = let a' = C.unpack $ a
+ b' = C.unpack $ b in
+ if number a' && number b'
+ then return . justcx . C.pack $ show (read a' `f` read b')
+ else error "math: Argumuent is not a number"
-myHead [Just (ContextList a)] = return $ Just (head a)
-myHead _ = return $ Nothing
+myHead [ContextList a] = return $ head a
+myHead _ = return $ ContextNull
-myType [Just (ContextList _)] = return . justcx $ C.pack "<List>"
-myType [Just (ContextPairs _)] = return . justcx $ C.pack "<Dict>"
-myType [Just (ContextValue _)] = return . justcx $ C.pack "<Value>"
+myType [ContextList _] = return . justcx $ C.pack "<List>"
+myType [ContextPairs _] = return . justcx $ C.pack "<Dict>"
+myType [ContextValue _] = return . justcx $ C.pack "<Value>"
number = and . map isNumber
-boolcx True = justcx ("True" :: C.ByteString)
-boolcx False = Nothing
+boolcx = ContextBool
+
builtins :: (Monad m) => M.Map C.ByteString (BuiltinFunc m)
builtins = M.fromList [("id",myId)
View
12 src/Text/RSTemplate/Eval/Context.hs
@@ -4,7 +4,7 @@ module Text.RSTemplate.Eval.Context where
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C
import Text.RSTemplate.Eval.Types
-
+import Data.Maybe
-- instance (Monad m) => ContextLookup m [(String,String)] where
@@ -12,23 +12,23 @@ import Text.RSTemplate.Eval.Types
-- cxLookup k = return . lookup (C.unpack k)
instance (Monad m) => ContextLookup m [(ByteString,ContextItem m)] where
- cxLookup k = return . lookup k
+ cxLookup k = return . fromMaybe ContextNull . lookup k
instance (Monad m) => ContextLookup m String where
toContext = ContextValue . C.pack
- cxLookup _ _ = return Nothing
+ cxLookup _ _ = return ContextNull
instance (Monad m) => ContextLookup m ByteString where
toContext a = ContextValue a
- cxLookup _ _ = return Nothing
+ cxLookup _ _ = return ContextNull
instance (Monad m) => ContextLookup m Bool where
toContext = ContextBool
- cxLookup _ _ = return Nothing
+ cxLookup _ _ = return ContextNull
instance (Monad m,ContextLookup m a) => ContextLookup m [a] where
toContext a = ContextList (map toContext a)
- cxLookup _ _ = return Nothing
+ cxLookup _ _ = return ContextNull
-- instance (Monad m) => ContextLookup m [Context m] where
-- cxLookup k (x:xs) = do
View
27 src/Text/RSTemplate/Eval/Types.hs
@@ -21,10 +21,11 @@ import qualified Data.Map as M
data ContextItem m = ContextPairs [Context m]
| ContextValue ByteString
| ContextBool Bool
+ | ContextNull
| ContextList [ContextItem m]
- | ContextFunction ([Maybe (ContextItem m)] -> m (Maybe (ContextItem m)))
+ | ContextFunction ([ContextItem m] -> m (ContextItem m))
-type BuiltinFunc m = [Maybe (ContextItem m)] -> m (Maybe (ContextItem m))
+type BuiltinFunc m = [ContextItem m] -> m (ContextItem m)
data ContextState m = ContextState { getContextState :: (ContextItem m)
, getContextFuns :: M.Map C.ByteString (BuiltinFunc m) }
@@ -40,32 +41,34 @@ instance (Monad m) => Show (ContextItem m) where
show (ContextPairs _) = "((ContextMap))"
show (ContextList _) = "((ContextList))"
show (ContextBool x) = show x
+ show (ContextNull) = ""
+ show (ContextFunction _) = "((ContextFunction))"
data EmptyContext = EmptyContext
-instance (Monad m) => ContextLookup m EmptyContext where
- cxLookup _ _ = return Nothing
-
-
-newtype Context m = Context { getContext :: ByteString -> m (Maybe (ContextItem m)) }
+newtype Context m = Context { getContext :: ByteString -> m (ContextItem m) }
class (Monad m) => ContextLookup m a where
- cxLookup :: ByteString -> a -> m (Maybe (ContextItem m))
+ cxLookup :: ByteString -> a -> m (ContextItem m)
toContext :: a -> ContextItem m
toContext a = ContextPairs [Context (flip cxLookup a)]
instance (Monad m) => ContextLookup m (ContextItem m) where
- cxLookup _ _ = return Nothing
+ cxLookup _ _ = return ContextNull
toContext = id
+instance (Monad m) => ContextLookup m EmptyContext where
+ cxLookup _ _ = return ContextNull
+
+
-- simpleContext
foldCX :: (Monad m) => [ContextItem m] -> ContextItem m
foldCX = foldl (<+>) emptyContext
-justcx :: (Monad m, ContextLookup m a) => a -> (Maybe (ContextItem m))
-justcx = Just . toContext
+justcx :: (Monad m, ContextLookup m a) => a -> ContextItem m
+justcx = toContext
-- Context Writer Monad --
@@ -92,7 +95,7 @@ cxw = execCXW
set k v = tell $ ContextPairs [Context aux]
where aux x = if x == (C.pack k)
then return . justcx $ v
- else return Nothing
+ else return ContextNull
with k fn = do cx <- lift $ execCXW fn
Please sign in to comment.
Something went wrong with that request. Please try again.