Much improved error handling

3 files changed, 54 insertions, 29 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..dc5aaf2
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+rip
+*.hi
+*.o
diff --git a/rip.hs b/rip.hs
index 3c2ab2b..6dddb20 100644
--- a/rip.hs
+++ b/rip.hs
@@ -2,33 +2,54 @@ module Main where
 
 import System.Environment
 import System.Exit
+import Control.Exception
 import Data.Char
+import Data.Either
 
 type Stackelem = Integer
 
+
+c_ripmode :: Bool
+c_ripmode = True
+
+
 booltoint :: (Integral a) => Bool -> a
 booltoint False = 0
 booltoint True = 1
 
-parenpairs :: String -> [(Int,Int)]
+riperror :: String -> IO a
+riperror s = do
+	if c_ripmode
+		then putStrLn "rip"
+		else putStrLn $ "ERROR: " ++ s
+	exitFailure
+
+fromRight :: Either a b -> b
+fromRight (Right r) = r
+
+fromLeft :: Either a b -> a
+fromLeft (Left l) = l
+
+parenpairs :: String -> Either String [(Int,Int)]
 parenpairs = go 0 []
 	--       index  stack   string
-	where go   _      []      []    = []
+	where go   _      []      []    = Right []
 	      go   i      st   ('[':cs) = go (i+1) (i:st) cs
-	      go   i    (s:st) (']':cs) = (s,i) : go (i+1) st cs
-	      go   i      []   (']':cs) = error "rip -- unmatched closing bracket"
+	      go   i    (s:st) (']':cs) = either Left (\x -> Right $ (s,i):x) $ go (i+1) st cs
+	      go   i      []   (']':cs) = Left "rip -- unmatched closing bracket"
 	      go   i      st    (_:cs)  = go (i+1) st cs
-	      go   _    (_:_)     []    = error "rip -- unmatched open bracket"
+	      go   _    (_:_)     []    = Left "rip -- unmatched open bracket"
 
 -- returns string in and after codeblock
-getcodeblock :: String -> Either () (String,String)
-getcodeblock s = if head (dropWhile isSpace s) == '[' then Right (getcodeblock' s) else Left ()
+getcodeblock :: String -> Either String (String,String)
+getcodeblock s = if head (dropWhile isSpace s) == '[' then getcodeblock' s else Left "rip -- no codeblock when expected"
 
-getcodeblock' :: String -> (String,String)
-getcodeblock' s = (inblock,afterblock)
+getcodeblock' :: String -> Either String (String,String)
+getcodeblock' s = either Left (\_ -> Right (inblock,afterblock)) parenserr
 	where
 		afterwhite = dropWhile isSpace s
-		parens = parenpairs afterwhite
+		parenserr = parenpairs afterwhite
+		parens = fromRight parenserr
 		mainpair = minimum parens
 		blockend = snd mainpair
 		inblock = drop 1 $ take blockend afterwhite
@@ -106,31 +127,34 @@ rip' (x:xs) st = case x of
 			where (b:a:cs) = st
 
 	'I' ->
-		either
-			(\_ -> error "rip -- no block following I")
-			(\(inblock,afterblock) ->
+		let maybecb = getcodeblock xs
+		in case maybecb of
+			Left s -> riperror s
+
+			Right (inblock,afterblock) ->
 				if head st /= 0
 					then do
 						newstack <- rip' inblock (tail st)
 						rip' afterblock newstack
-					else rip' afterblock (tail st))
-			(getcodeblock xs)
+					else rip' afterblock (tail st)
 
 	'W' ->
-		either
-			(\_ -> error "rip -- no block following W")
-			(\(inblock,afterblock) ->
-				let doloop st = do
-					newstack <- rip' inblock st
-					if head newstack /= 0
-						then doloop $ tail newstack
-						else return newstack
+		let maybecb = getcodeblock xs
+		in case maybecb of
+			Left s -> riperror s
+
+			Right (inblock,afterblock) ->
+				let
+					doloop st = do
+						newstack <- rip' inblock st
+						if head newstack /= 0
+							then doloop $ tail newstack
+							else return newstack
 				in if head st /= 0
 					then do
 						newstack <- doloop (tail st)
 						rip' afterblock newstack
-					else rip' afterblock (tail st))
-			(getcodeblock xs)
+					else rip' afterblock (tail st)
 
 	'o' -> do
 		putStr [chr (fromIntegral $ head st)]
@@ -151,10 +175,7 @@ rip' (x:xs) st = case x of
 	c | isSpace c ->
 		rip' xs st
 
-	_ -> do
-		putStr "(error) Stack: "
-		print st
-		ioError (userError $ "Unknown command '" ++ [x,'\''])
+	_ -> riperror $ "Unknown command '" ++ [x,'\'']
 
 
 main :: IO ()
diff --git a/testif.rip b/testif.rip
index f4ebcee..03e1694 100644
--- a/testif.rip
+++ b/testif.rip
@@ -4,3 +4,4 @@ D I [1 O]
 1 S s
 I [0 O]
 9io
+h   <-- this char errors