light cleaning

README.md

@@ -37,7 +37,7 @@ where:
 ## Delete
 
 ```bash
-rm -rf .stack-work
+rm -r .stack-work
 ```
 
 # Notepad:
@@ -109,4 +109,4 @@ BasicCheck args could disappear with even heavier Machine smart constructors
 is managing missing tape with Either too much ?
 `json` package might sound more "standard library" than `aeson`
 
-To return a Either String Machine, all fields might need to be their own types, returning Either in their constructors ?
+State might get bigger depending on how we handle bonuses (keeping history, counting iterations...)

app/Main.hs

@@ -8,8 +8,9 @@ import Data.ByteString.Lazy.Char8 (pack)
 import Data.Aeson (eitherDecode)
 import Data.Either
 import Control.Monad (join)
+import Data.Foldable (toList)
 
-import Machine
+import Machine (Machine, State, stateFromString, runMachine, tape)
 
 usage :: String
 usage = "Usage: ./a-machine desc.json tape\nwhere:\n\t- 'desc.json' is a json encoded file containing a valid machine description\n\t- 'tape' is a string of instructions from the machine alphabet"
@@ -35,20 +36,16 @@ buildMachine (Right args)   = do
 buildState :: Either String Machine -> Either String [String] -> Either String State
 buildState (Left err1) _ = Left err1
 buildState _ (Left err2) = Left err2
-buildState (Right machine) (Right args) = Right (stateFromString (args !! 1) 0 $ initial machine)
+buildState (Right machine) (Right args) = Right (stateFromString (args !! 1) 0 machine)
 
 debug :: IO ()
 debug = putStrLn "----- END (All exceptions/errors handled properly) -----"
 
 main :: IO ()
 main = do
-    putStrLn "----- BEGIN --------------------------------------------"
-    -- IO stuff stays in main then byebye IO
     args        <- processArgs <$> getArgs
     machine     <- buildMachine args
 
-    putStrLn $ show machine -- print everything to avoid the lazy side of things
-    -- buildState returns the last tape
     case ( join ((runMachine <$> machine) <*> buildState machine args) ) of
-        Left str    -> putStrLn str >> putStrLn "----- END (Exceptions or Errors handled properly) ------" >> exitFailure
-        Right state -> putStrLn ("It's ALIIIIIVE:\n" ++ (show state)) >> putStrLn "----- END (No errors) ----------------------------------"
+        Left str    -> putStrLn str >> exitFailure
+        Right state -> putStrLn $ "Final tape: " ++ (show $ toList $ tape state)

src/Machine.hs

