rm cruft

4 files changed, 0 insertions, 975 deletions

diff --git a/Main-gut-ohne-transformers.hs b/Main-gut-ohne-transformers.hs
deleted file mode 100644
index c4646ec..0000000
--- a/Main-gut-ohne-transformers.hs
+++ /dev/null
@@ -1,340 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Main where
-
-import Control.Concurrent
-import Control.Concurrent.MVar
-import Control.Monad
-import Data.Char
-import Data.IORef
-import Data.List
-import Data.Time.Clock (getCurrentTime)
-import Data.Time.Format (formatTime)
-import Numeric (showIntAtBase)
-import System.IO
-import System.Locale (defaultTimeLocale, rfc822DateFormat)
---import System.Posix.Signals
-
-
-type Buffer = (String, String)
-
-emptyBuffer = ("", "")
-
-
-main :: IO ()
-main = do
-  hSetEcho stdin False
-  hSetBuffering stdin NoBuffering
-
-  tid <- myThreadId
-
-  -- WINCH
-  -- TODO installHandler 28 (Catch $ ioctl 0 ...) Nothing
-
-  lock <- newMVar emptyBuffer
-
-  renderInputLine emptyBuffer
-  hFlush stdout
-
-  forkIO $ (dateThread 1000000) lock
-  uiThread (NormalMode nmap) lock
-
-
-dateThread delay lock = forever $ do
-    t <- getCurrentTime
-    withMVar lock $ \ buf -> do
-      putLine $ formatTime defaultTimeLocale rfc822DateFormat t 
-      renderInputLine buf
-      hFlush stdout
-    threadDelay delay
- 
-
-uiThread mode lock = do
-    c <- getCommand mode
-    mbMode <- modifyMVar lock (execCommand c)
-    case mbMode of
-        Nothing ->
-            uiThread mode lock
-        Just mode' -> 
-            uiThread mode' lock
-
-
-data Command
-  = AlertBadInput String
-  | InsertChar Char
-  | InsertNextCharVerbatim
-  | InsertCharThenChangeMode Char Mode
-  | MoveCursorRight
-  | MoveCursorLeft
-  | KillLastWord
-  | KillLastChar
-  | KillNextChar
-  | ExecuteInputBuffer
-  | UnboundSequence String String
-  | GotoBOL
-  | GotoEOL
-
-
-finishCommand :: Buffer -> IO (Buffer, Maybe Mode)
-finishCommand buf = do
-    clearLine
-    renderInputLine buf
-    hFlush stdout
-    return (buf, Nothing)
-
-finishCommandChangeMode :: Buffer -> Mode -> IO (Buffer, Maybe Mode)
-finishCommandChangeMode buf mode = do
-    clearLine
-    putStrLn $ "change mode: " ++ (show mode)
-    renderInputLine buf
-    hFlush stdout
-    return (buf, Just mode)
-
-
-
-execCommand :: Command -> Buffer -> IO (Buffer, Maybe Mode)
-
-execCommand GotoBOL (lhs, rhs) =
-    finishCommand ("", lhs ++ rhs)
-
-execCommand GotoEOL (lhs, rhs) =
-    finishCommand (lhs ++ rhs, "")
-
-execCommand MoveCursorLeft buf@(lhs@(_:_),rhs) = do
-    finishCommand (init lhs, last lhs : rhs)
-
-execCommand MoveCursorRight (lhs,rhs@(_:_)) = do
-    finishCommand (lhs ++ [head rhs], tail rhs)
-
-execCommand (InsertChar c) (lhs,rhs) = do
-    finishCommand (lhs ++ [c], rhs)
-
-execCommand (InsertCharThenChangeMode c m) (lhs, rhs) = do
-    finishCommandChangeMode (lhs ++ [c], rhs) m
-
-execCommand InsertNextCharVerbatim buf = do
-    finishCommandChangeMode buf VerbatimMode
-
-execCommand ExecuteInputBuffer (lhs,rhs) = do
-    putLine $ "input: <" ++ (concat $ map (reform 32) $ lhs ++ rhs) ++ ">"
-    finishCommand emptyBuffer
-
-execCommand KillNextChar buf@(lhs,_:rhs') = do
-    finishCommand (lhs, rhs')
-
-execCommand KillLastChar (lhs@(_:_),rhs) = do
-    finishCommand (init lhs, rhs)
-
-execCommand KillLastWord (lhs@(_:_),rhs) = do
-    finishCommand (foldr dropWhileEnd lhs [not . isSpace, isSpace], rhs)
-
-execCommand (AlertBadInput s) buf@(lhs,rhs) = do
-    putLine $ "unhandled input: <" ++ (concat $ map (reform 31) s) ++ ">"
-    finishCommand buf
-
-execCommand (UnboundSequence s n) buf@(lhs,rhs) = do
-    putLine $ "unbound sequence: <" ++ (concat $ map (reform 31) s) ++ "> "
-              ++ (special 31 n)
-    finishCommand buf
-
-execCommand _ buf = do
-    ringBell
-    hFlush stdout
-    return (buf, Nothing)
-
-
-
-
-putLine s = do
-    clearLine -- TODO this renders finishCommand's clearLine redundant
-    putStrLn s
-
-
-
-reform colorCode c =
-    if isPrint c
-      then normal colorCode [c]
-      else
-        special colorCode $
-          case ord c of
-            27 -> "^["
-            _ -> charToCode c
-
-normal colorCode s = "\x1b[" ++ show colorCode ++ "m" ++ s ++ "\x1b[m"
-special colorCode s = "\x1b[1;" ++ show colorCode ++ "m" ++ s ++ "\x1b[m"
-
-
-
--- XXX assumes that the cursor is already at the input line
-renderInputLine :: Buffer -> IO ()
-renderInputLine (lhs, rhs) = do
-    --clearLine
-    putStr $ "> " ++ pp lhs ++ pp rhs
-    moveCursorLeft (length $ ppVis rhs)
-    --hFlush stdout
-  where
-    pp = concat . map reform
-    reform c =
-      if isPrint c
-        then [c]
-        else
-          "\x1b[35m" ++ (
-            case ord c of
-              27 -> "^["
-              _ -> "\\" ++ show (ord c)
-          ) ++ "\x1b[m"
-
-    ppVis = concat . map reformVis
-    reformVis c =
-      if isPrint c
-        then [c]
-        else
-            case ord c of
-              27 -> "^["
-              _ -> "\\" ++ show (ord c)
-
-
-
-
-
-
-clearLine =
-    putStr "\x1b[2K" >>
-    moveCursorLeft 80
-
-
-ringBell = putStr "\x07" -- BEL '\a'
-
-
-moveCursorLeft 0 = return ()
-moveCursorLeft i = putStr $ "\x1b[" ++ show i ++ "D"
-
-moveCursorRight 0 = return ()
-moveCursorRight i = putStr $ "\x1b[" ++ show i ++ "C"
-
-clearLineFromCursorRight = putStr "\x1b[0K"
-
-
--- TODO? charToCode c = "\\x" ++ showHex (ord c)
-charToCode c = "\\x" ++ showIntAtBase 16 intToDigit (ord c) ""
-
-
-
-
-
--- TODO pressing ESC, then F11 etc. is ugly
-nmap =
-  [ ("\x01", GotoBOL)
-  , ("\x05", GotoEOL)
-  , ("\x1b[3~", KillNextChar)
-  , ("\x1b[C", MoveCursorRight)
-  , ("\x1b[D", MoveCursorLeft)
-  , ("\x16", InsertNextCharVerbatim) -- ^V
-  , ("\x17", KillLastWord) -- ^W
-  , ("\x0a", ExecuteInputBuffer)
-  , ("\x7f", KillLastChar) -- Delete
-  , ("\x08", KillLastChar) -- BackSpace
-  ]
-  ++ [unboundSequence "\x1b[2~" "<Insert>"]
-  ++ [unboundSequence "\x1b[5~" "<Prior>"]    -- page up
-  ++ [unboundSequence "\x1b[6~" "<Next>"]     -- page dn
-  ++ [unboundSequence "\x1b[7~" "<Home>"]
-  ++ [unboundSequence "\x1b[8~" "<End>"]
-  ++ [unboundSequence "\x1b[2$" "<S-Insert>"]
-  ++ [unboundSequence "\x1b[5$" "<S-Prior>"]    -- page up
-  ++ [unboundSequence "\x1b[6$" "<S-Next>"]     -- page dn
-  ++ [unboundSequence "\x1b[7$" "<S-Home>"]
-  ++ [unboundSequence "\x1b[8$" "<S-End>"]
-  ++ [unboundSequence "\x1b\x1b[2$" "<S-M-Insert>"]
-  ++ [unboundSequence "\x1b\x1b[5$" "<S-M-Prior>"]    -- page up
-  ++ [unboundSequence "\x1b\x1b[6$" "<S-M-Next>"]     -- page dn
-  ++ [unboundSequence "\x1b\x1b[7$" "<S-M-Home>"]
-  ++ [unboundSequence "\x1b\x1b[8$" "<S-M-End>"]
-  ++ [unboundSequence "\x1b\x1b[A" "<M-Up>"]
-  ++ [unboundSequence "\x1b\x1b[B" "<M-Down>"]
-  ++ [unboundSequence "\x1b\x1b[C" "<M-Right>"]
-  ++ [unboundSequence "\x1b\x1b[D" "<M-Left>"]
-  ++ [unboundSequence "\x1b\x1b[a" "<S-M-Up>"]
-  ++ [unboundSequence "\x1b\x1b[b" "<S-M-Down>"]
-  ++ [unboundSequence "\x1b\x1b[c" "<S-M-Right>"]
-  ++ [unboundSequence "\x1b\x1b[d" "<S-M-Left>"]
-  ++ [unboundSequence "\x1b[a" "<S-Up>"]
-  ++ [unboundSequence "\x1b[b" "<S-Down>"]
-  ++ [unboundSequence "\x1b[c" "<S-Right>"]
-  ++ [unboundSequence "\x1b[d" "<S-Left>"]
-  ++ [unboundSequence "\x1bOa" "<C-Up>"]
-  ++ [unboundSequence "\x1bOb" "<C-Down>"]
-  ++ [unboundSequence "\x1bOc" "<C-Right>"]
-  ++ [unboundSequence "\x1bOd" "<C-Left>"]
-  ++ [unboundSequence "\x1b\x1bOa" "<C-M-Up>"]
-  ++ [unboundSequence "\x1b\x1bOb" "<C-M-Down>"]
-  ++ [unboundSequence "\x1b\x1bOc" "<C-M-Right>"]
-  ++ [unboundSequence "\x1b\x1bOd" "<C-M-Left>"]
-  ++ [unboundSequence "\x1b[11~" "<F1>"]
-  ++ [unboundSequence "\x1b[12~" "<F2>"]
-  ++ [unboundSequence "\x1b[13~" "<F3>"]
-  ++ [unboundSequence "\x1b[14~" "<F4>"]
-  ++ [unboundSequence "\x1b[15~" "<F5>"]
-  ++ [unboundSequence "\x1b[17~" "<F6>"]
-  ++ [unboundSequence "\x1b[18~" "<F7>"]
-  ++ [unboundSequence "\x1b[19~" "<F8>"]
-  ++ [unboundSequence "\x1b[20~" "<F9>"]
-  ++ [unboundSequence "\x1b[21~" "<F10>"]
-  ++ [unboundSequence "\x1b[23~" "<F11>"]
-  ++ [unboundSequence "\x1b[24~" "<F12>"]
-
-  ++ [unboundSequence "\x1b\x1b[2~" "<M-Insert>"]
-  ++ [unboundSequence "\x1b\x1b[3~" "<M-Delete>"]
-  ++ map (\ i -> unboundSequence ("\x1b\x1b[" ++ show i ++ "~")
-                                 ("<M-F" ++ show i ++ ">"))
-          [11..24]
-  ++ [unboundSequence "\x1b\x7f" "<M-BackSpace>"]
-  ++ [unboundSequence "\x1b\x0a" "<M-Return>"]
-
-
-unboundSequence seq name =
-  (seq, UnboundSequence seq name)
-
-
-data Mode
-  = NormalMode [(String, Command)]
-  | VerbatimMode
-
-instance  Show Mode  where
-  show (NormalMode _) = "normal"
-  show VerbatimMode = "verbatim"
-
-
-getCommand :: Mode -> IO Command
-getCommand (NormalMode map) = getMappedCommand map
-getCommand VerbatimMode = verbatimKeymap
-
-
-getMappedCommand :: [(String, Command)] -> IO Command
-getMappedCommand xs = do
-    c <- getChar
-    if any (isPrefixOf [c] . fst) xs
-      then rec [c]
-      else
-        if isPrint c
-          then return $ InsertChar c
-          else return $ AlertBadInput [c]
-  where
-    rec :: String -> IO Command
-    rec s =
-      case lookup s xs of
-        Just c -> return c
-        _ ->
-          if any (isPrefixOf s . fst) xs
-            then do
-              c <- getChar
-              rec $ s ++ [c]
-            else
-              return $ AlertBadInput s
-
-
-verbatimKeymap :: IO Command
-verbatimKeymap = do
-  c <- getChar
-  --return $ InsertCharThenChangeMode c defaultGetCommand
-  return $ InsertCharThenChangeMode c (NormalMode nmap)
-
diff --git a/Main-kaputt-mit-mtl.hs b/Main-kaputt-mit-mtl.hs
deleted file mode 100644
index 0167b9f..0000000
--- a/Main-kaputt-mit-mtl.hs
+++ /dev/null
@@ -1,396 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Main where
-
-import Control.Concurrent
-import Control.Concurrent.MVar
-import Control.Monad
-import Data.Char
-import Data.IORef
-import Data.List
-import Data.Time.Clock (getCurrentTime)
-import Data.Time.Format (formatTime)
-import Numeric (showIntAtBase)
-import System.IO
-import System.Locale (defaultTimeLocale, rfc822DateFormat)
---import System.Posix.Signal
---import Control.Monad.Trans.Class (lift)
---import Control.Monad.IO.Class (liftIO, MonadIO)
---import Control.Monad.Trans.State.Lazy
-import Control.Monad.State
-import Control.Monad.Reader
-import Data.Typeable
-import Control.Applicative
-
-
-newtype VT a = VT (StateT VTState IO a)
-    deriving (Functor, Monad, MonadIO, MonadState VTState)
-
-
-instance Applicative VT where
-    pure = return
-    (<*>) = ap
-
-
-data VTState = VTState
-  { mode :: Mode
-  , buffer :: MVar Buffer
-  }
-
-runVT :: VTState -> VT a -> IO (a, VTState)
-runVT st (VT a) = runStateT a st
-
-
-
-
-type Buffer = (String, String)
-
-emptyBuffer = ("", "")
-
-
-main :: IO ()
-main = do
-  hSetEcho stdin False
-  hSetBuffering stdin NoBuffering
-
-  tid <- myThreadId
-
-  -- WINCH
-  -- TODO installHandler 28 (Catch $ ioctl 0 ...) Nothing
-
-  lock <- newMVar emptyBuffer
-
-  renderInputLine emptyBuffer
-  hFlush stdout
-
-  let st = VTState
-        { mode = NormalMode nmap
-        , buffer = lock
-        }
-
-  forkIO $ runVT st (dateThread 1000000 lock) >> return ()
-  runVT st uiThread
-
-  return ()
-
-
-dateThread :: Int -> MVar Buffer -> VT ()
-dateThread delay lock = forever $ do
-    t <- liftIO getCurrentTime
-    liftIO $ withMVar lock $ \ buf -> do
-      putLine $ formatTime defaultTimeLocale rfc822DateFormat t 
-      renderInputLine buf
-      hFlush stdout
-    liftIO $ threadDelay delay
- 
-
---uiThread :: MVar Buffer -> VT ()
---uiThread lock = do
---    c <- liftIO $ getCommand mode
---uiThread :: mvar buffer -> vt ()
---uiThread lock = do
-uiThread :: VT ()
-uiThread = forever $ do
-    st <- get
-    let m = mode st
-    c <- liftIO $ getCommand m
-    b <- liftIO $ readMVar (buffer st)
-    execCommand c b
-    --mbMode <- liftIO $ modifyMVar (buffer st) (execCommand c)
-    --case mbMode of
-    --    Nothing -> return ()
-    --    Just mode' -> do
-    --        put $ st { mode = mode' }
-
-
-data Command
-  = AlertBadInput String
-  | InsertChar Char
-  | InsertNextCharVerbatim
-  | InsertCharThenChangeMode Char Mode
-  | MoveCursorRight
-  | MoveCursorLeft
-  | KillLastWord
-  | KillLastChar
-  | KillNextChar
-  | ExecuteInputBuffer
-  | UnboundSequence String String
-  | GotoBOL
-  | GotoEOL
-
-
---finishCommand :: Buffer -> IO (Buffer, Maybe Mode)
-finishCommand :: Buffer -> VT ()
-finishCommand buf = do
-    b <- gets buffer
-    liftIO $ do
-        clearLine
-        renderInputLine buf
-        hFlush stdout
-        putMVar b buf
-    --modify $ \ st -> st { buffer = buf }
-    --return (buf, Nothing)
-
---finishCommandChangeMode :: Buffer -> Mode -> IO (Buffer, Maybe Mode)
-finishCommandChangeMode :: Buffer -> Mode -> VT ()
-finishCommandChangeMode buf mode = do
-    b <- gets buffer
-    liftIO $ do
-        clearLine
-        putStrLn $ "change mode: " ++ (show mode)
-        renderInputLine buf
-        hFlush stdout
-        putMVar b buf
-    --return (buf, Just mode)
-    --modify $ \ st -> st { buffer = buf }
-
-
---execCommand :: Command -> Buffer -> IO (Buffer, Maybe Mode)
-execCommand :: Command -> Buffer -> VT ()
-
-execCommand GotoBOL (lhs, rhs) =
-    finishCommand ("", lhs ++ rhs)
-
-execCommand GotoEOL (lhs, rhs) =
-    finishCommand (lhs ++ rhs, "")
-
-execCommand MoveCursorLeft buf@(lhs@(_:_),rhs) = do
-    finishCommand (init lhs, last lhs : rhs)
-
-execCommand MoveCursorRight (lhs,rhs@(_:_)) = do
-    finishCommand (lhs ++ [head rhs], tail rhs)
-
-execCommand (InsertChar c) (lhs,rhs) = do
-    finishCommand (lhs ++ [c], rhs)
-
-execCommand (InsertCharThenChangeMode c m) (lhs, rhs) = do
-    finishCommandChangeMode (lhs ++ [c], rhs) m
-
-execCommand InsertNextCharVerbatim buf = do
-    finishCommandChangeMode buf VerbatimMode
-
-execCommand ExecuteInputBuffer (lhs,rhs) = do
-    liftIO $ putLine $ "input: <" ++ (concat $ map (reform 32) $ lhs ++ rhs) ++ ">"
-    finishCommand emptyBuffer
-
-execCommand KillNextChar buf@(lhs,_:rhs') = do
-    finishCommand (lhs, rhs')
-
-execCommand KillLastChar (lhs@(_:_),rhs) = do
-    finishCommand (init lhs, rhs)
-
-execCommand KillLastWord (lhs@(_:_),rhs) = do
-    finishCommand (foldr dropWhileEnd lhs [not . isSpace, isSpace], rhs)
-
-execCommand (AlertBadInput s) buf@(lhs,rhs) = do
-    liftIO $ putLine $ "unhandled input: <" ++ (concat $ map (reform 31) s) ++ ">"
-    finishCommand buf
-
-execCommand (UnboundSequence s n) buf@(lhs,rhs) = do
-    liftIO $ putLine $ "unbound sequence: <" ++ (concat $ map (reform 31) s) ++ "> "
-              ++ (special 31 n)
-    finishCommand buf
-
-execCommand _ buf = do
-    liftIO $ do
-        ringBell
-        hFlush stdout
-    --return (buf, Nothing)
-
-
-
-
-putLine s = do
-    clearLine -- TODO this renders finishCommand's clearLine redundant
-    putStrLn s
-
-
-
-reform colorCode c =
-    if isPrint c
-      then normal colorCode [c]
-      else
-        special colorCode $
-          case ord c of
-            27 -> "^["
-            _ -> charToCode c
-
-normal colorCode s = "\x1b[" ++ show colorCode ++ "m" ++ s ++ "\x1b[m"
-special colorCode s = "\x1b[1;" ++ show colorCode ++ "m" ++ s ++ "\x1b[m"
-
-
-
--- XXX assumes that the cursor is already at the input line
-renderInputLine :: Buffer -> IO ()
-renderInputLine (lhs, rhs) = do
-    --clearLine
-    putStr $ "> " ++ pp lhs ++ pp rhs
-    moveCursorLeft (length $ ppVis rhs)
-    --hFlush stdout
-  where
-    pp = concat . map reform
-    reform c =
-      if isPrint c
-        then [c]
-        else
-          "\x1b[35m" ++ (
-            case ord c of
-              27 -> "^["
-              _ -> "\\" ++ show (ord c)
-          ) ++ "\x1b[m"
-
-    ppVis = concat . map reformVis
-    reformVis c =
-      if isPrint c
-        then [c]
-        else
-            case ord c of
-              27 -> "^["
-              _ -> "\\" ++ show (ord c)
-
-
-
-
-
-
-clearLine =
-    putStr "\x1b[2K" >>
-    moveCursorLeft 80
-
-
-ringBell = putStr "\x07" -- BEL '\a'
-
-
-moveCursorLeft 0 = return ()
-moveCursorLeft i = putStr $ "\x1b[" ++ show i ++ "D"
-
-moveCursorRight 0 = return ()
-moveCursorRight i = putStr $ "\x1b[" ++ show i ++ "C"
-
-clearLineFromCursorRight = putStr "\x1b[0K"
-
-
--- TODO? charToCode c = "\\x" ++ showHex (ord c)
-charToCode c = "\\x" ++ showIntAtBase 16 intToDigit (ord c) ""
-
-
-
-
-
--- TODO pressing ESC, then F11 etc. is ugly
-nmap =
-  [ ("\x01", GotoBOL)
-  , ("\x05", GotoEOL)
-  , ("\x1b[3~", KillNextChar)
-  , ("\x1b[C", MoveCursorRight)
-  , ("\x1b[D", MoveCursorLeft)
-  , ("\x16", InsertNextCharVerbatim) -- ^V
-  , ("\x17", KillLastWord) -- ^W
-  , ("\x0a", ExecuteInputBuffer)
-  , ("\x7f", KillLastChar) -- Delete
-  , ("\x08", KillLastChar) -- BackSpace
-  ]
-  ++ [unboundSequence "\x1b[2~" "<Insert>"]
-  ++ [unboundSequence "\x1b[5~" "<Prior>"]    -- page up
-  ++ [unboundSequence "\x1b[6~" "<Next>"]     -- page dn
-  ++ [unboundSequence "\x1b[7~" "<Home>"]
-  ++ [unboundSequence "\x1b[8~" "<End>"]
-  ++ [unboundSequence "\x1b[2$" "<S-Insert>"]
-  ++ [unboundSequence "\x1b[5$" "<S-Prior>"]    -- page up
-  ++ [unboundSequence "\x1b[6$" "<S-Next>"]     -- page dn
-  ++ [unboundSequence "\x1b[7$" "<S-Home>"]
-  ++ [unboundSequence "\x1b[8$" "<S-End>"]
-  ++ [unboundSequence "\x1b\x1b[2$" "<S-M-Insert>"]
-  ++ [unboundSequence "\x1b\x1b[5$" "<S-M-Prior>"]    -- page up
-  ++ [unboundSequence "\x1b\x1b[6$" "<S-M-Next>"]     -- page dn
-  ++ [unboundSequence "\x1b\x1b[7$" "<S-M-Home>"]
-  ++ [unboundSequence "\x1b\x1b[8$" "<S-M-End>"]
-  ++ [unboundSequence "\x1b\x1b[A" "<M-Up>"]
-  ++ [unboundSequence "\x1b\x1b[B" "<M-Down>"]
-  ++ [unboundSequence "\x1b\x1b[C" "<M-Right>"]
-  ++ [unboundSequence "\x1b\x1b[D" "<M-Left>"]
-  ++ [unboundSequence "\x1b\x1b[a" "<S-M-Up>"]
-  ++ [unboundSequence "\x1b\x1b[b" "<S-M-Down>"]
-  ++ [unboundSequence "\x1b\x1b[c" "<S-M-Right>"]
-  ++ [unboundSequence "\x1b\x1b[d" "<S-M-Left>"]
-  ++ [unboundSequence "\x1b[a" "<S-Up>"]
-  ++ [unboundSequence "\x1b[b" "<S-Down>"]
-  ++ [unboundSequence "\x1b[c" "<S-Right>"]
-  ++ [unboundSequence "\x1b[d" "<S-Left>"]
-  ++ [unboundSequence "\x1bOa" "<C-Up>"]
-  ++ [unboundSequence "\x1bOb" "<C-Down>"]
-  ++ [unboundSequence "\x1bOc" "<C-Right>"]
-  ++ [unboundSequence "\x1bOd" "<C-Left>"]
-  ++ [unboundSequence "\x1b\x1bOa" "<C-M-Up>"]
-  ++ [unboundSequence "\x1b\x1bOb" "<C-M-Down>"]
-  ++ [unboundSequence "\x1b\x1bOc" "<C-M-Right>"]
-  ++ [unboundSequence "\x1b\x1bOd" "<C-M-Left>"]
-  ++ [unboundSequence "\x1b[11~" "<F1>"]
-  ++ [unboundSequence "\x1b[12~" "<F2>"]
-  ++ [unboundSequence "\x1b[13~" "<F3>"]
-  ++ [unboundSequence "\x1b[14~" "<F4>"]
-  ++ [unboundSequence "\x1b[15~" "<F5>"]
-  ++ [unboundSequence "\x1b[17~" "<F6>"]
-  ++ [unboundSequence "\x1b[18~" "<F7>"]
-  ++ [unboundSequence "\x1b[19~" "<F8>"]
-  ++ [unboundSequence "\x1b[20~" "<F9>"]
-  ++ [unboundSequence "\x1b[21~" "<F10>"]
-  ++ [unboundSequence "\x1b[23~" "<F11>"]
-  ++ [unboundSequence "\x1b[24~" "<F12>"]
-
-  ++ [unboundSequence "\x1b\x1b[2~" "<M-Insert>"]
-  ++ [unboundSequence "\x1b\x1b[3~" "<M-Delete>"]
-  ++ map (\ i -> unboundSequence ("\x1b\x1b[" ++ show i ++ "~")
-                                 ("<M-F" ++ show i ++ ">"))
-          [11..24]
-  ++ [unboundSequence "\x1b\x7f" "<M-BackSpace>"]
-  ++ [unboundSequence "\x1b\x0a" "<M-Return>"]
-
-
-unboundSequence seq name =
-  (seq, UnboundSequence seq name)
-
-
-data Mode
-  = NormalMode [(String, Command)]
-  | VerbatimMode
-
-instance  Show Mode  where
-  show (NormalMode _) = "normal"
-  show VerbatimMode = "verbatim"
-
-
-getCommand :: Mode -> IO Command
-getCommand (NormalMode map) = getMappedCommand map
-getCommand VerbatimMode = verbatimKeymap
-
-
-getMappedCommand :: [(String, Command)] -> IO Command
-getMappedCommand xs = do
-    c <- getChar
-    if any (isPrefixOf [c] . fst) xs
-      then rec [c]
-      else
-        if isPrint c
-          then return $ InsertChar c
-          else return $ AlertBadInput [c]
-  where
-    rec :: String -> IO Command
-    rec s =
-      case lookup s xs of
-        Just c -> return c
-        _ ->
-          if any (isPrefixOf s . fst) xs
-            then do
-              c <- getChar
-              rec $ s ++ [c]
-            else
-              return $ AlertBadInput s
-
-
-verbatimKeymap :: IO Command
-verbatimKeymap = do
-  c <- getChar
-  --return $ InsertCharThenChangeMode c defaultGetCommand
-  return $ InsertCharThenChangeMode c (NormalMode nmap)
-
diff --git a/OldMain.hs b/OldMain.hs
deleted file mode 100644
index 05fb955..0000000
--- a/OldMain.hs
+++ /dev/null
@@ -1,206 +0,0 @@
-module Main where
-
-import Control.Concurrent
-import Control.Concurrent.MVar
-import Control.Monad (forever)
-import System.IO
-import Data.IORef
-import Data.Time.Clock (getCurrentTime)
-import Data.Time.Format (formatTime)
-import System.Locale (defaultTimeLocale, rfc822DateFormat)
-import Data.Char
-import Data.List
-
-
-data Config = Config
-
-data State = State
-  { promptString :: String
-  , inputBuffer :: (String, String)
-  , getCommand :: IO Command
-  , outputLock :: MVar ()
-  }
-
-initState :: State
-initState = State "> " ("", "") defaultGetCommand
-
-
-main :: IO ()
-main = do
-  hSetEcho stdin False
-  hSetBuffering stdin NoBuffering
-
-  lock <- newMVar initState
-
-  let q = State
-        { promptString = "> "
-        , inputBuffer = ("", "")
-        , getCommand = defaultGetCommand
-        , outputLock = lock
-        }
-
-  putStr (promptString q)
-
-  forkIO $ dateThread q
-  uiThread q
-
-
-dateThread q = forever $ do
-    t <- getCurrentTime
-    withMVar (outputLock q) $ \ _ -> do
-      clearLine
-      putStrLn $ formatTime defaultTimeLocale rfc822DateFormat t 
-      putStr $ (promptString q) ++ lhs ++ rhs
-      moveCursorLeft (length rhs)
-      hFlush stdout
-      return ()
-    threadDelay 1000000
-
-
-uiThread q = do
-    c <- getCommand q
-    modifyMVar_ (outputLock q) (execCommand c) >>= uiThread
-
-
-data Command
-  = AlertBadInput String
-  | InsertChar Char
-  | InsertNextCharVerbatim
-  | MoveCursorRight
-  | MoveCursorLeft
-  | KillLastWord
-  | KillLastChar
-  | ExecuteInputBuffer
-
-
-defaultGetCommand :: IO Command
-defaultGetCommand = do
-    c1 <- getChar
-    case c1 of
-      '\x1b' -> do
-        c2 <- getChar
-        case c2 of
-          '[' -> do
-            c3 <- getChar
-            case c3 of
-              'C' -> return MoveCursorRight
-              'D' -> return MoveCursorLeft
-              _ -> return $ AlertBadInput (c1:c2:c3:[])
-          _ -> return $ AlertBadInput (c1:c2:[])
-      _ ->
-        if isPrint c1
-          then return $ InsertChar c1
-          else
-            case ord c1 of
-              22 -> return InsertNextCharVerbatim
-              23 -> return KillLastWord
-              10 -> return ExecuteInputBuffer
-              127 -> return KillLastChar
-              _ -> return $ AlertBadInput (c1:[])
-
-
-execCommand :: String -> Command -> (String, String) -> IO (String, String)
-
-execCommand MoveCursorLeft q@State{inputBuffer=([],_)} =
-  cannotExecuteCommand q
-
-execCommand MoveCursorLeft q@State{inputBuffer=(lhs,rhs)} = do
-    clearLineFromCursorRight
-    putStr rhs
-    moveCursorLeft (length rhs + 1)
-    hFlush stdout
-    return q{inputBuffer=(init lhs, last lhs : rhs)}
-
-execCommand MoveCursorRight q@State{inputBuffer=(_,[])} =
-  cannotExecuteCommand q
-
-execCommand MoveCursorRight q@State{inputBuffer=(lhs,rhs)} = do
-    moveCursorRight 1
-    hFlush stdout
-    return q{inputBuffer=(lhs ++ [head rhs], tail rhs)}
-
-execCommand (InsertChar c) q@State{inputBuffer=(lhs,rhs)} = do
-    putChar c
-    -- TODO rhs
-    hFlush stdout
-    return q{inputBuffer=(lhs ++ [c], rhs)}
-
---execCommand InsertNextCharVerbatim input = do
---    return input { keymap = verbatimKeymap }
-
-
-execCommand ExecuteInputBuffer q@State{inputBuffer=(lhs,rhs)} = do
-    clearLine
-    putStrLn $ "input: <\x1b[32;1m" ++ lhs ++ rhs ++ "\x1b[m>"
-    putStr (promptString q)
-    hFlush stdout
-    return q{inputBuffer=("","")}
-
-execCommand KillLastChar q@State{inputBuffer=([],_)} =
-  cannotExecuteCommand q
-
-execCommand KillLastChar q@State{inputBuffer=(lhs,rhs)} = do
-    moveCursorLeft 1
-    clearLineFromCursorRight
-    putStr rhs
-    moveCursorLeft (length rhs)
-    hFlush stdout
-    return q{inputBuffer=(init lhs, rhs)}
-
-execCommand KillLastWord q@State{inputBuffer=([],_)} =
-  cannotExecuteCommand q
-
-execCommand KillLastWord q@State{inputBuffer=(lhs,rhs)} = do
-    let lhs' =
-          dropWhileEnd (not . isSpace) $
-          dropWhileEnd isSpace lhs
-        killedCharCount = length lhs - length lhs'
-    moveCursorLeft killedCharCount
-    clearLineFromCursorRight
-    putStr rhs
-    moveCursorLeft (length rhs)
-    hFlush stdout
-    return q{inputBuffer=(lhs', rhs)}
-
-execCommand (AlertBadInput s) q@State{inputBuffer=(lhs,rhs)} = do
-    clearLine
-    putStrLn $ "unhandled input: <" ++ (concat $ map reform s) ++ ">"
-    putStr $ (promptString q) ++ lhs ++ rhs
-    moveCursorLeft (length rhs)
-    hFlush stdout
-    return q
-  where
-    reform c =
-      if isPrint c
-        then "\x1b[31m" ++ [c] ++ "\x1b[m"
-        else
-          "\x1b[1;31m" ++ (
-            case ord c of
-              27 -> "^["
-              _ -> "\\" ++ show (ord c)
-          ) ++ "\x1b[m"
-
-
-clearLine =
-  putStr "\x1b[2K" >>
-  moveCursorLeft 80
-
-
-
-cannotExecuteCommand input = do
-  ringBell
-  hFlush stdout
-  return input
-
-
-
-ringBell = putStr "\x07" -- BEL '\a'
-
-
-moveCursorLeft 0 = return ()
-moveCursorLeft i = putStr $ "\x1b[" ++ show i ++ "D"
-
-moveCursorRight 0 = return ()
-moveCursorRight i = putStr $ "\x1b[" ++ show i ++ "C"
-
-clearLineFromCursorRight = putStr "\x1b[0K"
diff --git a/defaultGetCommand.hs b/defaultGetCommand.hs
deleted file mode 100644
index b82f2ce..0000000
--- a/defaultGetCommand.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-
-
-
-
-defaultGetCommand :: IO Command
-defaultGetCommand = do
-    c1 <- getChar
-    case c1 of
-      '\x1b' -> do
-        c2 <- getChar
-        case c2 of
-          '[' -> do
-            c3 <- getChar
-            case c3 of
-              'C' -> return MoveCursorRight
-              'D' -> return MoveCursorLeft
-              '3' -> do
-                c4 <- getChar
-                case c4 of
-                  '~' -> return KillNextChar
-                  _ -> return $ AlertBadInput (c1:c2:c3:c4:[])
-              _ -> return $ AlertBadInput (c1:c2:c3:[])
-          _ -> return $ AlertBadInput (c1:c2:[])
-      _ ->
-        if isPrint c1
-          then return $ InsertChar c1
-          else
-            case ord c1 of
-              22 -> return InsertNextCharVerbatim
-              23 -> return KillLastWord
-              10 -> return ExecuteInputBuffer
-              127 -> return KillLastChar
-              _ -> return $ AlertBadInput (c1:[])