generalization/ more instructions/ etc

src/Instructions/CharInstructions.hs

@@ -1,7 +1,12 @@
 module Instructions.CharInstructions where
 
+import Data.Char
 import State
 import Instructions.GenericInstructions
+import Instructions.StringInstructions (wschars)
+
+intToAscii :: (Integral a) => a -> Char
+intToAscii val = chr (abs (fromIntegral val) `mod` 128)
 
 instructionCharConcat :: State -> State
 instructionCharConcat state@(State {_char = c1 : c2 : cs, _string = ss}) = state{_char = cs, _string = [c1, c2] : ss}
@@ -28,3 +33,31 @@ instructionCharFromNthChar state@(State {_char = cs, _string = s1 : ss, _int = i
   in
     state{_char = s1 !! index : cs, _string = ss, _int = is}
 instructionCharFromNthChar state = state
+
+instructionCharIsWhitespace :: State -> State
+instructionCharIsWhitespace state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = (c1 `elem` wschars) : bs}
+instructionCharIsWhitespace state = state
+
+instructionCharIsLetter :: State -> State
+instructionCharIsLetter state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = isAlpha c1 : bs}
+instructionCharIsLetter state = state
+
+instructionCharIsDigit :: State -> State
+instructionCharIsDigit state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = isDigit c1 : bs}
+instructionCharIsDigit state = state
+
+instructionCharFromBool :: State -> State
+instructionCharFromBool state@(State {_char = cs, _bool = b1 : bs}) = state{_char = (if b1 then 'T' else 'F') : cs, _bool = bs}
+instructionCharFromBool state = state
+
+instructionCharFromAsciiInt :: State -> State
+instructionCharFromAsciiInt state@(State {_char = cs, _int = i1 : is}) = state{_char = intToAscii i1 : cs, _int = is}
+instructionCharFromAsciiInt state = state
+
+instructionCharFromAsciiFloat :: State -> State
+instructionCharFromAsciiFloat state@(State {_char = cs, _float = f1 : fs}) = state{_char = intToAscii @Integer (floor f1) : cs, _float = fs}
+instructionCharFromAsciiFloat state = state
+
+instructionCharsFromString :: State -> State
+instructionCharsFromString state@(State {_char = cs, _string = s1 : ss}) = state{_char = s1 <> cs, _string = ss}
+instructionCharsFromString state = state

src/Instructions/ExecInstructions.hs

@@ -5,10 +5,10 @@ import Instructions.IntInstructions
 import Instructions.GenericInstructions
 
 instructionExecIf :: State -> State
-instructionExecIf state@(State {_exec = (e1 : e2 : es), _bool = (b : _)}) =
+instructionExecIf state@(State {_exec = (e1 : e2 : es), _bool = (b : bs)}) =
   if b
-    then state {_exec = e1 : es}
+    then state {_exec = e1 : es, _bool = bs}
-    else state {_exec = e2 : es}
+    else state {_exec = e2 : es, _bool = bs}
 instructionExecIf state = state
 
 instructionExecDup :: State -> State

src/Instructions/GenericInstructions.hs

@@ -8,6 +8,19 @@ import State
 deleteAt :: Int -> [a] -> [a]
 deleteAt idx xs = take idx xs <> drop 1 (drop idx xs)
 
+combineTuple :: a -> ([a], [a]) -> [a]
+combineTuple val tup = fst tup <> [val] <> snd tup
+
+combineTupleList :: [a] -> ([a], [a]) -> [a]
+combineTupleList val tup = fst tup <> val <> snd tup
+
+
+insertAt :: Int -> a -> [a] -> [a]
+insertAt idx val xs = combineTuple val (splitAt idx xs)
+
+replaceAt :: Int -> a -> [a] -> [a]
+replaceAt idx val xs = deleteAt (idx + 1) (insertAt idx val xs)
+
 findSubA :: forall a. Eq a => [a] -> [a] -> Int
 findSubA fullA subA 
   | length fullA < length subA = -1
@@ -50,8 +63,8 @@ takeR amt fullA = drop (length fullA - amt) fullA
 dropR :: Int -> [a] -> [a]
 dropR amt fullA = take (length fullA - amt) fullA
 
-combineTuple :: a -> ([a], [a]) -> [a]
+absNum :: Integral a => a -> [b] -> Int
-combineTuple val tup = fst tup <> [val] <> snd tup
+absNum rawNum lst = abs (fromIntegral rawNum) `mod` length lst
 
 notEmptyStack :: State -> Lens' State [a] -> Bool
 notEmptyStack state accessor = not . null $ view accessor state

src/Instructions/StringInstructions.hs

@@ -3,12 +3,25 @@ module Instructions.StringInstructions where
 import State
 import Instructions.GenericInstructions
 import Data.List.Split