@@ -1,37 +1,26 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE OverloadedStrings #-}
--- ScopedTypeVariables to print function types signature at runtime
--- OverloadedStrings allows for seemless conversion between Text/String (not ByteString ?!) as needed
+{-# LANGUAGE ScopedTypeVariables #-} -- Necessary for lambdas when type is unclear
+{-# LANGUAGE OverloadedStrings #-} -- Seemless Text/String (not ByteString ?!) conversion for (.:) param
 
 module Machine where
 
--- For FromJSON
-import Data.Aeson.Types (Parser, Object, Value)
-import qualified Data.HashMap.Strict as HM
-import Data.Aeson (FromJSON(..), parseJSON, (.:), withObject)
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
-import Data.Either (isLeft, fromLeft)
-
--- for Map (String, Char) Transition
 import Data.Map (Map)
 import qualified Data.Map as Map -- functions names clash with Prelude, not Map type itself
-
--- Show Functions
-import Data.Typeable
-
+import Data.Either (isLeft, fromLeft)
 import Control.Monad (join)
+import Data.HashMap.Strict (toList)
+import Data.Aeson (FromJSON, parseJSON, (.:), withObject)
+import Data.Aeson.Types (Parser, Object, Value)
 
-instance (Typeable a, Typeable b) => Show (a->b) where
-  show _ = show $ typeOf (undefined :: a -> b)
+instance Show Transition where
+  show _ = "t"
 
 type Tape = Seq Char
 type Move = Int
--- Map added to parameters for now as I can't see how to properly curry it
--- type Transition = Map (String, Char) Transition -> State -> Either String State
-newtype Transition = Transition { runTransition :: Map (String, Char) Transition -> State -> State } deriving Show
+newtype Transition = Transition { runTransition :: Map (String, Char) Transition -> State -> State }
 
 -- Static Machine type
 data Machine = Machine {
@@ -59,11 +48,11 @@ data TransitionStruct = TransitionStruct {
     tMove :: Move
 } deriving (Show)
 
-stateFromString :: String -> Int -> String -> State
-stateFromString tapeStr pos next = State {
+stateFromString :: String -> Int -> Machine -> State
+stateFromString tapeStr pos m = State {
     tape=Seq.fromList tapeStr,
     pos=pos,
-    nextTransition=next
+    nextTransition=initial m
 }
 
 currChar :: State -> Either String Char
@@ -84,7 +73,7 @@ genericTransition toWrite move toTransition transitions state = do
     State {tape=newTape, pos=newPos, nextTransition=nextT}
 
 buildTransition :: String -> Object -> Set Char -> Parser TransitionStruct
-buildTransition name fields mAlphabet = do -- Parser
+buildTransition name fields mAlphabet = do
         tmpRead <- fields .: "read"
         if Set.member tmpRead mAlphabet
             then pure True else fail $ "Function '"++ name ++ "' is able to read '" ++ tmpRead:"' which is not in the machine alphabet."
@@ -100,21 +89,17 @@ buildTransition name fields mAlphabet = do -- Parser
 
 parseTransitions :: Value -> Set Char -> Parser [Parser TransitionStruct]
 parseTransitions raw mAlphabet =
-    -- Conversion function + composition operator
     foldl (\globalAcc (name, linesArray :: [Object]) ->
         (foldl (\nameAcc lineObject ->
             (buildTransition name lineObject mAlphabet):nameAcc) [] linesArray) ++ globalAcc) []
-        .
-    -- Turn the HashMap with random name into a list of pairs (name, [objects]) and apply (<$>) operator
-    HM.toList <$>
-    -- parse the JSON thing into a HashMap String (HashMap String a)
-    parseJSON raw
+        . -- Conversion function + composition operator
+    toList <$> -- Turn the HashMap with random name into a list of pairs (name, [objects]) and apply (<$>) operator
+    parseJSON raw -- parse the JSON thing into a HashMap String (HashMap String a)
 
 onlyUnique :: Eq a => [a] -> Bool
 onlyUnique [] = True
 onlyUnique (x:xs) = if elem x xs then False else onlyUnique xs
 
--- Following https://artyom.me/aeson tutorial
 instance FromJSON Machine where
     parseJSON = withObject "machine" $ \o -> do -- in Parser (kinda Either String Value)
         mName <- o .: "name"
@@ -128,25 +113,17 @@ instance FromJSON Machine where
         let mAlphabet = Set.fromList lAlphabet
         mFinals <- o .: "finals"
         mInitial <- o .: "initial" :: Parser String
+        -- Cleaning could be made
         transitionsListObject <- o .: "transitions" -- > Parser Object
         transitionsListParsed <- parseTransitions transitionsListObject mAlphabet -- [Parser TransitionStruct] <- (Parser Object -> (Parser [Parser TransitionStruct])) 
         transitions <- sequence $ transitionsListParsed -- [t] <- [Parser t] -> Parser [t]
+        -- 
         let keyTuples = foldl (\acc t -> (tName t, tRead t):acc) [] transitions
         if onlyUnique keyTuples
             then pure True else fail "Duplicate definitions in transitions"
-        -- can't include the Map in curryied genericTransition... ?!
         let mTransitions = foldl (\acc t -> Map.insert (tName t, tRead t) (Transition (genericTransition (tWrite t) (tMove t) (tToState t))) acc) Map.empty transitions
         return Machine{name=mName, alphabet=mAlphabet, blank=mBlank, finals=mFinals, transitions=mTransitions, initial=mInitial}
 
--- NEEDS:
--- - Execute/check if transition exists
---   - Left "error blabla"
--- - Move pos
---   - Left "Stay on the dancefloor"
--- - Tail recursion
--- State might get bigger depending on how we handle bonuses (keeping history, counting iterations...)
-
--- TO DO
 runMachine :: Machine -> State -> Either String State
 runMachine machine state    | elem (nextTransition state) (finals machine) = Right state
                             | isLeft (currChar state) = Left $ fromLeft "" $ currChar state
@@ -159,6 +136,3 @@ runMachine machine state    | elem (nextTransition state) (finals machine) = Rig
                                     Just x -> Right x
                                 let newState = (runTransition nextT) (transitions machine) state
                                 runMachine machine newState
-
-                                -- let newTransition = ()
-                                -- Left $ "It's DEAD" -- :\n" ++ (show machine) ++ "\n" ++ (show state)