From f298fcb268dbd4fe74d752077f8f012532d095c1 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Mon, 14 Apr 2014 00:07:24 +1000
Subject: Interpreter can now handle literal strings to avoid code injection

---
 src/Thue/Interpreter.hs | 41 +++++++++++++++++++++++++++++++----------
 src/Thue/Parser.hs      | 28 +++++++++++++---------------
 2 files changed, 44 insertions(+), 25 deletions(-)

(limited to 'src/Thue')

diff --git a/src/Thue/Interpreter.hs b/src/Thue/Interpreter.hs
index 28aff93..3e82826 100644
--- a/src/Thue/Interpreter.hs
+++ b/src/Thue/Interpreter.hs
@@ -12,6 +12,15 @@ import Thue.Parser
 
 
 
+data ThueVersion = Ver1 | Ver2a
+    deriving (Eq)
+
+
+data Choice = Random StdGen
+            | First
+            | Last
+
+
 
 thue :: ThueProgram -> IO ThueState
 thue program =
@@ -19,30 +28,42 @@ thue program =
         state = thueInitialState program
         gen = mkStdGen 4 --chosen by fair dice roll, guaranteed to be random
 
-    in interpret state rules gen
+    in interpret Ver1 rules (Random gen) state
 
 
 
-interpret :: ThueState -> [ThueRule] -> StdGen -> IO ThueState
-interpret state rules gen =
+interpret :: ThueVersion -> [ThueRule] -> Choice -> ThueState -> IO ThueState
+interpret ver rules gen state =
     let possibleRules = rules `applicableTo` state
-        ruleToApply = possibleRules !! num
-
-        (num, gen') = nextInRange 0 (length possibleRules - 1) gen
+        (ruleToApply, gen') = choose possibleRules gen
 
     in if (possibleRules == [])
         then return state
-        else applyRule ruleToApply state >>= (\x -> interpret x rules gen')
+        else applyRule ver ruleToApply state >>= interpret ver rules gen'
+
 
 
+choose :: [ThueRule] -> Choice -> (ThueRule, Choice)
+choose ruleList gen =
+    case gen of
+        First -> (head ruleList, First)
 
-applyRule :: ThueRule -> ThueState -> IO ThueState
-applyRule rule state =
+        Last -> (last ruleList, Last)
+
+        Random g -> let (num, g') = nextInRange 0 (length ruleList - 1) g
+                    in (ruleList !! num, Random g')
+
+
+
+applyRule :: ThueVersion -> ThueRule -> ThueState -> IO ThueState
+applyRule ver rule state =
     let (before, after) = fromJust (extractInfix (original rule) state)
 
+        inputProc = if (ver == Ver1) then return . tStr else return . tLitStr
+
     in case (replacement rule) of
         x | x == (tStr ":::") ->
-            getLine >>= return . toThueState >>= return . (before ++) . (++ after)
+            getLine >>= inputProc >>= return . (before ++) . (++ after)
 
         x:xs | x == (tCh '~') ->
             putStr (fromThueState xs) >> return (before ++ after)
diff --git a/src/Thue/Parser.hs b/src/Thue/Parser.hs
index 3ca937e..a9c2d96 100644
--- a/src/Thue/Parser.hs
+++ b/src/Thue/Parser.hs
@@ -4,11 +4,12 @@ module Thue.Parser (
 	ThueState,
 	ThueChar(..),
 
-    tCh,
-    tStr,
-
 	parseThue,
-	toThueState,
+	
+	tCh,
+	tLit,
+	tStr,
+	tLitStr,
 	fromThueState
 	) where
 
@@ -48,24 +49,21 @@ parseThue = parse thue "error"
 
 
 
-toThueState :: String -> ThueState
-toThueState = map TChar
-
-
-
-fromThueState :: ThueState -> String
-fromThueState = map tChar
-
-
-
 tCh :: Char -> ThueChar
 tCh = TChar
 
-
+tLit :: Char -> ThueChar
+tLit = TLit
 
 tStr :: String -> ThueState
 tStr = map TChar
 
+tLitStr :: String -> ThueState
+tLitStr = map TLit
+
+fromThueState :: ThueState -> String
+fromThueState = map tChar
+
 
 
 
-- 
cgit