-- Read stdin, which has lines of form "key=value". -- Lookup the command line args as keys, and print their values. -- -- $ ghc --make lmap.hs && (echo alpha=male; echo beta=max; echo 0=1; echo = ) | ./lmap alpha beta gamma 0 -- "alpha"="male","beta"="max","0"="1",""="",Nil -- male,max,NotFound,1,. -- $ module Main where import Prelude import IO import Control.Monad.Error import Control.Monad.State import System.Environment import Text.ParserCombinators.Parsec hiding (State) main :: IO () main = do lines <- getContents putStrLn $ stringify $ parse parseString "" lines putStrLn $ show $ eval newTerp $ parse parseString "" lines eval :: Terp -> Either ParseError [Command] -> Result eval terp (Left x) = Left $ Err $ "ERROR: " ++ (show x) eval terp (Right x) = let (result', terp') = runState (runCommand (x !! 0)) terp in result' stringify :: Either ParseError [Command] -> String stringify (Left x) = "ERROR: " ++ (show x) stringify (Right x) = "PARSED " ++ (show x) joinOnCommas :: [String] -> String joinOnCommas ss = foldr (\ x y -> x ++ ";" ++ y) " " ss ---------------------------------------------------------- ---------------------------------------------------------- type Result = Either NotOk String data NotOk = Err String | Return String | Break | Continue deriving Show data Interp = Interp [Cmd] [Frame] deriving Show data Frame = Frame [Var] deriving Show data Var = Var String String deriving Show data Cmd = Cmd String [String] String deriving Show -- the state of the Tcl Interpreter, to act on. data Terp = Terp { cmds :: [Cmd], frames :: [Frame] } deriving Show -- that state, held in a State Mondad. type Act = State Terp -- Monad resulting in a Result. type Action = Act Result oneCmd :: Cmd oneCmd = Cmd "threetwoone" ["one_arg"] "one_body" newTerp = Terp { cmds = [oneCmd], frames = [] } ---------------------------------------------------------- runCommand :: Command -> Action --runCommand (Command (Bare "puts" : ts)) = do runCommand (Command things) = do st <- get let cmds' = cmds st r <- substThings [] things case r of Left z -> return r Right rstr -> return $ Right (show (findCmd cmds' rstr)) findCmd :: [Cmd] -> String -> Maybe (String, String) findCmd [] s = Nothing findCmd (c:cs) s = let Cmd name [args] body = c in if s == name then Just (args, body ++ " // " ++ s ++ " // " ++ name) -- HACK else findCmd cs s substThings :: [String] -> [Thing] -> State Terp Result substThings ws [] = return $ Right $ concat ws substThings ws (t:ts) = do a <- substThing t case a of Left z -> return $ Left z Right s -> substThings (s:ws) ts where substThing :: Thing -> State Terp Result substThing (Bare s) = return $ Right s ---------------------------------------------------------- data Thing = Bare String | VarThing String | CmdThing String deriving Show data Command = Command [Thing] specialChars = "{}[];\"$" whiteChars = " \t\r\n" blankChars = " \t" instance Show Command where show (Command things) = "<" ++ (joinOnCommas (map show things)) ++ ">" parseString :: Parser [Command] parseString = do skipComments parseEnd <|> parseCommands parseCommands :: Parser [Command] parseCommands = do c <- parseCommand cs <- parseString return $ c : cs skipComments :: Parser () skipComments = skip $ many $ oneOf $ whiteChars ++ specialChars parseCommand :: Parser Command parseCommand = do things <- many1 $ parseThing return $ Command things parseThing :: Parser Thing parseThing = do x <- many1 $ noneOf $ specialChars ++ whiteChars -- TODO: special chars. many $ oneOf $ blankChars return $ Bare x parseEnd :: Parser [Command] parseEnd = do eof return [] skip :: Parser a -> Parser () skip p = p >> return () ----------------------------------------------------------