twine 0.1.1 → 0.1.2
raw patch · 11 files changed
+242/−241 lines, 11 filesdep +convertible
Dependencies added: convertible
Files
- src/Text/Twine.hs +11/−11
- src/Text/Twine/Interpreter.hs +27/−28
- src/Text/Twine/Interpreter/Builtins.hs +3/−3
- src/Text/Twine/Interpreter/Context.hs +0/−68
- src/Text/Twine/Interpreter/ContextWriter.hs +3/−2
- src/Text/Twine/Interpreter/FancyContext.hs +0/−75
- src/Text/Twine/Interpreter/Interface.hs +153/−0
- src/Text/Twine/Interpreter/Types.hs +21/−22
- src/Text/Twine/Parser.hs +2/−6
- src/Text/Twine/Parser/Types.hs +18/−22
- twine.cabal +4/−4
src/Text/Twine.hs view
@@ -1,17 +1,17 @@-module Text.Twine (module Text.Twine.Parser- ,module Text.Twine.Interpreter- ,module Text.Twine.Interpreter.Context- ,module Text.Twine.Interpreter.FancyContext- ,module Text.Twine.Interpreter.ContextWriter- ,evalTemplate)+module Text.Twine (+ module Text.Twine.Parser+ ,module Text.Twine.Interpreter+ ,module Text.Twine.Interpreter.Interface+ ,module Text.Twine.Interpreter.ContextWriter+ , TwineElement+ ,evalTemplate) where -import Text.Twine.Parser-import Text.Twine.Interpreter.Types-import Text.Twine.Interpreter.Context-import Text.Twine.Interpreter.FancyContext-import Text.Twine.Interpreter.ContextWriter import Text.Twine.Interpreter+import Text.Twine.Interpreter.Interface+import Text.Twine.Interpreter.ContextWriter+import Text.Twine.Interpreter.Types+import Text.Twine.Parser evalTemplate template context = do templ <- loadTemplateFromFile template
src/Text/Twine/Interpreter.hs view
@@ -1,38 +1,33 @@ {-# LANGUAGE NoMonomorphismRestriction #-} module Text.Twine.Interpreter (runEval) where ---import Text.Twine-+import Control.Monad.Identity import Control.Monad.State import Control.Monad.Writer-import Control.Monad.Identity--import Text.Twine.Interpreter.Types-import Text.Twine.Interpreter.Context-import Text.Twine.Interpreter.FancyContext+import Data.ByteString.Char8 (ByteString,pack,unpack)+import Debug.Trace import Text.Twine.Interpreter.Builtins+import Text.Twine.Interpreter.Interface+import Text.Twine.Interpreter.Types import Text.Twine.Parser.Types-import Data.ByteString.Char8 (ByteString,pack,unpack) import qualified Data.ByteString.Char8 as C-import Debug.Trace import qualified Data.Map as M -type Stack m a = StateT (ContextState m) (WriterT [String] m) a+-- TODO: Most of the interpreter is all wrong, and there is no error+-- checking. Eventually this all needs to be fixed up. --- simpleContext+type Stack m a = StateT (ContextState m) (WriterT [String] m) a foldCX :: (Monad m) => [TwineElement m] -> TwineElement m foldCX = foldl (<+>) emptyContext --- Context Writer Monad --- mergeCXP (TwineObjectList a) (TwineObjectList b) = TwineObjectList (a ++ b) mergeCXP (TwineList a) (TwineList b) = TwineList (a ++ b) mergeCXP (TwineObject a) x = TwineObjectList [a] `mergeCXP` x mergeCXP x (TwineObject a) = x `mergeCXP` TwineObjectList [a] mergeCXP a b = error $ "Cannot merge " ++ show a ++ " and " ++ show b-(<+>) = mergeCXP +(<+>) = mergeCXP runStack run state = runWriterT (runStateT run state) @@ -73,7 +68,7 @@ eval (Assign k e) = debug ("evaluating assign " ++ show k ++ " = " ++ show e) $ do ee <- evalExpr e st <- getCX- putCX (bind [(k,ee)] <+> st)+ putCX (bind (M.fromList [(k,ee)]) <+> st) return (C.pack "") eval (Cond e bls) = do@@ -90,19 +85,23 @@ case ee of TwineNull -> return (C.pack "") a -> runLoop a- where runLoop (TwineList ls) = fmap (C.concat) $ mapM inner ls- - runLoop (TwineObjectList x) = do- it <- lift2 $ getIterable (head x)- runLoop (TwineList it)- - runLoop (TwineObject x) = do- it <- lift2 $ getIterable x- runLoop (TwineList it)-- runLoop x = error $ "Not iterable: " ++ show x- inner v = do cx <- getCX- lift2 $ runEval bls (bind [(as,v)] <+> cx)+ where + --runLoop :: (Monad m) => TwineElement m -> m C.ByteString+ runLoop (TwineList ls) = fmap (C.concat) $ mapM inner ls + + runLoop (TwineObjectList x) = do + it <- lift2 $ getIterable (head x) + runLoop (TwineList it) + + runLoop (TwineObject x) = do + it <- lift2 $ getIterable x + runLoop (TwineList it) + + runLoop x = error $ "Not iterable: " ++ show x + + inner v = do + cx <- getCX + lift2 $ runEval bls (bind (M.fromList [(as,v)]) <+> cx) eval x = error $ "Cannot eval: '" ++ (show x) ++ "'"
src/Text/Twine/Interpreter/Builtins.hs view
@@ -4,12 +4,12 @@ import Data.Char import Data.List import Text.Twine.Interpreter.Types-import Text.Twine.Interpreter.Context+import Text.Twine.Interpreter.Interface import Control.Exception (assert) import qualified Data.ByteString.Char8 as C import qualified Data.Map as M -myNot [TwineBool b] = return . bind $ not b+myNot [b] = unbind b >>= return . bind . not builtins :: (Monad m) => M.Map C.ByteString (TwineElement m)-builtins = M.fromList [("not", TwineFunction myNot)]+builtins = M.fromList [("not", method myNot)]
− src/Text/Twine/Interpreter/Context.hs
@@ -1,68 +0,0 @@-{-#LANGUAGE MultiParamTypeClasses- , TypeSynonymInstances- , FlexibleInstances- , FlexibleContexts - , NoMonomorphismRestriction- , OverlappingInstances- , OverloadedStrings- , UndecidableInstances- , FunctionalDependencies- #-}--module Text.Twine.Interpreter.Context (emptyContext, TemplateInterface (..)) where--import Data.ByteString.Char8 (ByteString)-import Data.Maybe-import Data.Monoid-import Text.Twine.Interpreter.Types-import qualified Data.ByteString.Char8 as C-import Control.Monad.Writer-import qualified Data.Map as M--class (Monad m) => TemplateInterface m a | a -> m where- property :: ByteString -> a -> m (TwineElement m)- makeIterable :: a -> m [TwineElement m]- makeString :: a -> m String- bind :: (TemplateInterface m a) => a -> TwineElement m-- property _ _ = return TwineNull- makeIterable _ = return []- makeString _ = return ""- bind a = TwineObject $ Context {- getContext = (flip property a),- getIterable = makeIterable a,- getString = makeString a- }---instance (Monad m) => TemplateInterface m (TwineElement m) where- bind = id- makeString = return . show--instance (Monad m) => TemplateInterface m ([TwineElement m] -> m (TwineElement m)) where- bind = TwineFunction--instance (Monad m) => TemplateInterface m EmptyContext --instance (Monad m, TemplateInterface m a) => TemplateInterface m (Maybe a) where- bind (Just a) = bind a- bind Nothing = TwineNull--instance (Monad m) => TemplateInterface m [(ByteString,TwineElement m)] where- property k = return . fromMaybe TwineNull . lookup k--instance (Monad m) => TemplateInterface m String where- bind = TwineString . C.pack--instance (Monad m) => TemplateInterface m ByteString where- bind a = TwineString a--instance (Monad m) => TemplateInterface m Bool where- bind = TwineBool--instance (Monad m) => TemplateInterface m (M.Map ByteString (TwineElement m)) where- property k = return . fromMaybe (TwineNull) . M.lookup k--emptyContext :: (Monad m) => TwineElement m-emptyContext = bind EmptyContext-
src/Text/Twine/Interpreter/ContextWriter.hs view
@@ -13,13 +13,13 @@ import Data.Maybe import Data.Monoid import Text.Twine.Interpreter.Types-import Text.Twine.Interpreter.Context-import Text.Twine.Interpreter.FancyContext+import Text.Twine.Interpreter.Interface import Text.Twine.Interpreter.Builtins import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as C import Control.Monad.Writer import Data.Map (Map)+import Data.Convertible import qualified Data.Map as M type TwineObjectper m = Map ByteString (TwineElement m)@@ -30,4 +30,5 @@ mp <- execWriterT cw return $ bind (mp `M.union` builtins) +--(=:) :: (MonadWriter (Map ByteString (TwineElement m)) m, Convertible a (TwineElement m)) => String -> a -> m () k =: v = tell $ M.fromList [(C.pack k, bind v)]
− src/Text/Twine/Interpreter/FancyContext.hs
@@ -1,75 +0,0 @@-{-#LANGUAGE MultiParamTypeClasses- , TypeSynonymInstances- , FlexibleInstances- , FlexibleContexts - , NoMonomorphismRestriction- , OverlappingInstances- , OverloadedStrings- , UndecidableInstances- #-}---module Text.Twine.Interpreter.FancyContext where-import Text.Twine.Interpreter.Types-import Text.Twine.Interpreter.Context--instance (TemplateInterface m a) => TemplateInterface m [a] where- bind = bind . CXListLike . map bind --instance (Monad m) => TemplateInterface m (CXListLike m) where- property "length" = mbind . length . unCXListLike- property "head" = mbind . head . unCXListLike- property "tail" = mbind . tail . unCXListLike- property "init" = mbind . init . unCXListLike- property "last" = mbind . last . unCXListLike- property "item" = \x -> return $ TwineFunction (\[n] -> do- i <- cxToInteger n- mbind (unCXListLike x !! fromIntegral i))- - property "take" = \x -> return $ TwineFunction (\[n] -> do- i <- cxToInteger n- mbind . take (fromIntegral i) $ unCXListLike x)- - property "drop" = \x -> return $ TwineFunction (\[n] -> do- i <- cxToInteger n- mbind . drop (fromIntegral i) $ unCXListLike x)- - makeIterable = return . unCXListLike- makeString = \_-> return "<list>"----------------------------------------------------------------------------instance (Monad m) => TemplateInterface m Int where- bind = bind . CXInteger . fromIntegral- -instance (Monad m) => TemplateInterface m Integer where- bind = bind . CXInteger--instance (Monad m) => TemplateInterface m CXInteger where- makeString = return . show . unCXInteger- property "toInteger" = return . TwineInteger . unCXInteger - property "even?" = mbind . even . unCXInteger- property "odd?" = mbind . odd . unCXInteger- property "add" = \a-> return $ TwineFunction (\[n]-> do - i <- cxToInteger n- mbind $ (unCXInteger a + i)- )- property "subtract" = \a-> return $ TwineFunction (\[n]-> do - i <- cxToInteger n- mbind $ (unCXInteger a - i)- )--mbind = return . bind- -signal sig (TwineObject obj) = (getContext obj) sig --cxToInteger (TwineInteger i) = return i-cxToInteger cm@(TwineObject obj) = do- v <- signal "toInteger" cm- case v of- TwineInteger i -> return i- TwineNull -> error "expected number but got null value"- _ -> error ("'" ++ show v ++ "' is not a number")-- -
+ src/Text/Twine/Interpreter/Interface.hs view
@@ -0,0 +1,153 @@+{-#LANGUAGE MultiParamTypeClasses+ , TypeSynonymInstances+ , FlexibleInstances+ , FlexibleContexts + , NoMonomorphismRestriction+ , OverlappingInstances+ , OverloadedStrings+ , UndecidableInstances+ , FunctionalDependencies+ #-}++module Text.Twine.Interpreter.Interface (TemplateInterface (..), emptyContext, bind, unbind, method) where++import Control.Monad.Writer+import Data.ByteString.Char8 (ByteString)+import Data.Convertible.Base+import Data.Maybe+import Data.Monoid+import Text.Twine.Interpreter.Types+import qualified Data.ByteString.Char8 as C+import qualified Data.Map as M+++class (Monad m) => TemplateInterface m a | a -> m where+ property :: ByteString -> a -> m (TwineElement m)+ makeIterable :: a -> m [TwineElement m]+ makeString :: a -> m String++ property _ _ = return TwineNull+ makeIterable _ = return []+ makeString _ = return ""+++instance (Monad m, TemplateInterface m a) => Convertible a (TwineElement m) where+ safeConvert a = Right $ TwineObject $ Context {+ getContext = (flip property a),+ getIterable = makeIterable a,+ getString = makeString a+ }++------------------------------------------------------------------------++bind :: (Convertible a (TwineElement m), Monad m) => a -> TwineElement m+bind = convert++unbind :: (Convertible (TwineElement m) a, Monad m) => TwineElement m -> a+unbind = convert++method :: (Monad m) => ([TwineElement m] -> m (TwineElement m)) -> TwineElement m+method = TwineFunction++------------------------------------------------------------------------++instance (Monad m) => Convertible String (TwineElement m) where+ safeConvert = Right . TwineString . C.pack++instance (Monad m) => Convertible ByteString (TwineElement m) where+ safeConvert = Right . TwineString ++instance (Monad m) => Convertible Bool (TwineElement m) where+ safeConvert = Right . TwineBool++instance (Monad m) => Convertible ([TwineElement m] -> m (TwineElement m)) (TwineElement m) where+ safeConvert = Right . TwineFunction++instance (Monad m, Convertible a (TwineElement m)) => Convertible (Maybe a) (TwineElement m) where+ safeConvert (Just a) = Right $ bind a+ safeConvert Nothing = Right $ TwineNull++instance (Monad m) => TemplateInterface m (TwineElement m) where + makeString = return . show++instance (Monad m) => TemplateInterface m EmptyContext ++instance (Monad m, Convertible a (TwineElement m)) => Convertible [a] (TwineElement m) where+ safeConvert = Right . bind . CXListLike . map bind ++instance (Monad m) => Convertible Int (TwineElement m) where+ safeConvert = Right . bind . CXInteger . fromIntegral+ +instance (Monad m) => Convertible Integer (TwineElement m) where+ safeConvert = Right . bind . CXInteger++instance (Monad m) => Convertible (TwineElement m) (TwineElement m) where+ safeConvert = Right ++instance (Monad m) => TemplateInterface m [(ByteString,TwineElement m)] where+ property k = return . bind . lookup k++instance (Monad m) => TemplateInterface m (M.Map ByteString (TwineElement m)) where+ property k = return . bind . M.lookup k++------------------------------------------------------------------------+ +instance (Monad m) => TemplateInterface m (CXListLike m) where+ property "length" = return . bind . length . unCXListLike+ property "head" = mbind . head . unCXListLike+ property "tail" = return . bind . tail . unCXListLike+ property "init" = return . bind . init . unCXListLike+ property "last" = mbind . last . unCXListLike+ property "item" = \x -> return $ method (\[n] -> do+ i <- unbind n+ mbind (unCXListLike x !! i))+ + property "take" = \x -> return $ method (\[n] -> do+ i <- unbind n+ mbind . take i $ unCXListLike x)+ + property "drop" = \x -> return $ method (\[n] -> do+ i <- unbind n+ mbind . drop i $ unCXListLike x)+ + makeIterable = return . unCXListLike+ makeString = \_-> return "<list>"+++instance (Monad m) => TemplateInterface m CXInteger where+ makeString = return . show . unCXInteger+ property "toInteger" = return . TwineInteger . unCXInteger + property "even?" = mbind . even . unCXInteger+ property "odd?" = mbind . odd . unCXInteger+ property "add" = \a-> return $ method (\[n]-> do + i <- unbind n+ mbind $ (unCXInteger a + i)+ )+ property "subtract" = \a-> return $ method (\[n]-> do + i <- unbind n+ mbind $ (unCXInteger a - i)+ )+mbind :: (Convertible a (TwineElement m), Monad m) => a -> m (TwineElement m)+mbind = return . bind+ +emptyContext :: (Monad m) => TwineElement m+emptyContext = bind EmptyContext++instance (Monad m) => Convertible (TwineElement m) (m Int) where+ safeConvert = Right . cxToInteger+ +instance (Monad m) => Convertible (TwineElement m) (m Integer) where+ safeConvert = Right . cxToInteger++instance (Monad m) => Convertible (TwineElement m) (m Bool) where+ safeConvert = Right . cxToBool+ +cxToInteger (TwineInteger i) = + return (fromIntegral i)+cxToInteger cm@(TwineObject obj) = + signal "toInteger" cm >>= convert++signal :: ByteString -> TwineElement t -> t (TwineElement t)+signal sig (TwineObject obj) = (getContext obj) sig ++cxToBool (TwineBool b) = return b
src/Text/Twine/Interpreter/Types.hs view
@@ -1,22 +1,20 @@ {-#LANGUAGE MultiParamTypeClasses , TypeSynonymInstances , FlexibleInstances- , UndecidableInstances- , FlexibleContexts+ , FlexibleContexts + , NoMonomorphismRestriction , OverlappingInstances , OverloadedStrings- , NoMonomorphismRestriction+ , UndecidableInstances , FunctionalDependencies #-} module Text.Twine.Interpreter.Types where import qualified Data.ByteString.Char8 as C-import Data.ByteString.Char8 (ByteString,pack)-import Control.Monad.Writer-import Control.Monad.Identity -import Control.Monad.Trans+import Data.ByteString.Char8 (ByteString) import qualified Data.Map as M+import Data.Convertible.Base data TwineElement m = TwineObjectList [Context m] | TwineObject (Context m)@@ -27,20 +25,6 @@ | TwineList [TwineElement m] | TwineFunction ([TwineElement m] -> m (TwineElement m)) -newtype CXListLike m = CXListLike { unCXListLike :: [TwineElement m] }-newtype CXInteger = CXInteger { unCXInteger :: Integer }--type BuiltinFunc m = [TwineElement m] -> m (TwineElement m)--data ContextState m = ContextState { getContextState :: (TwineElement m)- , getContextFuns :: M.Map C.ByteString (BuiltinFunc m) }---instance (Monad m) => Eq (TwineElement m) where- (TwineString x) == (TwineString y) = x == y- (TwineList x) == (TwineList y) = x == y- _ == _ = error "Unable to determine equality."- instance (Monad m) => Show (TwineElement m) where show (TwineString x) = C.unpack x show (TwineObjectList _) = "((TwineObject))"@@ -49,13 +33,28 @@ show (TwineBool x) = show x show (TwineNull) = "" show (TwineFunction _) = "((TwineFunction))"+ show _ = "" -data EmptyContext = EmptyContext+instance (Monad m) => Eq (TwineElement m) where+ (TwineString x) == (TwineString y) = x == y+ (TwineList x) == (TwineList y) = x == y+ _ == _ = error "Unable to determine equality." ++newtype CXListLike m = CXListLike { unCXListLike :: [TwineElement m] }+newtype CXInteger = CXInteger { unCXInteger :: Integer }++type BuiltinFunc m = [TwineElement m] -> m (TwineElement m)++data ContextState m = ContextState { getContextState :: (TwineElement m)+ , getContextFuns :: M.Map C.ByteString (BuiltinFunc m) }+ data Context m = Context { getContext :: ByteString -> m (TwineElement m), getIterable :: m [TwineElement m], getString :: m String } ++data EmptyContext = EmptyContext
src/Text/Twine/Parser.hs view
@@ -86,6 +86,8 @@ -- Expressions ------------------------------------------------------------------------ +-- TODO Remove the cruft from the original expression parser.+ accessor = do a <- try method <|> try atom <?> "property or method" char '.'@@ -165,9 +167,3 @@ loadTemplateFromString :: String -> Template loadTemplateFromString = parseTemplate "theTemplate"------
src/Text/Twine/Parser/Types.hs view
@@ -1,30 +1,26 @@ module Text.Twine.Parser.Types where -import qualified Data.ByteString.Char8 as C--type Key = C.ByteString-type Name = C.ByteString +import Data.ByteString.Char8 (ByteString) +type Key = ByteString+type Name = ByteString type Template = [TemplateCode] -data Expr = Func Name [Expr] - | Var Name - | StringLiteral C.ByteString- | NumberLiteral Integer- | Accessor Expr Expr- deriving (Show,Read,Eq)+data Expr = + Func Name [Expr] + | Var Name + | StringLiteral ByteString+ | NumberLiteral Integer+ | Accessor Expr Expr+ deriving (Show,Read,Eq) -data TemplateCode = Text C.ByteString - | Slot Expr- | Loop Expr Key [TemplateCode]- | Cond Expr [TemplateCode]- | Incl FilePath- | Assign Key Expr- deriving (Show)+data TemplateCode = + Text ByteString + | Slot Expr+ | Loop Expr Key [TemplateCode]+ | Cond Expr [TemplateCode]+ | Incl FilePath+ | Assign Key Expr+ deriving (Show) -data ParserState = ParserState { getBlocks :: [TemplateCode] - , getTextQ :: C.ByteString- , getTemplate :: C.ByteString } deriving (Show)--makePS = ParserState [] C.empty
twine.cabal view
@@ -1,5 +1,5 @@ name: twine-version: 0.1.1+version: 0.1.2 synopsis: very simple template language description: very simple template language category: Text@@ -20,16 +20,16 @@ , filepath >= 1.1.0.3 , parsec >= 3 , containers >= 0.3 + , convertible Exposed-modules: Text.Twine Other-modules: Text.Twine.Parser ,Text.Twine.Parser.Types ,Text.Twine.Interpreter- ,Text.Twine.Interpreter.Context+ ,Text.Twine.Interpreter.Interface ,Text.Twine.Interpreter.ContextWriter - ,Text.Twine.Interpreter.FancyContext ,Text.Twine.Interpreter.Types ,Text.Twine.Interpreter.Builtins - ghc-options: -O2 -fvia-C+ ghc-options: -O2 -fvia-C