+import Control.Lens
 
-absNum :: Integral a => a -> [b] -> Int
+-- shamelessly stolen from https://hackage.haskell.org/package/MissingH-1.6.0.1/docs/src/Data.String.Utils.html#strip
-absNum rawNum lst = abs (fromIntegral rawNum) `mod` length lst
+wschars :: String
+wschars = " \t\r\n"
 
-combineString :: String -> (String, String) -> String
+strip :: String -> String
-combineString toInsert (front, back) = front <> toInsert <> back
+strip = lstrip . rstrip
+
+lstrip :: String -> String
+lstrip s = case s of
+                  [] -> []
+                  (x:xs) -> if x `elem` wschars
+                            then lstrip xs
+                            else s
+
+-- this is a tad inefficient init
+rstrip :: String -> String
+rstrip = reverse . lstrip . reverse
 
 instructionStringConcat :: State -> State
 instructionStringConcat state = instructionConcat state string
@@ -17,7 +30,7 @@ instructionStringSwap :: State -> State
 instructionStringSwap state = instructionSwap state string
 
 instructionStringInsertString :: State -> State
-instructionStringInsertString state@(State{_string = s1 : s2 : ss, _int = i1 : is}) = state {_string = combineString s2 (splitAt i1 s1) : ss, _int = is}
+instructionStringInsertString state@(State{_string = s1 : s2 : ss, _int = i1 : is}) = state {_string = combineTupleList s2 (splitAt i1 s1) : ss, _int = is}
 instructionStringInsertString state = state
 
 instructionStringFromFirstChar :: State -> State
@@ -35,9 +48,6 @@ instructionStringFromNthChar :: State -> State
 instructionStringFromNthChar state@(State {_string = s1 : ss, _int = i1 : is}) = state{_string = [s1 !! absNum i1 s1] : ss, _int = is}
 instructionStringFromNthChar state = state
 
--- instructionStringContainsString :: State -> State
--- instructionStringContainsString state@(State )
-
 instructionStringIndexOfString :: State -> State
 instructionStringIndexOfString state@(State {_string = s1 : s2 : ss, _int = is}) = state {_string = ss, _int = findSubA s1 s2 : is}
 instructionStringIndexOfString state = state
@@ -80,7 +90,7 @@ instructionStringOccurrencesOfString state@(State {_string = s1 : s2 : ss, _int
 instructionStringOccurrencesOfString state = state
 
 instructionStringInsertChar :: State -> State
-instructionStringInsertChar state@(State {_string = s1 : ss, _char = c1 : cs, _int = i1 : is}) = state{_string = combineString [c1] (splitAt i1 s1) : ss, _char = cs, _int = is}
+instructionStringInsertChar state@(State {_string = s1 : ss, _char = c1 : cs, _int = i1 : is}) = state{_string = combineTuple c1 (splitAt i1 s1) : ss, _char = cs, _int = is}
 instructionStringInsertChar state = state
 
 instructionStringContainsChar :: State -> State
@@ -172,3 +182,31 @@ instructionStringIsEmptyString state = state
 instructionStringRemoveNth :: State -> State
 instructionStringRemoveNth state@(State {_string = s1 : ss, _int = i1 : is}) = state{_string = deleteAt (absNum i1 s1) s1 : ss, _int = is}
 instructionStringRemoveNth state = state
+
+instructionStringSetNth :: State -> State
+instructionStringSetNth state@(State {_string = s1 : ss, _char = c1 : cs, _int = i1 : is}) = state{_string = replaceAt (absNum i1 s1) c1 s1 : ss, _char = cs, _int = is}
+instructionStringSetNth state = state
+
+instructionStringStripWhitespace :: State -> State
+instructionStringStripWhitespace state@(State {_string = s1 : ss}) = state{_string = strip s1 : ss}
+instructionStringStripWhitespace state = state
+
+-- Need to do uncons to all of the warnings in this mug
+instructionStringFromLens :: Show a => State -> Lens' State [a] -> State
+instructionStringFromLens state@(State {_string = ss}) accessor =
+  case uncons (view accessor state) of
+    Nothing -> state
+    Just (x,_) -> state{_string = show x : ss}
+
+instructionStringFromBool :: State -> State
+instructionStringFromBool state = instructionStringFromLens state bool
+
+instructionStringFromInt :: State -> State
+instructionStringFromInt state = instructionStringFromLens state int
+
+instructionStringFromFloat :: State -> State
+instructionStringFromFloat state = instructionStringFromLens state float
+
+instructionStringFromChar :: State -> State
+instructionStringFromChar state@(State {_string = ss, _char = c1 : cs}) = state{_string = [c1] : ss, _char = cs}
+instructionStringFromChar state = state