[Make the user input field functional
Joachim Breitner <mail@joachim-breitner.de>**20100904105557
 Ignore-this: d7887a677d0c7d7fa2e60bf12f8f2c3a
] hunk ./b18n-combined-cgi.hs 7
+import qualified Data.ByteString.Lazy as BS
hunk ./b18n-combined-cgi.hs 27
+import BundledCode
hunk ./b18n-combined-cgi.hs 40
+    , playErrorM :: Maybe String
hunk ./b18n-combined-cgi.hs 139
+                )) +++
+                ( htmlMB playErrorM $ \playError -> maindiv << ( 
+                    p << (
+                        strong << "An error occurred while evaluating your code:" +++ br +++
+                        pre << playError
+                        )
hunk ./b18n-combined-cgi.hs 165
-		[ "get (a) = init (a)"
-                , "init (Nil)         = Nil"
+		[ "init (Nil)         = Nil"
hunk ./b18n-combined-cgi.hs 172
-		[ "get (a) = initHalf (a)"
-		, "initHalf(Nil)       = Nil"
+		[ "initHalf(Nil)       = Nil"
hunk ./b18n-combined-cgi.hs 181
-		[ "get (a) = seive (a)"
-		, "seive (Nil)               = Nil"
+		[ "seive (Nil)               = Nil"
hunk ./b18n-combined-cgi.hs 186
-		[ "get (a) = reverse (a)"
-		, "reverse(xs) = rev(xs,Nil)"
+		[ "reverse(xs) = rev(xs,Nil)"
hunk ./b18n-combined-cgi.hs 261
+defaultPlayCode = -- Are we only considering [Nat] here?
+        Just "source = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10]"
hunk ./b18n-combined-cgi.hs 282
-        let mbAST = parseString code
+        let eAST = parseString code
hunk ./b18n-combined-cgi.hs 285
-        let parseError = either (Just . show) (const Nothing) mbAST
+        let parseError = either (Just . show) (const Nothing) eAST
hunk ./b18n-combined-cgi.hs 287
-        let genCode = case (todo,mbAST) of
-                (Just Load, _) -> Nothing
-                (Just _, Right ast) -> Just $ render $ case exMode of 
+        let (genCodeM,getM) = case (todo,eAST) of
+                (Just Load, _) -> (Nothing, Nothing)
+                (Just _, Right ast) ->
+                    (  Just $ render $ case exMode of 
hunk ./b18n-combined-cgi.hs 294
-                _ -> Nothing
-
-        let defaultPlayCode = Just $ "default code"
+                    ,  firstDeclaredName ast
+                    )
+                _ -> (Nothing, Nothing)
hunk ./b18n-combined-cgi.hs 298
-        playCode <- case (todo,genCode) of
+        pcM <- getInput "playCode" 
+        (playCode, playErrorM) <- case (todo,getM,genCodeM,pcM) of
hunk ./b18n-combined-cgi.hs 302
-            (Just BiDi, Just _) -> return defaultPlayCode
+            (Just BiDi, _, Just _, _) -> return (defaultPlayCode, Nothing)
hunk ./b18n-combined-cgi.hs 304
-            (Just EvalGet, Just _) -> (`mplus` defaultPlayCode) <$> getInput "playCode"
-            (Just EvalPut, Just _) -> (`mplus` defaultPlayCode) <$> getInput "playCode"
-            (_, _ ) -> return Nothing
+            (Just EvalGet, Just get, Just genCode, Just pc) -> do
+                view <- liftIO $ evaluateWith genCode pc (get ++ " source")
+                case view of 
+                    Left err -> return $ (Just pc, Just err)
+                    Right dat -> return $ (\r -> (Just r, Nothing))
+                                        $ addDefiniton "view" dat 
+                                        $ delDefinition "result"
+                                        $ pc
+            (Just EvalGet, _, Just genCode, Nothing) -> do
+                return (defaultPlayCode, Nothing)
+            (Just EvalPut, Just get, Just genCode, Just pc) -> do
+                view <- liftIO $ evaluateWith genCode pc (get ++ "_B source view")
+                case view of 
+                    Left err -> return $ (Just pc, Just err)
+                    Right dat -> return $ (\r -> (Just r, Nothing))
+                                        $ addDefiniton "result" dat 
+                                        $ pc
+            (Just EvalPut, _, Just _, Nothing) -> do
+                return (defaultPlayCode, Nothing)
+            _ -> return (Nothing, Nothing)
hunk ./b18n-combined-cgi.hs 336
-                     genCode
+                     genCodeM
hunk ./b18n-combined-cgi.hs 338
+                     playErrorM
+
+evaluateWith :: String -> String -> String -> IO (Either String String)
+evaluateWith genCode playCode expr =
+    withinTmpDir $ do
+        BS.writeFile "BUtil.hs" bUtilCode
+        writeFile "Main.hs" $ "module Main where\n" ++ genCode
+        liftIO $ catchInterpreterErrors $ simpleInterpret mods imports playCode expr
+  where mods = 
+            [ "BUtil"
+            , "Main"
+            --, "Data.Maybe"
+            ]
+        imports = mods ++
+            [ "Data.Maybe"
+            ]
+
+withFullSource genCode playCode = genCode' ++ "\n" ++ playCode
+    where genCode' = unlines . filter (not . isPrefixOf "import") . lines $ genCode
hunk ./b18n-combined-cgi.hs 364
-	p << ("Definition parsed succesfully"
-{-		"Your definitions have the following types: " +++
-		pre << ("get :: " ++ getType ++ "\n"++
-		        "source :: " ++ sourceType) +++
-		"Therefore, an updater can be derived by " +++
-		case (canBff, canBffEq, canBffOrd) of
-			(True, _, _) -> 
-				tt << "bff" +++ ", " +++
-				tt << "bff_Eq" +++ ", and " +++
-				tt << "bff_Ord" +++ "."
-			(False, True, _) -> 
-				tt << "bff_Eq" +++ " and " +++
-				tt << "bff_Ord" +++ "."
-			(False, False, True) -> 
-				tt << "bff_Ord" +++ " only."
-			(False, False, False) -> 
-				"none of the " +++ tt << "bff" +++ " functions."
--}                                
-	) +++
+	p << ("Definition parsed succesfully") +++
hunk ./b18n-combined-cgi.hs 401
+
+
+firstDeclaredName (AST []) = Nothing
+firstDeclaredName (AST (Decl n _ _ _:_)) = Just (show n)
+