content: -- Some elementary types for Turing Machine
  data Move = MLeft | MRight | Stay deriving (Show, Eq)
  data Tape a = Tape a [a] [a]
  data Action state val = Action val Move state deriving (Show)
  
  instance (Show a) => Show (Tape a) where
    show (Tape x lts rts) = concat $ left ++ [hd] ++ right
                            where hd = "[" ++ show x ++ "]"
                                  left = map show $ reverse $ take 10 lts
                                  right = map show $ take 10 rts
  
  -- new tape
  tape blank lts rts | null rts = Tape blank left blanks
                     | otherwise = Tape (head rts) left right
                     where blanks = repeat blank
                           left = reverse lts ++ blanks
                           right = tail rts ++ blanks
  
  -- Turing Machine
  step rules (state, Tape x (lh:lts) (rh:rts)) = (state', tape')
       where  Action x' dir state' = rules state x
              tape' = move dir
              move Stay = Tape x' (lh:lts) (rh:rts)
              move MLeft = Tape lh lts (x':rh:rts)
              move MRight = Tape rh (x':lh:lts) rts
  
  runUTM rules stop start tape = steps ++ [final]
        where (steps, final:_) = break ((== stop) . fst) $ iterate (step rules) (start, tape)
  