Simulation of manufactoria. WIP.

manufactoria.hs

import qualified Data.Map as M

data Direction = N | S | E | W deriving Eq

type Location = (Int, Int)

data Sticker = Red | Blue deriving Eq

data Widget = Widget Location [Sticker]

data Tile = Machine Direction | Conveyor Direction | In | Out

type Factory = M.Map Location Tile

data Outcome = Accept | Reject deriving Show

displace :: Widget -> Direction -> Widget
displace (Widget (x, y) xs) d
    | d == N    = Widget (x, y + 1) xs
    | d == S    = Widget (x, y - 1) xs
    | d == E    = Widget (x + 1, y) xs
    | otherwise = Widget (x - 1, y) xs

clockwise :: Direction -> Direction
clockwise N = E
clockwise E = S
clockwise S = W
clockwise W = N

cclockwise :: Direction -> Direction
cclockwise E = N
cclockwise S = E
cclockwise W = S
cclockwise N = W

process :: Widget -> Tile -> Widget
process w@(Widget _ []) (Machine d) = displace w d
process w@(Widget _ (x:_)) (Machine d)
    | x == Red = displace w (cclockwise d)
    | otherwise = displace w (clockwise d)
process w (Conveyor d) = displace w d
process w In = displace w S
process w Out = w

simulate :: Factory -> Widget -> [Widget]
simulate f w@(Widget l xs) = foldl process w []

simulate :: Factory -> Widget -> Outcome
simulate f w@(Widget l _) = case M.lookup l f of
    Nothing -> Reject
    Just t -> case t of
        Out -> Accept
        _ -> simulate f (process w t)

testf :: Factory
testf = M.fromList [
    ((0, 0), In),
    ((0, -1), Conveyor S),
    ((0, -2), Machine E),
    ((0, -3), Out)
    ]