1 files changed, 0 insertions, 206 deletions
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"