-- 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 ()
----------------------------------------------------------