Kevazoul - Print enhancements (#8)

* print machine a bit better * print machine looking nice but disgusting one liner to print transitions * print machine syntax improved * print machine syntax improved * print machine syntax improved * print machine syntax improved * print machine syntax improved
Karocyt · Mar 5, 2021 · 815bfdc · 815bfdc
1 parent b75f021
commit 815bfdc
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 3 deletions.
diff --git a/app/Main.hs b/app/Main.hs
@@ -46,6 +46,11 @@ main = do
     args        <- processArgs <$> getArgs
     machine     <- buildMachine args
 
+    case machine of
+        Right m -> putStrLn $ show m
+
     case ( join ((runMachine <$> machine) <*> buildState machine args) ) of
         Left str    -> putStrLn str >> exitFailure
         Right state -> putStrLn $ "Final tape: " ++ (show $ toList $ tape state)
+
+    debug
diff --git a/src/Machine.hs b/src/Machine.hs
@@ -9,6 +9,7 @@ import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
 import Data.Map (Map)
 import qualified Data.Map as Map -- functions names clash with Prelude, not Map type itself
+import Data.List (intercalate, groupBy)
 import Data.Either (isLeft, fromLeft)
 import Control.Monad (join)
 import Data.HashMap.Strict (toList)
@@ -30,7 +31,18 @@ data Machine = Machine {
     finals :: [String],
     transitions :: Map (String, Char) Transition,
     initial :: String
-} deriving (Show)
+} --deriving (Show)
+
+instance Show Machine where
+    show (Machine name alphabet blank finals transitions initial) = (concat ["*" | _ <- [1..42]]) ++
+        "\n\t" ++ name ++
+        '\n':(concat ["*" | _ <- [1..42]]) ++
+        "\nalphabet: " ++ intercalate ", " (((map show).Set.toList) alphabet) ++
+        "\nblank: '" ++ blank:"'" ++
+        "\ninitial: " ++ initial ++
+        "\nfinals: " ++ (intercalate ", " finals) ++
+        "\ntransitions:\n\t- " ++ (((intercalate "\n\t- ").map (\(group) -> (show.fst.fst.head) group ++ " defined for:\n\t\t" ++ intercalate ", " (map (show.snd.fst) group))) $ groupBy (\a b -> (fst.fst) a == (fst.fst) b) $ Map.toList transitions) ++
+        '\n':(concat ["*" | _ <- [1..42]])
 
 -- State type
 data State = State {
@@ -80,7 +92,7 @@ buildTransition name fields mAlphabet = do
         tmpToState <- fields .: "to_state"
         tmpWrite <- fields .: "write"
         if Set.member tmpWrite mAlphabet
-            then pure True else fail $ "On '" ++ tmpRead:"', function '"++ name ++ "' is able to write '" ++ tmpWrite:"' which is not in the machine alphabet."
+            then pure True else fail $ "On '" ++ tmpRead:"', function '"++ name ++ "' is able to write " ++ (show tmpWrite) ++ " which is not in the machine alphabet."
         tmpAction <- fields .: "action"
         tmpMove <- case (stringToMove tmpAction) of
             Left s -> fail s
@@ -138,7 +150,7 @@ runMachine machine state    | elem (nextTransition state) (finals machine) = Rig
                                 let t = nextTransition state
                                 let maybeT = Map.lookup (t, c) (transitions machine)
                                 nextT <- case (maybeT) of
-                                    Nothing -> Left $ "Behavior is not defined for state '" ++ t ++ "' and symbol '" ++ (show c) ++ "'"
+                                    Nothing -> Left $ "Behavior is not defined for state '" ++ t ++ "' and symbol " ++ (show c)
                                     Just x -> Right x
                                 let newState = (runTransition nextT) (transitions machine) state
                                 runMachine machine newState