diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,23 @@
+Copyright 2007, Judah Jacobson.
+All Rights Reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistribution of source code must retain the above copyright notice,
+this list of conditions and the following disclamer.
+
+- Redistribution in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclamer in the documentation
+and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,31 @@
+#!/usr/local/bin/runhaskell
+
+\begin{code}
+import Distribution.Simple
+import Distribution.Verbosity
+import Distribution.Simple.LocalBuildInfo
+import Distribution.PackageDescription
+import Distribution.Simple.GHC as GHC
+import Distribution.Simple.PreProcess
+
+main = defaultMainWithHooks simpleUserHooks {runTests = buildTestProg}
+
+buildTestProg :: [String] -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
+buildTestProg _ _ pkgDescr lbi = do
+    let newPkg = withTest pkgDescr
+    preprocessSources newPkg lbi False normal [("hsc",ppHsc2hs)]
+    GHC.build (withTest pkgDescr) lbi normal
+
+withTest :: PackageDescription -> PackageDescription
+withTest pkg@PackageDescription {library = Just lib} 
+                = pkg {executables = [testProg],
+                        library = Nothing}
+    where
+        testProg = Executable {exeName = "Test",
+                                modulePath = "examples/Test.hs",
+                                buildInfo = alterBuildInfo (libBuildInfo lib)}
+
+alterBuildInfo :: BuildInfo -> BuildInfo
+alterBuildInfo bi = bi {options = (GHC,["-threaded"]) : options bi}
+
+\end{code}
diff --git a/System/Console/Haskeline.hs b/System/Console/Haskeline.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline.hs
@@ -0,0 +1,228 @@
+module System.Console.Haskeline(
+                    -- * Main functions
+                    --
+                    -- $maindoc
+                    InputT,
+                    runInputT,
+                    runInputTWithPrefs,
+                    getInputLine,
+                    outputStr,
+                    outputStrLn,
+                    -- * Settings
+                    Settings(..),
+                    defaultSettings,
+                    setComplete,
+                    -- * Ctrl-C handling
+                    Interrupt(..),
+                    handleInterrupt,
+                    module System.Console.Haskeline.Completion,
+                    module System.Console.Haskeline.Prefs,
+                    module System.Console.Haskeline.MonadException)
+                     where
+
+import System.Console.Haskeline.LineState
+import System.Console.Haskeline.Command
+import System.Console.Haskeline.Command.History
+import System.Console.Haskeline.Vi
+import System.Console.Haskeline.Emacs
+import System.Console.Haskeline.Prefs
+import System.Console.Haskeline.Monads
+import System.Console.Haskeline.MonadException
+import System.Console.Haskeline.InputT
+import System.Console.Haskeline.Completion
+import System.Console.Haskeline.Term
+
+import System.IO
+import Data.Char (isSpace)
+import Control.Monad
+import qualified Control.Exception as Exception
+import Data.Dynamic
+
+
+
+{- $maindoc
+
+
+An example use of this library for a simple read-eval-print loop is the
+following.
+
+> import System.Console.Haskeline
+> import Control.Monad.Trans
+> 
+> main :: IO ()
+> main = runInputT defaultSettings loop
+>    where 
+>        loop :: InputT IO ()
+>        loop = do
+>            minput <- getInputLine "% "
+>            case minput of
+>                Nothing -> return ()
+>                Just "quit" -> return ()
+>                Just input -> do outputStrLn $ "Input was: " ++ input
+>                                 loop
+
+-}
+
+
+-- | A useful default.  In particular:
+--
+-- @
+-- defaultSettings = Settings {
+--           complete = completeFilename,
+--           historyFile = Nothing,
+--           handleSigINT = False
+--           }
+-- @
+defaultSettings :: MonadIO m => Settings m
+defaultSettings = Settings {complete = completeFilename,
+                        historyFile = Nothing,
+                        handleSigINT = False}
+
+-- NOTE: If we set stdout to NoBuffering, there can be a flicker effect when many
+-- characters are printed at once.  We'll keep it buffered here, and let the Draw
+-- monad manually flush outputs that don't print a newline.
+wrapTerminalOps:: MonadException m => m a -> m a
+wrapTerminalOps =
+    bracketSet (hGetBuffering stdin) (hSetBuffering stdin) NoBuffering
+    . bracketSet (hGetBuffering stdout) (hSetBuffering stdout) LineBuffering
+    . bracketSet (hGetEcho stdout) (hSetEcho stdout) False
+
+bracketSet :: (Eq a, MonadException m) => IO a -> (a -> IO ()) -> a -> m b -> m b
+bracketSet getState set newState f = do
+    oldState <- liftIO getState
+    if oldState == newState
+        then f
+        else finally (liftIO (set newState) >> f) (liftIO (set oldState))
+
+
+-- | Write a string to the console output.  Allows cross-platform display of
+-- Unicode characters.
+outputStr :: forall m . MonadIO m => String -> InputT m ()
+outputStr xs = do
+    run :: RunTerm (InputCmdT m) <- ask
+    liftIO $ putStrTerm run xs
+
+-- | Write a string to the console output, followed by a newline.  Allows
+-- cross-platform display of Unicode characters.
+outputStrLn :: MonadIO m => String -> InputT m ()
+outputStrLn xs = outputStr (xs++"\n")
+
+{- | Read one line of input from the user, with a rich line-editing
+user interface.  Returns 'Nothing' if the user presses Ctrl-D when the input
+text is empty.  Otherwise, it returns the input line with the final newline
+removed.  
+ 
+If 'stdin' is not connected to a terminal (for example, piped from
+another process), then this function is equivalent to 'getLine', except that
+it returns 'Nothing' if an EOF is encountered before any characters are
+read.
+
+If signal handling is enabled in the 'Settings', then 'getInputLine' will
+throw an 'Interrupt' exception when the user presses Ctrl-C.
+
+-}
+getInputLine :: forall m . MonadException m => String -- ^ The input prompt
+                            -> InputT m (Maybe String)
+getInputLine prefix = do
+    isTerm <- liftIO $ hIsTerminalDevice stdin
+    if isTerm
+        then getInputCmdLine prefix
+        else do
+            atEOF <- liftIO $ hIsEOF stdin
+            if atEOF
+                then return Nothing
+                else liftM Just $ liftIO $ hGetLine stdin
+
+getInputCmdLine :: forall m . MonadException m => String -> InputT m (Maybe String)
+getInputCmdLine prefix = do
+-- TODO: Cache the terminal, actions
+    emode <- asks (\prefs -> case editMode prefs of
+                    Vi -> viActions
+                    Emacs -> emacsCommands)
+    settings :: Settings m <- ask
+    wrapTerminalOps $ do
+        let ls = emptyIM
+        RunTerm {withGetEvent = withGetEvent', runTerm=runTerm'} <- ask
+        result <- runInputCmdT $ runTerm' $ withGetEvent' (handleSigINT settings) 
+                        $ \getEvent -> do
+                            drawLine prefix ls 
+                            repeatTillFinish getEvent prefix ls emode
+        case result of 
+            Just line | not (all isSpace line) -> addHistory line
+            _ -> return ()
+        return result
+
+repeatTillFinish :: forall m s d 
+    . (MonadTrans d, Term (d m), MonadIO m, LineState s, MonadReader Prefs m)
+            => d m Event -> String -> s -> KeyMap m s 
+            -> d m (Maybe String)
+repeatTillFinish getEvent prefix = loop
+    where 
+        -- NOTE: since the functions in this mutually recursive binding group do not have the 
+        -- same contexts, we need the -XGADTs flag (or -fglasgow-exts)
+        loop :: forall t . LineState t => t -> KeyMap m t -> d m (Maybe String)
+        loop s processor = do
+                event <- getEvent
+                case event of
+                    SigInt -> do
+                        moveToNextLine s
+                        liftIO $ Exception.evaluate (Exception.throwDyn Interrupt)
+                    WindowResize newLayout -> 
+                        withReposition newLayout (loop s processor)
+                    KeyInput k -> case lookupKM processor k of
+                        Nothing -> actBell >> loop s processor
+                        Just g -> case g s of
+                            Left r -> moveToNextLine s >> return r
+                            Right f -> do
+                                        KeyAction effect next <- lift f
+                                        drawEffect prefix s effect
+                                        loop (effectState effect) next
+
+{-- 
+Note why it is necessary to integrate ctrl-c handling with this module:
+if the user is in the middle of a few wrapped lines, we want to clean up
+by moving the cursor to the start of the following line.
+--}
+
+data Interrupt = Interrupt
+                deriving (Show,Typeable,Eq)
+
+-- | Catch and handle an exception of type 'Interrupt'.
+handleInterrupt :: MonadException m => m a 
+                        -- ^ Handler to run if Ctrl-C is pressed
+                     -> m a -- ^ Computation to run
+                     -> m a
+handleInterrupt f = handle $ \e -> case Exception.dynExceptions e of
+                    Just dyn | Just Interrupt <- fromDynamic dyn -> f
+                    _ -> throwIO e
+
+
+
+drawEffect :: (LineState s, LineState t, Term (d m), 
+                MonadTrans d, MonadReader Prefs m) 
+    => String -> s -> Effect t -> d m ()
+drawEffect prefix s (Redraw shouldClear t) = if shouldClear
+    then clearLayout >> drawLine prefix t
+    else clearLine prefix s >> drawLine prefix t
+drawEffect prefix s (Change t) = drawLineDiff prefix s t
+drawEffect prefix s (PrintLines ls t) = do
+    if isTemporary s
+        then clearLine prefix s
+        else moveToNextLine s
+    printLines ls
+    drawLine prefix t
+drawEffect _ _ (RingBell _) = actBell
+
+drawLine :: (LineState s, Term m) => String -> s -> m ()
+drawLine prefix s = drawLineDiff prefix Cleared s
+
+clearLine :: (LineState s, Term m) => String -> s -> m ()
+clearLine prefix s = drawLineDiff prefix s Cleared
+        
+actBell :: (Term (d m), MonadTrans d, MonadReader Prefs m) => d m ()
+actBell = do
+    style <- lift (asks bellStyle)
+    case style of
+        NoBell -> return ()
+        VisualBell -> ringBell False
+        AudibleBell -> ringBell True
diff --git a/System/Console/Haskeline/Backend.hs b/System/Console/Haskeline/Backend.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Backend.hs
@@ -0,0 +1,23 @@
+module System.Console.Haskeline.Backend where
+
+import System.Console.Haskeline.Term
+import System.Console.Haskeline.Monads
+
+#ifdef MINGW
+import System.Console.Haskeline.Backend.Win32 as Win32
+#else
+import System.Console.Haskeline.Backend.Terminfo as Terminfo
+import System.Console.Haskeline.Backend.DumbTerm as DumbTerm
+#endif
+
+myRunTerm :: (MonadException m, MonadLayout m) => IO (RunTerm m)
+
+#ifdef MINGW
+myRunTerm = return win32Term
+#else
+myRunTerm = do
+    mRun <- runTerminfoDraw
+    case mRun of 
+        Nothing -> return runDumbTerm
+        Just run -> return run
+#endif
diff --git a/System/Console/Haskeline/Backend/DumbTerm.hs b/System/Console/Haskeline/Backend/DumbTerm.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Backend/DumbTerm.hs
@@ -0,0 +1,126 @@
+module System.Console.Haskeline.Backend.DumbTerm where
+
+import System.Console.Haskeline.Backend.Posix
+import System.Console.Haskeline.Term
+import System.Console.Haskeline.LineState
+import System.Console.Haskeline.Monads as Monads
+import System.Console.Haskeline.Command
+
+import System.IO
+import qualified System.IO.UTF8 as UTF8
+
+-- TODO: 
+---- Make this unicode-aware, too.
+---- Put "<" and ">" at end of term if scrolls off.
+---- Have a margin at the ends
+
+data Window = Window {pos :: Int -- ^ # of visible chars to left of cursor
+                }
+
+initWindow :: Window
+initWindow = Window {pos=0}
+
+newtype DumbTerm m a = DumbTerm {unDumbTerm :: StateT Window m a}
+                deriving (Monad,MonadIO, MonadState Window)
+
+instance MonadReader Layout m => MonadReader Layout (DumbTerm m) where
+    ask = lift ask
+    local r = DumbTerm . local r . unDumbTerm
+
+instance MonadException m => MonadException (DumbTerm m) where
+    block = DumbTerm . block . unDumbTerm
+    unblock = DumbTerm . unblock . unDumbTerm
+    catch (DumbTerm f) g = DumbTerm $ Monads.catch f (unDumbTerm . g)
+
+runDumbTerm :: (MonadLayout m, MonadException m) => RunTerm m
+runDumbTerm = RunTerm {
+    getLayout = getPosixLayout,
+    withGetEvent = withPosixGetEvent Nothing,
+    runTerm = evalStateT' initWindow . unDumbTerm,
+    putStrTerm = UTF8.putStr
+    }
+    
+
+instance MonadTrans DumbTerm where
+    lift = DumbTerm . lift
+
+instance MonadLayout m => Term (DumbTerm m) where
+    withReposition _ = id
+    drawLineDiff = drawLineDiff'
+    
+    printLines = mapM_ (\s -> printText (s ++ crlf))
+    moveToNextLine = \_ -> printText crlf
+    clearLayout = clearLayoutD
+    ringBell True = printText "\a"
+    ringBell False = return ()
+      
+printText :: MonadIO m => String -> m ()
+printText str = liftIO $ UTF8.putStr str >> hFlush stdout
+
+-- Things we can assume a dumb terminal knows how to do
+cr,crlf :: String
+crlf = "\r\n"
+cr = "\r"
+
+backs,spaces :: Int -> String
+backs n = replicate n '\b'
+spaces n = replicate n ' '
+
+
+clearLayoutD :: MonadLayout m => DumbTerm m ()
+clearLayoutD = do
+    w <- maxWidth
+    printText (cr ++ spaces w ++ cr)
+
+-- Don't want to print in the last column, as that may wrap to the next line.
+maxWidth :: MonadLayout m => DumbTerm m Int
+maxWidth = asks (\lay -> width lay - 1)
+
+drawLineDiff' :: (LineState s, LineState t, MonadLayout m)
+                => String -> s -> t -> DumbTerm m ()
+drawLineDiff' prefix s1 s2 = do
+    let xs1 = beforeCursor prefix s1
+    let ys1 = afterCursor s1
+    let xs2 = beforeCursor prefix s2
+    let ys2 = afterCursor s2
+    Window {pos=p} <- get
+    w <- maxWidth
+    let (xs1',xs2') = matchInit xs1 xs2
+    let newP = p + length xs2' - length xs1'
+    let ys2' = take (w-newP) ys2
+    if length xs1' > p  || newP >= w
+        then refitLine (xs2,ys2)
+        else do -- we haven't moved outside the margins
+            put Window {pos=newP}
+            case (xs1',xs2') of
+                ([],[]) | ys1 == ys2    -> return () -- no change
+                (_,[]) | xs1' ++ ys1 == ys2 -> -- moved left
+                    printText $ backs (length xs1')
+                ([],_) | ys1 == xs2' ++ ys2 -> -- moved right
+                    printText xs2'
+                _ -> let
+                        extraLength = length xs1' + length ys1
+                                    - length xs2' - length ys2
+                     in printText $ backs (length xs1')
+                        ++ xs2' ++ ys2' ++ clearDeadText extraLength
+                        ++ backs (length ys2')
+
+refitLine :: MonadLayout m => (String,String) -> DumbTerm m ()
+refitLine (xs,ys) = do
+    w <- maxWidth
+    let xs' = dropFrames w xs
+    let p = length xs'    
+    put Window {pos=p}
+    let ys' = take (w - p) ys
+    let k = length ys'
+    printText $ cr ++ xs' ++ ys'
+        ++ spaces (w-k-p)
+        ++ backs (w-p)
+  where
+    dropFrames w zs = case splitAt w zs of
+                        (_,"") -> zs
+                        (_,zs') -> dropFrames w zs'
+    
+clearDeadText :: Int -> String
+clearDeadText n | n > 0 = spaces n ++ backs n
+                | otherwise = ""
diff --git a/System/Console/Haskeline/Backend/Posix.hsc b/System/Console/Haskeline/Backend/Posix.hsc
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Backend/Posix.hsc
@@ -0,0 +1,181 @@
+module System.Console.Haskeline.Backend.Posix (
+                        withPosixGetEvent,
+                        getPosixLayout,
+                        mapLines
+                 ) where
+
+import Foreign
+import Foreign.C.Types
+import qualified Data.Map as Map
+import System.Console.Terminfo
+import System.Posix (stdOutput)
+import System.Posix.Terminal
+import Control.Monad
+import Control.Concurrent
+import Control.Concurrent.STM
+import Data.Maybe
+import System.Posix.Signals.Exts
+import System.Posix.IO(stdInput)
+import Data.List
+import System.IO
+import qualified Data.ByteString as B
+import qualified Data.ByteString.UTF8 as UTF8
+
+import System.Console.Haskeline.Monads
+import System.Console.Haskeline.Command
+import System.Console.Haskeline.Term
+
+#include <sys/ioctl.h>
+
+-------------------
+-- Window size
+
+foreign import ccall ioctl :: CInt -> CULong -> Ptr a -> IO ()
+
+getPosixLayout :: IO Layout
+getPosixLayout = allocaBytes (#size struct winsize) $ \ws -> do
+                            ioctl 1 (#const TIOCGWINSZ) ws
+                            rows :: CUShort <- (#peek struct winsize,ws_row) ws
+                            cols :: CUShort <- (#peek struct winsize,ws_col) ws
+                            return Layout {height=fromEnum rows,width=fromEnum cols}
+
+-- todo: make sure >=2
+-- TODO: other ways of getting it:
+-- env vars ROWS/COLUMNS
+-- terminfo capabilities
+
+
+--------------------
+-- Key sequences
+
+-- TODO: What if term not found?
+getKeySequences :: Maybe Terminal -> IO (TreeMap Char Key)
+getKeySequences term = do
+    sttys <- sttyKeys
+    let tinfos = fromMaybe ansiKeys (term >>= terminfoKeys)
+    -- note ++ acts as a union; so the below favors sttys over tinfos
+    return $ listToTree $ tinfos ++ sttys
+
+
+ansiKeys :: [(String, Key)]
+ansiKeys = [("\ESC[D",  KeyLeft)
+            ,("\ESC[C",  KeyRight)
+            ,("\ESC[A",  KeyUp)
+            ,("\ESC[B",  KeyDown)
+            ,("\b",      Backspace)]
+
+terminfoKeys :: Terminal -> Maybe [(String,Key)]
+terminfoKeys term = getCapability term $ mapM getSequence keyCapabilities
+    where 
+        getSequence (cap,x) = do 
+                            keys <- cap
+                            return (keys,x)
+        keyCapabilities = 
+                [(keyLeft,KeyLeft),
+                (keyRight,KeyRight),
+                (keyUp,KeyUp),
+                (keyDown,KeyDown),
+                (keyBackspace,Backspace),
+                (keyDeleteChar,DeleteForward)]
+
+sttyKeys :: IO [(String, Key)]
+sttyKeys = do
+    attrs <- getTerminalAttributes stdOutput
+    let getStty (k,c) = do {str <- controlChar attrs k; return ([str],c)}
+    return $ catMaybes $ map getStty [(Erase,Backspace),(Kill,KillLine)]
+                        
+newtype TreeMap a b = TreeMap (Map.Map a (Maybe b, TreeMap a b))
+                        deriving Show
+
+emptyTreeMap :: TreeMap a b
+emptyTreeMap = TreeMap Map.empty
+
+insertIntoTree :: Ord a => ([a], b) -> TreeMap a b -> TreeMap a b
+insertIntoTree ([],_) _ = error "Can't insert empty list into a treemap!"
+insertIntoTree ((c:cs),k) (TreeMap m) = TreeMap (Map.alter f c m)
+    where
+        alterSubtree = insertIntoTree (cs,k)
+        f Nothing = Just $ if null cs
+                            then (Just k, emptyTreeMap)
+                            else (Nothing, alterSubtree emptyTreeMap)
+        f (Just (y,t)) = Just $ if null cs
+                                    then (Just k, t)
+                                    else (y, alterSubtree t)
+
+listToTree :: Ord a => [([a],b)] -> TreeMap a b
+listToTree = foldl' (flip insertIntoTree) emptyTreeMap
+
+-- for debugging '
+mapLines :: (Show a, Show b) => TreeMap a b -> [String]
+mapLines (TreeMap m) = let
+    m2 = Map.map (\(k,t) -> show k : mapLines t) m
+    in concatMap (\(k,ls) -> show k : map (' ':) ls) $ Map.toList m2
+
+lexKeys :: TreeMap Char Key -> [Char] -> [Key]
+lexKeys _ [] = []
+lexKeys baseMap cs
+    | Just (k,ds) <- lookupChars baseMap cs
+            = k : lexKeys baseMap ds
+lexKeys baseMap ('\ESC':c:cs) = KeyMeta c : lexKeys baseMap cs
+lexKeys baseMap (c:cs) = KeyChar c : lexKeys baseMap cs
+
+lookupChars :: TreeMap Char Key -> [Char] -> Maybe (Key,[Char])
+lookupChars _ [] = Nothing
+lookupChars (TreeMap tm) (c:cs) = case Map.lookup c tm of
+    Nothing -> Nothing
+    Just (Nothing,t) -> lookupChars t cs
+    Just (Just k, t@(TreeMap tm2))
+                | not (null cs) && not (Map.null tm2) -- ?? lookup d tm2?
+                    -> lookupChars t cs
+                | otherwise -> Just (k, cs)
+
+-----------------------------
+
+withPosixGetEvent :: MonadException m => Maybe Terminal -> Bool -> (m Event -> m a) -> m a
+withPosixGetEvent term useSigINT f = do
+    baseMap <- liftIO (getKeySequences term)
+    eventChan <- liftIO $ newTChanIO
+    wrapKeypad term 
+        $ withWindowHandler eventChan
+        $ withSigIntHandler useSigINT eventChan
+        $ f $ liftIO $ getEvent baseMap eventChan
+
+-- If the keypad on/off capabilities are defined, wrap the computation with them.
+wrapKeypad :: MonadException m => Maybe Terminal -> m a -> m a
+wrapKeypad Nothing f = f
+wrapKeypad (Just term) f = (maybeOutput keypadOn >> f) 
+                            `finally` maybeOutput keypadOn
+  where
+    maybeOutput cap = liftIO $ runTermOutput term $
+                            fromMaybe mempty (getCapability term cap)
+
+withWindowHandler :: MonadException m => TChan Event -> m a -> m a
+withWindowHandler eventChan = withHandler windowChange $ Catch $
+    getPosixLayout >>= atomically . writeTChan eventChan . WindowResize
+
+withSigIntHandler :: MonadException m => Bool -> TChan Event -> m a -> m a
+withSigIntHandler False _ = id
+withSigIntHandler True eventChan = withHandler keyboardSignal $ CatchOnce $
+            atomically $ writeTChan eventChan SigInt
+
+withHandler :: MonadException m => Signal -> Handler -> m a -> m a
+withHandler signal handler f = do
+    old_handler <- liftIO $ installHandler signal handler Nothing
+    f `finally` liftIO (installHandler signal old_handler Nothing)
+
+getEvent :: TreeMap Char Key -> TChan Event -> IO Event
+getEvent baseMap = keyEventLoop readKeyEvents
+  where
+    bufferSize = 100
+    readKeyEvents eventChan = do
+        -- Read at least one character of input, and more if available.
+        -- In particular, the characters making up a control sequence will all
+        -- be available at once, so we can process them together with lexKeys.
+        threadWaitRead stdInput
+        bs <- B.hGetNonBlocking stdin bufferSize
+        let cs = UTF8.toString bs
+        let ks = map KeyInput $ lexKeys baseMap cs
+        if null ks
+            then readKeyEvents eventChan
+            else atomically $ mapM_ (writeTChan eventChan) ks
+
diff --git a/System/Console/Haskeline/Backend/Terminfo.hs b/System/Console/Haskeline/Backend/Terminfo.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Backend/Terminfo.hs
@@ -0,0 +1,266 @@
+module System.Console.Haskeline.Backend.Terminfo(
+                            Draw(),
+                            runTerminfoDraw
+                            )
+                             where
+
+import System.Console.Terminfo
+import Control.Monad
+import Data.List(intersperse)
+import System.IO (hFlush,stdout)
+import qualified Control.Exception as Exception
+
+import System.Console.Haskeline.Monads as Monads
+import System.Console.Haskeline.LineState
+import System.Console.Haskeline.Command
+import System.Console.Haskeline.Term
+import System.Console.Haskeline.Backend.Posix
+import qualified Codec.Binary.UTF8.String as UTF8
+
+-- | Keep track of all of the output capabilities we can use.
+-- 
+-- We'll be frequently using the (automatic) 'Monoid' instance for 
+-- @Actions -> TermOutput@.
+data Actions = Actions {leftA, rightA, upA :: Int -> TermOutput,
+                        clearToLineEnd :: TermOutput,
+                        nl, cr :: TermOutput,
+                        bellAudible,bellVisual :: TermOutput,
+                        clearAll :: LinesAffected -> TermOutput,
+                        wrapLine :: TermOutput}
+
+getActions :: Capability Actions
+getActions = do
+    leftA' <- moveLeft
+    rightA' <- moveRight
+    upA' <- moveUp
+    clearToLineEnd' <- clearEOL
+    clearAll' <- clearScreen
+    nl' <- newline
+    cr' <- carriageReturn
+    -- Don't require the bell capabilities
+    bellAudible' <- bell `mplus` return mempty
+    bellVisual' <- visualBell `mplus` return mempty
+    wrapLine' <- getWrapLine nl' (leftA' 1)
+    return Actions{leftA=leftA',rightA=rightA',upA=upA',
+                clearToLineEnd=clearToLineEnd',nl=nl',cr=cr',
+                bellAudible=bellAudible', bellVisual=bellVisual',
+                clearAll=clearAll',
+                 wrapLine=wrapLine'}
+
+text :: String -> Actions -> TermOutput
+text str _ = termText (UTF8.encodeString str)
+
+getWrapLine :: TermOutput -> TermOutput -> Capability TermOutput
+getWrapLine nl' left1 = (autoRightMargin >>= guard >> withAutoMargin)
+                    `mplus` return nl'
+  where 
+    -- If the wraparound glitch is in effect, force a wrap by printing a space.
+    -- Otherwise, it'll wrap automatically.
+    withAutoMargin = (do
+                        wraparoundGlitch >>= guard
+                        return (termText " " <#> left1)
+                     )`mplus` return mempty
+    
+left,right,up :: Int -> Actions -> TermOutput
+left = flip leftA
+right = flip rightA
+up = flip upA
+
+
+--------
+
+
+mreplicate :: Monoid m => Int -> m -> m
+mreplicate n m
+    | n <= 0    = mempty
+    | otherwise = m `mappend` mreplicate (n-1) m
+
+-- denote in modular arithmetic;
+-- in particular, 0 <= termCol < width
+data TermPos = TermPos {termRow,termCol :: Int}
+    deriving Show
+
+initTermPos :: TermPos
+initTermPos = TermPos {termRow = 0, termCol = 0}
+
+
+--------------
+
+newtype Draw m a = Draw {unDraw :: ReaderT Actions (ReaderT Terminal (StateT TermPos m)) a}
+    deriving (Monad,MonadIO,MonadReader Actions,MonadReader Terminal,
+        MonadState TermPos)
+
+instance MonadReader Layout m => MonadReader Layout (Draw m) where
+    ask = lift ask
+    local r = Draw . local r . unDraw
+
+instance MonadException m => MonadException (Draw m) where
+    block = Draw . block . unDraw
+    unblock = Draw . unblock . unDraw
+    catch (Draw f) g = Draw $ Monads.catch f (unDraw . g)
+
+
+instance MonadTrans Draw where
+    lift = Draw . lift . lift . lift
+    
+runTerminfoDraw :: (MonadException m, MonadLayout m) => IO (Maybe (RunTerm m))
+runTerminfoDraw = do
+    mterm <- Exception.try setupTermFromEnv
+    case mterm of
+        Left _ -> return Nothing
+        Right term -> case getCapability term getActions of
+            Nothing -> return Nothing
+            Just actions -> return $ Just $ RunTerm {
+                getLayout = getPosixLayout,
+                withGetEvent = withPosixGetEvent (Just term),
+                putStrTerm = putStr . UTF8.encodeString,
+                runTerm = \(Draw f) -> evalStateT' initTermPos 
+                                    $ runReaderT' term
+                                    $ runReaderT' actions f
+                }
+    
+output :: MonadIO m => (Actions -> TermOutput) -> Draw m ()
+output f = do
+    toutput <- asks f
+    term <- ask
+    liftIO $ runTermOutput term toutput
+    liftIO $ hFlush stdout
+
+
+
+changeRight, changeLeft :: MonadLayout m => Int -> Draw m ()
+changeRight n = do
+    w <- asks width
+    TermPos {termRow=r,termCol=c} <- get
+    if c+n < w  
+        then do
+                put TermPos {termRow=r,termCol=c+n}
+                output (right n)
+        else do
+              let m = c+n
+              let linesDown = m `div` w
+              let newCol = m `rem` w
+              put TermPos {termRow=r+linesDown, termCol=newCol}
+              output $ cr <#> mreplicate linesDown nl <#> right newCol
+                      
+changeLeft n = do
+    w <- asks width
+    TermPos {termRow=r,termCol=c} <- get
+    if c - n >= 0 
+        then do 
+                put TermPos {termRow = r,termCol = c-n}
+                output (left n)
+        else do      
+                let m = n - c
+                let linesUp = 1 + ((m-1) `div` w)
+                let newCol = (-m) `mod` w -- mod returns positive #
+                put TermPos {termRow = r - linesUp, termCol=newCol}
+                output $ cr <#> up linesUp <#> right newCol
+                
+-- TODO: I think if we wrap this all up in one call to output, it'll be faster...
+printText :: MonadLayout m => String -> Draw m ()
+printText "" = return ()
+printText xs = fillLine xs >>= printText
+
+-- Draws as much of the string as possible in the line, and returns the rest.
+-- If we fill up the line completely, wrap to the next row.
+fillLine :: MonadLayout m => String -> Draw m String
+fillLine str = do
+    w <- asks width
+    TermPos {termRow=r,termCol=c} <- get
+    let roomLeft = w - c
+    if length str < roomLeft
+        then do
+                output (text str)
+                put TermPos{termRow=r, termCol=c+length str}
+                return ""
+        else do
+                let (thisLine,rest) = splitAt roomLeft str
+                output (text thisLine <#> wrapLine)
+                put TermPos {termRow=r+1,termCol=0}
+                return rest
+
+drawLineDiffT :: (LineState s, LineState t, MonadLayout m) 
+                        => String -> s -> t -> Draw m ()
+drawLineDiffT prefix s1 s2 = let 
+    xs1 = beforeCursor prefix s1
+    ys1 = afterCursor s1
+    xs2 = beforeCursor prefix s2
+    ys2 = afterCursor s2
+    in case matchInit xs1 xs2 of
+        ([],[])     | ys1 == ys2            -> return ()
+        (xs1',[])   | xs1' ++ ys1 == ys2    -> changeLeft (length xs1')
+        ([],xs2')   | ys1 == xs2' ++ ys2    -> changeRight (length xs2')
+        (xs1',xs2')                         -> do
+            changeLeft (length xs1')
+            printText (xs2' ++ ys2)
+            let m = length xs1' + length ys1 - (length xs2' + length ys2)
+            clearDeadText m
+            changeLeft (length ys2)
+
+linesLeft :: Layout -> TermPos -> Int -> Int
+linesLeft Layout {width=w} TermPos {termCol = c} n
+    | c + n < w = 1
+    | otherwise = 1 + div (c+n) w
+
+lsLinesLeft :: LineState s => Layout -> TermPos -> s -> Int
+lsLinesLeft layout pos s = linesLeft layout pos (lengthToEnd s)
+
+clearDeadText :: MonadLayout m => Int -> Draw m ()
+clearDeadText n
+    | n <= 0    = return ()
+    | otherwise = do
+        layout <- ask
+        pos <- get
+        let numLinesToClear = linesLeft layout pos n
+        output clearToLineEnd
+        when (numLinesToClear > 1) $ output $ mconcat [
+                    mreplicate (numLinesToClear - 1) 
+                            $ nl <#> clearToLineEnd
+                    , up (numLinesToClear - 1)
+                    , right (termCol pos)]
+
+clearLayoutT :: MonadLayout m => Draw m ()
+clearLayoutT = do
+    h <- asks height
+    output (flip clearAll h)
+    put initTermPos
+
+moveToNextLineT :: (LineState s, MonadLayout m) => s -> Draw m ()
+moveToNextLineT s = do
+    pos <- get
+    layout <- ask
+    output $ mreplicate (lsLinesLeft layout pos s) nl
+    put initTermPos
+
+
+posFromLength :: Layout -> Int -> TermPos
+posFromLength Layout {width = w} n = TermPos 
+                            {termRow = n `div` w, termCol = n `mod` w}
+
+posToLength :: Layout -> TermPos -> Int
+posToLength Layout {width = w} TermPos {termRow = r, termCol = c}
+    = r * w + c
+
+reposition :: Layout -> Layout -> TermPos -> TermPos
+reposition oldLayout newLayout oldPos = posFromLength newLayout $ 
+                                            posToLength oldLayout oldPos
+
+withRepositionT :: MonadReader Layout m => Layout -> Draw m a -> Draw m a
+withRepositionT newLayout f = do
+    oldPos <- get
+    oldLayout <- ask
+    let newPos = reposition oldLayout newLayout oldPos
+    put newPos
+    local newLayout f
+
+instance MonadLayout m => Term (Draw m) where
+    drawLineDiff = drawLineDiffT
+    withReposition = withRepositionT
+    
+    printLines [] = return ()
+    printLines ls = output $ mconcat $ intersperse nl (map text ls) ++ [nl] 
+    clearLayout = clearLayoutT
+    moveToNextLine = moveToNextLineT
+    ringBell True = output bellAudible
+    ringBell False = output bellVisual
diff --git a/System/Console/Haskeline/Backend/Win32.hsc b/System/Console/Haskeline/Backend/Win32.hsc
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Backend/Win32.hsc
@@ -0,0 +1,284 @@
+module System.Console.Haskeline.Backend.Win32(
+                Draw(),
+                win32Term
+                )where
+
+
+import System.IO
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array
+import Foreign.C.Types
+import Foreign.Marshal.Utils
+import System.Win32.Types
+import Graphics.Win32.Misc(getStdHandle, sTD_INPUT_HANDLE, sTD_OUTPUT_HANDLE)
+import Data.List(intercalate)
+import Control.Concurrent
+import Control.Concurrent.STM
+
+import System.Console.Haskeline.Command
+import System.Console.Haskeline.Monads
+import System.Console.Haskeline.LineState
+import System.Console.Haskeline.Term
+
+#include "win_console.h"
+
+foreign import stdcall "windows.h ReadConsoleInputW" c_ReadConsoleInput
+    :: HANDLE -> Ptr () -> DWORD -> Ptr DWORD -> IO Bool
+    
+foreign import stdcall "windows.h WaitForSingleObject" c_WaitForSingleObject
+    :: HANDLE -> DWORD -> IO DWORD
+
+getEvent :: HANDLE -> TChan Event -> IO Event
+getEvent h = keyEventLoop readKeyEvents
+  where
+    waitTime = 200 -- milliseconds
+    readKeyEvents eventChan = do
+        yield -- since the foreign call to WaitForSingleObject blocks the killThread
+        ret <- c_WaitForSingleObject h waitTime
+        if ret /= (#const WAIT_OBJECT_0)
+            then readKeyEvents eventChan
+            else do
+                e <- readEvent h
+                case eventToKey e of
+	            Just k -> atomically $ writeTChan eventChan (KeyInput k)
+    	            Nothing -> readKeyEvents eventChan
+
+            
+eventToKey :: InputEvent -> Maybe Key
+eventToKey KeyEvent {keyDown = True, unicodeChar = c, virtualKeyCode = vc}
+    | c /= '\NUL' = Just (KeyChar c)
+    | otherwise = keyFromCode vc -- special character; see below.
+eventToKey _ = Nothing
+
+keyFromCode :: WORD -> Maybe Key
+keyFromCode (#const VK_BACK) = Just Backspace
+keyFromCode (#const VK_LEFT) = Just KeyLeft
+keyFromCode (#const VK_RIGHT) = Just KeyRight
+keyFromCode (#const VK_UP) = Just KeyUp
+keyFromCode (#const VK_DOWN) = Just KeyDown
+keyFromCode (#const VK_DELETE) = Just DeleteForward
+-- TODO: KeyMeta (option-x), KillLine
+keyFromCode _ = Nothing
+    
+data InputEvent = KeyEvent {keyDown :: BOOL,
+                          repeatCount :: WORD,
+                          virtualKeyCode :: WORD,
+                          virtualScanCode :: WORD,
+                          unicodeChar :: Char,
+                          controlKeyState :: DWORD}
+            -- TODO: WINDOW_BUFFER_SIZE_RECORD
+            -- I cant figure out how the user generates them.
+           | OtherEvent
+                        deriving Show
+
+readEvent :: HANDLE -> IO InputEvent
+readEvent h = allocaBytes (#size INPUT_RECORD) $ \pRecord -> 
+                        alloca $ \numEventsPtr -> do
+    failIfFalse_ "ReadConsoleInput" 
+        $ c_ReadConsoleInput h pRecord 1 numEventsPtr
+    -- useful? numEvents <- peek numEventsPtr
+    eventType :: WORD <- (#peek INPUT_RECORD, EventType) pRecord
+    let eventPtr = (#ptr INPUT_RECORD, Event) pRecord
+    case eventType of
+        (#const KEY_EVENT) -> getKeyEvent eventPtr
+        _ -> return OtherEvent
+        
+getKeyEvent :: Ptr () -> IO InputEvent
+getKeyEvent p = do
+    kDown' <- (#peek KEY_EVENT_RECORD, bKeyDown) p
+    repeat' <- (#peek KEY_EVENT_RECORD, wRepeatCount) p
+    keyCode <- (#peek KEY_EVENT_RECORD, wVirtualKeyCode) p
+    scanCode <- (#peek KEY_EVENT_RECORD, wVirtualScanCode) p
+    char :: CWchar <- (#peek KEY_EVENT_RECORD, uChar) p
+    state <- (#peek KEY_EVENT_RECORD, dwControlKeyState) p
+    return KeyEvent {keyDown = kDown',
+                            repeatCount = repeat',
+                            virtualKeyCode = keyCode,
+                            virtualScanCode = scanCode,
+                            unicodeChar = toEnum (fromEnum char),
+                            controlKeyState = state}
+
+data Coord = Coord {coordX, coordY :: Int}
+                deriving Show
+                
+instance Storable Coord where
+    sizeOf _ = (#size COORD)
+    alignment = undefined -- ???
+    peek p = do
+        x :: CShort <- (#peek COORD, X) p
+        y :: CShort <- (#peek COORD, Y) p
+        return Coord {coordX = fromEnum x, coordY = fromEnum y}
+    poke p c = do
+        (#poke COORD, X) p (toEnum (coordX c) :: CShort)
+        (#poke COORD, Y) p (toEnum (coordY c) :: CShort)
+                
+                            
+foreign import ccall "SetPosition"
+    c_SetPosition :: HANDLE -> Ptr Coord -> IO Bool
+    
+setPosition :: HANDLE -> Coord -> IO ()
+setPosition h c = with c $ failIfFalse_ "SetConsoleCursorPosition" 
+                    . c_SetPosition h
+                    
+foreign import stdcall "windows.h GetConsoleScreenBufferInfo"
+    c_GetScreenBufferInfo :: HANDLE -> Ptr () -> IO Bool
+    
+getPosition :: HANDLE -> IO Coord
+getPosition = withScreenBufferInfo $ 
+    (#peek CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition)
+
+withScreenBufferInfo :: (Ptr () -> IO a) -> HANDLE -> IO a
+withScreenBufferInfo f h = allocaBytes (#size CONSOLE_SCREEN_BUFFER_INFO)
+                                $ \infoPtr -> do
+        failIfFalse_ "GetConsoleScreenBufferInfo"
+            $ c_GetScreenBufferInfo h infoPtr
+        f infoPtr
+
+
+getDisplayWindow :: HANDLE -> IO (Coord,Coord)
+getDisplayWindow = withScreenBufferInfo $ \p -> do
+    let windowPtr = (#ptr CONSOLE_SCREEN_BUFFER_INFO, srWindow) p
+    left <- (#peek SMALL_RECT, Left) windowPtr
+    top <- (#peek SMALL_RECT, Top) windowPtr
+    right <- (#peek SMALL_RECT, Right) windowPtr
+    bottom <- (#peek SMALL_RECT, Bottom) windowPtr
+    return (Coord (cvt left) (cvt top), Coord (cvt right) (cvt bottom))
+  where
+    cvt :: CShort -> Int
+    cvt = fromEnum
+
+foreign import stdcall "windows.h WriteConsoleW" c_WriteConsoleW
+    :: HANDLE -> Ptr TCHAR -> DWORD -> Ptr DWORD -> Ptr () -> IO Bool
+
+writeConsole :: HANDLE -> String -> IO ()
+writeConsole h str = withArray tstr $ \t_arr -> alloca $ \numWritten -> do
+    failIfFalse_ "WriteConsole" 
+        $ c_WriteConsoleW h t_arr (toEnum $ length str) numWritten nullPtr
+  where
+    tstr = map (toEnum . fromEnum) str
+
+----------------------------
+-- Drawing
+
+newtype Draw m a = Draw {runDraw :: m a}
+    deriving (Monad,MonadIO,MonadException)
+
+instance MonadTrans Draw where
+    lift = Draw
+
+instance MonadReader Layout m => MonadReader Layout (Draw m) where
+    ask = lift ask
+    local r = Draw . local r . runDraw
+
+getInputHandle, getOutputHandle :: MonadIO m => m HANDLE
+getInputHandle = liftIO $ getStdHandle sTD_INPUT_HANDLE
+getOutputHandle = liftIO $ getStdHandle sTD_OUTPUT_HANDLE
+
+getDisplaySize :: IO Layout
+getDisplaySize = do
+    h <- getOutputHandle
+    (topLeft,bottomRight) <- getDisplayWindow h
+    return Layout {width = coordX bottomRight - coordX topLeft+1, 
+                    height = coordY bottomRight - coordY topLeft+1 }
+    
+getPos :: MonadIO m => Draw m Coord
+getPos = getOutputHandle >>= liftIO . getPosition
+    
+setPos :: MonadIO m => Coord -> Draw m ()
+setPos c = do
+    h <- getOutputHandle
+    liftIO (setPosition h c)
+
+printText :: MonadIO m => String -> m ()
+printText txt = do
+    h <- getOutputHandle
+    liftIO (writeConsole h txt)
+    
+printAfter :: MonadLayout m => String -> Draw m ()
+printAfter str = do
+    p <- getPos
+    printText str
+    setPos p
+    
+drawLineDiffWin :: (LineState s, LineState t, MonadLayout m)
+                        => String -> s -> t -> Draw m ()
+drawLineDiffWin prefix s1 s2 = let
+    xs1 = beforeCursor prefix s1
+    ys1 = afterCursor s1
+    xs2 = beforeCursor prefix s2
+    ys2 = afterCursor s2
+    in case matchInit xs1 xs2 of
+        ([],[])     | ys1 == ys2            -> return ()
+        (xs1',[])   | xs1' ++ ys1 == ys2    -> movePos $ negate $ length xs1'
+        ([],xs2')   | ys1 == xs2' ++ ys2    -> movePos $ length xs2'
+        (xs1',xs2')                         -> do
+            movePos (negate $ length xs1')
+            let m = length xs1' + length ys1 - (length xs2' + length ys2)
+            let deadText = replicate m ' '
+            printText xs2'
+            printAfter (ys2 ++ deadText)
+
+movePos :: MonadLayout m => Int -> Draw m ()
+movePos n = do
+    Coord {coordX = x, coordY = y} <- getPos
+    w <- asks width
+    let (h,x') = divMod (x+n) w
+    setPos Coord {coordX = x', coordY = y+h}
+
+crlf :: String
+crlf = "\r\n"
+
+instance MonadLayout m => Term (Draw m) where
+    drawLineDiff = drawLineDiffWin
+    withReposition _ = id -- TODO
+
+    printLines [] = return ()
+    printLines ls = printText $ intercalate crlf ls ++ crlf
+    
+    clearLayout = do
+        lay <- ask
+        setPos (Coord 0 0)
+        printText (replicate (width lay * height lay) ' ')
+        setPos (Coord 0 0)
+    
+    moveToNextLine s = do
+        movePos (lengthToEnd s)
+        printText "\r\n" -- make the console take care of creating a new line
+    
+    ringBell _ = return () -- TODO
+
+win32Term :: (MonadLayout m, MonadException m) => RunTerm m
+win32Term = RunTerm {
+    getLayout = getDisplaySize,
+    runTerm = runDraw,
+    withGetEvent = \useSigINT f -> do 
+        h <- getInputHandle
+	eventChan <- liftIO $ newTChanIO
+        withCtrlCHandler useSigINT eventChan
+		$ f $ liftIO $ getEvent h eventChan,
+    putStrTerm = printText
+    }
+
+type Handler = DWORD -> IO BOOL
+
+foreign import ccall "wrapper" wrapHandler :: Handler -> IO (FunPtr Handler)
+
+foreign import stdcall "windows.h SetConsoleCtrlHandler" c_SetConsoleCtrlHandler
+    :: FunPtr Handler -> BOOL -> IO BOOL
+
+-- sets the tv to True when ctrl-c is pressed.
+withCtrlCHandler :: MonadException m => Bool -> TChan Event -> m a -> m a
+withCtrlCHandler False _ f = f
+withCtrlCHandler True eventChan f = bracket (liftIO $ do
+                                    fp <- wrapHandler handler
+                                    c_SetConsoleCtrlHandler fp True
+                                    return fp)
+                                (\fp -> liftIO $ c_SetConsoleCtrlHandler fp False)
+                                (const f)
+  where
+    handler (#const CTRL_C_EVENT) = do
+        atomically $ writeTChan eventChan SigInt
+        return True
+    handler _ = return False
diff --git a/System/Console/Haskeline/Command.hs b/System/Console/Haskeline/Command.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Command.hs
@@ -0,0 +1,164 @@
+module System.Console.Haskeline.Command(
+                        Event(..),
+                        Key(..),
+                        controlKey,
+                        Layout(..),
+                        -- * Commands
+                        Effect(..),
+                        KeyMap(), 
+                        lookupKM,
+                        KeyAction(..),
+                        CmdAction(..),
+                        (>=>),
+                        Command(),
+                        runCommand,
+                        continue,
+                        (>|>),
+                        (>+>),
+                        acceptKey,
+                        acceptKeyM,
+                        acceptKeyOrFail,
+                        loopUntil,
+                        try,
+                        finish,
+                        failCmd,
+                        simpleCommand,
+                        charCommand,
+                        change,
+                        changeFromChar,
+                        changeWithoutKey,
+                        clearScreenCmd,
+                        (+>),
+                        choiceCmd
+                        ) where
+
+import Data.Char(isPrint)
+import Control.Monad(mplus)
+import Data.Bits
+import System.Console.Haskeline.LineState
+
+data Layout = Layout {width, height :: Int}
+                    deriving Show
+
+data Key = KeyChar Char | KeyMeta Char
+            | KeyLeft | KeyRight | KeyUp | KeyDown
+            | Backspace | DeleteForward | KillLine
+                deriving (Eq,Ord,Show)
+
+data Event = WindowResize Layout | KeyInput Key
+            | SigInt
+                deriving Show
+
+-- Easy translation of control characters; e.g., Ctrl-G or Ctrl-g or ^G
+controlKey :: Char -> Key
+controlKey '?' = KeyChar (toEnum 127)
+controlKey c = KeyChar $ toEnum $ fromEnum c .&. complement (bit 5 .|. bit 6)
+
+
+data Effect s = Change {effectState :: s} 
+              | PrintLines {linesToPrint :: [String], effectState :: s}
+              | Redraw {shouldClearScreen :: Bool, effectState :: s}
+              | RingBell {effectState :: s}
+
+newtype KeyMap m s = KeyMap {lookupKM :: Key -> Maybe 
+            (s -> Either (Maybe String) (m (KeyAction m)))}
+
+useKey :: Key -> (s -> Either (Maybe String) (m (KeyAction m))) -> KeyMap m s
+useKey k f = KeyMap $ \k' -> if k==k' then Just f else Nothing
+
+data KeyAction m = forall t . LineState t => KeyAction (Effect t) (KeyMap m t)
+
+nullKM :: KeyMap m s
+nullKM = KeyMap $ const Nothing
+
+orKM :: KeyMap m s -> KeyMap m s -> KeyMap m s
+orKM (KeyMap m) (KeyMap n) = KeyMap $ \k -> m k `mplus` n k
+
+choiceKM :: [KeyMap m s] -> KeyMap m s
+choiceKM = foldl orKM nullKM
+
+newtype Command m s t = Command (KeyMap m t -> KeyMap m s)
+
+runCommand :: Command m s s -> KeyMap m s
+runCommand (Command f) = let m = f m in m
+
+continue :: Command m s s
+continue = Command id
+
+infixl 6 >|>
+(>|>) :: Command m s t -> Command m t u -> Command m s u
+Command f >|> Command g = Command (f . g)
+
+infixl 6 >+>
+(>+>) :: (Monad m, LineState s) => Key -> Command m s t -> Command m s t
+k >+> f = k +> change id >|> f
+
+data CmdAction m s = forall t . LineState t => CmdAction (Effect t) (Command m t s)
+
+(>=>) :: LineState t => Effect t -> Command m t s -> CmdAction m s
+(>=>) = CmdAction
+
+acceptKey :: (Monad m) => (s -> CmdAction m t) -> Key -> Command m s t
+acceptKey f = acceptKeyFull (Just . return . f)
+
+acceptKeyM :: Monad m => (s -> m (CmdAction m t)) -> Key -> Command m s t
+acceptKeyM f = acceptKeyFull (Just . f)
+
+acceptKeyFull :: Monad m => (s -> Maybe (m (CmdAction m t)))
+                            -> Key -> Command m s t
+acceptKeyFull f k = Command $ \next -> useKey k $ \s -> case f s of
+                Nothing -> Left Nothing
+                Just act -> Right $ do
+                    CmdAction effect (Command g) <- act
+                    return (KeyAction effect (g next))
+
+acceptKeyOrFail :: Monad m => (s -> Maybe (CmdAction m t)) -> Key
+            -> Command m s t
+acceptKeyOrFail f = acceptKeyFull (fmap return . f)
+                         
+loopUntil :: Command m s s -> Command m s t -> Command m s t
+loopUntil f g = choiceCmd [g, f >|> loopUntil f g]
+
+try :: Command m s s -> Command m s s
+try (Command f) = Command $ \next -> (f next) `orKM` next
+
+finish :: forall s m t . (Result s, Monad m) => Key -> Command m s t
+finish k = Command $ \_-> useKey k (Left . Just . toResult)
+
+failCmd :: forall s m t . (LineState s, Monad m) => Key -> Command m s t
+failCmd k = Command $ \_-> useKey k (const $ Left Nothing)
+
+simpleCommand :: (LineState t, Monad m) => (s -> m (Effect t)) 
+                    -> Key -> Command m s t
+simpleCommand f = acceptKeyM $ \s -> do
+            act <- f s
+            return (act >=> continue)
+
+charCommand :: (LineState t, Monad m) => (Char -> s -> m (Effect t))
+                    -> Command m s t
+charCommand f = Command $ \next -> KeyMap $ \k -> case k of
+                    KeyChar c | isPrint c -> Just $ \s -> Right $ do
+                                    effect <- f c s
+                                    return (KeyAction effect next)
+                    _ -> Nothing
+                    
+
+change :: (LineState t, Monad m) => (s -> t) -> Key -> Command m s t
+change f = simpleCommand (return . Change . f)
+
+changeFromChar :: (Monad m, LineState t) => (Char -> s -> t) -> Command m s t
+changeFromChar f = charCommand (\c s -> return $ Change (f c s))
+
+changeWithoutKey :: (s -> t) -> Command m s t
+changeWithoutKey f = Command $ \(KeyMap next) -> KeyMap $ fmap (. f) . next
+
+clearScreenCmd :: (LineState s, Monad m) => Key -> Command m s s
+clearScreenCmd k = k +> simpleCommand (\s -> return (Redraw True s))
+
+infixl 7 +>
+(+>) :: Key -> (Key -> a) -> a 
+k +> f = f k
+
+choiceCmd :: [Command m s t] -> Command m s t
+choiceCmd cmds = Command $ \next -> 
+    choiceKM $ map (\(Command f) -> f next) cmds
diff --git a/System/Console/Haskeline/Command/Completion.hs b/System/Console/Haskeline/Command/Completion.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Command/Completion.hs
@@ -0,0 +1,149 @@
+module System.Console.Haskeline.Command.Completion(
+                            CompletionFunc,
+                            Completion,
+                            CompletionType(..),
+                            completionCmd
+                            ) where
+
+import System.Console.Haskeline.Command
+import System.Console.Haskeline.LineState
+import System.Console.Haskeline.InputT
+import System.Console.Haskeline.Prefs
+import System.Console.Haskeline.Completion
+import System.Console.Haskeline.Monads
+
+import Data.List(transpose, unfoldr)
+
+makeCompletion :: Monad m => InsertMode -> InputCmdT m (InsertMode, [Completion])
+makeCompletion (IMode xs ys) = do
+    f <- asks complete
+    (rest,completions) <- liftCmdT (f xs)
+    return (IMode rest ys,completions)
+
+-- | Create a 'Command' for word completion.
+completionCmd :: Monad m => Key -> Command (InputCmdT m) InsertMode InsertMode
+completionCmd k = k +> acceptKeyM (\s -> do
+    prefs <- ask
+    (rest,completions) <- makeCompletion s
+    case completionType prefs of
+        MenuCompletion -> return $ menuCompletion k s
+                        $ map (\c -> insertString (replacement c) rest) completions
+        ListCompletion -> 
+                pagingCompletion prefs s rest completions k)
+
+pagingCompletion :: Monad m => Prefs
+                -> InsertMode -> InsertMode -> [Completion] 
+                -> Key -> InputCmdT m (CmdAction (InputCmdT m) InsertMode)
+pagingCompletion _ oldIM _ [] _ = return $ RingBell oldIM >=> continue
+pagingCompletion _ _ im [newWord] _ 
+        = return $ (Change $ insertString (replacement newWord) im) >=> continue
+pagingCompletion prefs oldIM im completions k
+    | oldIM /= withPartial = return $ Change withPartial >=> continue
+    | otherwise = do
+        layout <- ask
+        let wordLines = makeLines (map display completions) layout
+        printingCmd <- if completionPaging prefs
+                        then printPage wordLines moreMessage
+                        else return $ printAll wordLines withPartial
+        let pageAction = askFirst (completionPromptLimit prefs) (length completions) 
+                            withPartial printingCmd
+        if listCompletionsImmediately prefs
+            then return pageAction
+            else return $ RingBell withPartial >=> 
+                        try (k +> acceptKey (const pageAction))
+  where
+    withPartial = insertString partial im
+    partial = foldl1 commonPrefix (map replacement completions)
+    commonPrefix (c:cs) (d:ds) | c == d = c : commonPrefix cs ds
+    commonPrefix _ _ = ""
+    moreMessage = Message withPartial "----More----"
+
+askFirst :: Monad m => Maybe Int -> Int -> InsertMode
+            -> CmdAction (InputCmdT m) InsertMode
+            -> CmdAction (InputCmdT m) InsertMode
+askFirst mlimit numCompletions im printingCmd = case mlimit of
+    Just limit | limit < numCompletions -> 
+        Change (Message im ("Display all " ++ show numCompletions
+                            ++ " possibilities? (y or n)"))
+                    >=> choiceCmd [
+                            KeyChar 'y' +> acceptKey (const printingCmd)
+                            , KeyChar 'n' +> change messageState
+                            ]
+    _ -> printingCmd
+
+printOneLine :: Monad m => [String] -> Message InsertMode -> CmdAction (InputCmdT m) InsertMode
+printOneLine (w:ws) im | not (null ws) =
+            PrintLines [w] im >=> pagingCommands ws
+printOneLine _ im = Change (messageState im) >=> continue
+
+printPage :: Monad m => [String] -> Message InsertMode
+                    -> InputCmdT m (CmdAction (InputCmdT m) InsertMode)
+printPage ws im = do
+    layout <- ask
+    return $ case splitAt (height layout - 1) ws of
+        (_,[]) -> PrintLines ws (messageState im) >=> continue
+        (zs,rest) -> PrintLines zs im
+                    >=> pagingCommands rest
+
+
+-- TODO: move testing of nullity into here
+pagingCommands :: Monad m => [String] -> Command (InputCmdT m) (Message InsertMode) InsertMode
+pagingCommands ws = choiceCmd [
+                            KeyChar ' ' +> acceptKeyM (printPage ws)
+                            ,KeyChar 'q' +> change messageState
+                            ,KeyChar '\n' +> acceptKey (printOneLine ws)
+                            ]
+
+
+printAll :: Monad m => [String] -> InsertMode 
+            -> CmdAction (InputCmdT m) InsertMode
+printAll ws im = PrintLines ws im >=> continue
+
+
+makeLines :: [String] -> Layout -> [String]
+makeLines ws layout = let
+    minColPad = 2
+    printWidth = width layout
+    maxLength = min printWidth (maximum (map length ws) + minColPad)
+    numCols = printWidth `div` maxLength
+    ls = if (maxLength >= printWidth)
+                    then map (\x -> [x]) ws
+                    else splitIntoGroups numCols ws
+    in map (padWords maxLength) ls
+
+-- Add spaces to the end of each word so that it takes up the given length.
+-- Don't padd the word in the last column, since printing a space in the last column
+-- causes a line wrap on some terminals.
+padWords :: Int -> [String] -> String
+padWords _ [x] = x
+padWords _ [] = ""
+padWords len (x:xs) = x ++ replicate (len - length x) ' '
+			++ padWords len xs
+
+-- Split xs into rows of length n,
+-- such that the list increases incrementally along the columns.
+-- e.g.: splitIntoGroups 4 [1..11] ==
+-- [[1,4,7,10]
+-- ,[2,5,8,11]
+-- ,[3,6,9]]
+splitIntoGroups :: Int -> [a] -> [[a]]
+splitIntoGroups n xs = transpose $ unfoldr f xs
+    where
+        f [] = Nothing
+        f ys = Just (splitAt k ys)
+        k = ceilDiv (length xs) n
+
+-- ceilDiv m n is the smallest k such that k * n >= m.
+ceilDiv :: Integral a => a -> a -> a
+ceilDiv m n | m `rem` n == 0    =  m `div` n
+            | otherwise         =  m `div` n + 1
+
+menuCompletion :: forall m . Monad m => Key -> InsertMode -> [InsertMode] 
+                    -> CmdAction m InsertMode
+menuCompletion _ oldState [] = RingBell oldState >=> continue
+menuCompletion _ _ [c] = Change c >=> continue
+menuCompletion k oldState (c:cs) = Change c >=> loop cs
+    where
+        loop [] = choiceCmd [change (const oldState) k,continue]
+        loop (d:ds) = choiceCmd [change (const d) k >|> loop ds,continue]
+
diff --git a/System/Console/Haskeline/Command/History.hs b/System/Console/Haskeline/Command/History.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Command/History.hs
@@ -0,0 +1,145 @@
+module System.Console.Haskeline.Command.History where
+
+import System.Console.Haskeline.LineState
+import System.Console.Haskeline.Command
+import Control.Monad(liftM,mplus)
+import System.Console.Haskeline.Monads
+import Data.List
+import Data.Maybe(fromMaybe)
+import Control.Exception(evaluate)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.UTF8 as UTF8
+
+import System.Directory(doesFileExist)
+
+data History = History {historyLines :: [String]} -- stored in reverse
+
+data HistLog = HistLog {pastHistory, futureHistory :: [String]}
+                    deriving Show
+
+prevHistoryM :: String -> HistLog -> Maybe (String,HistLog)
+prevHistoryM _ HistLog {pastHistory = []} = Nothing
+prevHistoryM s HistLog {pastHistory=ls:past, futureHistory=future}
+        = Just (ls, 
+            HistLog {pastHistory=past, futureHistory= s:future})
+
+prevHistories :: String -> HistLog -> [(String,HistLog)]
+prevHistories s h = flip unfoldr (s,h) $ \(s',h') -> fmap (\r -> (r,r))
+                    $ prevHistoryM s' h'
+
+histLog :: History -> HistLog
+histLog hist = HistLog {pastHistory = historyLines hist, futureHistory = []}
+
+runHistoryFromFile :: MonadIO m => Maybe FilePath -> Maybe Int -> StateT History m a -> m a
+runHistoryFromFile Nothing _ f = evalStateT' (History []) f
+runHistoryFromFile (Just file) stifleAmt f = do
+    contents <- liftIO $ do
+                exists <- doesFileExist file
+                if exists
+                    -- use binary file I/O to avoid Windows CRLF line endings
+                    -- which cause confusion when switching between systems.
+                    then fmap UTF8.toString (B.readFile file)
+                    else return ""
+    liftIO $ evaluate (length contents) -- force file closed
+    let oldHistory = History (lines contents)
+    (x,newHistory) <- runStateT f oldHistory
+    let stifle = case stifleAmt of
+                    Nothing -> id
+                    Just m -> take m
+    liftIO $ B.writeFile file $ UTF8.fromString 
+        $ unlines $ stifle $ historyLines newHistory
+    return x
+
+addHistory :: MonadState History m => String -> m ()
+addHistory l = modify $ \(History ls) -> History (l:ls)
+
+runHistLog :: Monad m => StateT HistLog m a -> StateT History m a
+runHistLog f = do
+    history <- get
+    lift (evalStateT' (histLog history) f)
+
+
+prevHistory :: FromString s => s -> HistLog -> (s, HistLog)
+prevHistory s h = let (s',h') = fromMaybe (toResult s,h) $ prevHistoryM (toResult s) h
+                  in (fromString s',h')
+
+historyBack, historyForward :: (FromString s, MonadState HistLog m) => 
+                        Key -> Command m s s
+historyBack = simpleCommand $ histUpdate prevHistory
+historyForward = simpleCommand $ reverseHist $ histUpdate prevHistory
+
+histUpdate :: MonadState HistLog m => (s -> HistLog -> (t,HistLog))
+                        -> s -> m (Effect t)
+histUpdate f = liftM Change . update . f
+
+reverseHist :: MonadState HistLog m => (a -> m b) -> a -> m b
+reverseHist f x = do
+    modify reverser
+    y <- f x
+    modify reverser
+    return y
+  where
+    reverser h = HistLog {futureHistory=pastHistory h, 
+                            pastHistory=futureHistory h}
+
+data SearchMode = SearchMode {searchTerm :: String,
+                              foundHistory :: InsertMode}
+                        deriving Show
+
+instance LineState SearchMode where
+    beforeCursor _ sm = beforeCursor prefix (foundHistory sm)
+        where prefix = "(reverse-i-search)`" ++ searchTerm sm ++ "': "
+    afterCursor = afterCursor . foundHistory
+
+instance Result SearchMode where
+    toResult = toResult . foundHistory
+
+startSearchMode :: InsertMode -> SearchMode
+startSearchMode im = SearchMode {searchTerm = "",foundHistory=im}
+
+addChar :: Char -> SearchMode -> SearchMode
+addChar c s = s {searchTerm = searchTerm s ++ [c]}
+
+searchHistories :: String -> [(String,HistLog)] -> Maybe (SearchMode,HistLog)
+searchHistories text = foldr mplus Nothing . map findIt
+    where
+        findIt (l,h) = do 
+            im <- findInLine text l
+            return (SearchMode text im,h)
+
+findInLine :: String -> String -> Maybe InsertMode
+findInLine text l = find' [] l
+    where
+        find' _ "" = Nothing
+        find' prev ccs@(c:cs)
+            | text `isPrefixOf` ccs = Just (IMode prev ccs)
+            | otherwise = find' (c:prev) cs
+
+prepSearch :: SearchMode -> HistLog -> (String,[(String,HistLog)])
+prepSearch sm h = let
+    text = searchTerm sm
+    l = toResult sm
+    in (text,prevHistories l h)
+
+searchHistory :: MonadState HistLog m => Command m InsertMode InsertMode
+searchHistory = controlKey 'r' +> change startSearchMode >|> backSearching
+    where
+        backKey = controlKey 'r'
+        backSearching = choiceCmd [
+                            choiceCmd [
+                                charCommand oneMoreChar
+                                , backKey +> simpleCommand searchBackMore
+                                , Backspace +> change delLastChar
+                                , KeyChar '\b' +> change delLastChar
+                                ] >|> backSearching
+                            , changeWithoutKey foundHistory -- abort
+                            ]
+        delLastChar s = s {searchTerm = minit (searchTerm s)}
+        minit xs = if null xs then "" else init xs
+        oneMoreChar c = histUpdate (\s h -> let
+            (text,hists) = prepSearch s h
+            in fromMaybe (s,h) $ searchHistories text ((toResult s,h):hists)
+            ) . addChar c
+        searchBackMore = histUpdate $ \s h -> let
+            (text,hists) = prepSearch s h
+            in fromMaybe (s,h) $ searchHistories text hists
diff --git a/System/Console/Haskeline/Completion.hs b/System/Console/Haskeline/Completion.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Completion.hs
@@ -0,0 +1,131 @@
+module System.Console.Haskeline.Completion(
+                            CompletionFunc,
+                            Completion(..),
+                            completeWord,
+                            simpleCompletion,
+                            noCompletion,
+                            completeFilename,
+                            filenameWordBreakChars
+                        ) where
+
+
+import System.Directory
+import System.FilePath
+import Data.List(isPrefixOf)
+import Control.Monad(forM)
+
+import System.Console.Haskeline.Monads
+
+-- | Performs completions from a reversed 'String'.  
+-- The output 'String' is also reversed.
+-- Use 'completeWord' to build these functions.
+
+type CompletionFunc m = String -> m (String, [Completion])
+
+
+data Completion = Completion {replacement  :: String, -- ^ Text to insert in line.
+                        display  :: String
+                                -- ^ Text to display when listing
+                                -- alternatives.
+                            }
+                    deriving Show
+
+-- | Disable completion altogether.
+noCompletion :: Monad m => CompletionFunc m
+noCompletion s = return (s,[])
+
+--------------
+-- Word break functions
+
+-- | The following function creates a custom 'CompletionFunc' for use in the 'Settings.'
+completeWord :: Monad m => Maybe Char 
+        -- ^ An optional escape character
+        -> String -- ^ List of characters which count as whitespace
+        -> (String -> m [Completion]) -- ^ Function to produce a list of possible completions
+        -> CompletionFunc m
+completeWord esc ws f line = do
+    let (word,rest) = case esc of
+                        Nothing -> break (`elem` ws) line
+                        Just e -> escapedBreak e line
+    completions <- f (reverse word)
+    return (rest,completions)
+  where
+    escapedBreak e (c:d:cs) | d == e
+            = let (xs,ys) = escapedBreak e cs in (c:d:xs,ys)
+    escapedBreak e (c:cs) | not (elem c ws)
+            = let (xs,ys) = escapedBreak e cs in (c:xs,ys)
+    escapedBreak _ cs = ("",cs)
+    
+-- | Adds a space after the word when inserting it after expansion.
+simpleCompletion :: String -> Completion
+simpleCompletion = setReplacement (++ " ") . completion
+
+-- NOTE: this is the same as for readline, except that I took out the '\\'
+-- so they can be used as a path separator.
+filenameWordBreakChars :: String
+filenameWordBreakChars = " \t\n`@$><=;|&{("
+
+-- A completion command for file and folder names.
+completeFilename :: MonadIO m => CompletionFunc m
+completeFilename  = completeWord (Just '\\') filenameWordBreakChars $ 
+                        (liftIO . quotedFilenames (`elem` "\"\'"))
+
+completion :: String -> Completion
+completion str = Completion str str
+
+setReplacement :: (String -> String) -> Completion -> Completion
+setReplacement f c = c {replacement = f $ replacement c}
+
+
+--------
+-- Helper funcs for file completion
+
+quotedFilenames :: (Char -> Bool) -> String -> IO [Completion]
+quotedFilenames isQuote (q:file) | isQuote q = do
+    files <- findFiles file
+    return $ map (setReplacement ((q:) . appendIfNotDir [q,' '])) files
+quotedFilenames _ file = do
+    files <- findFiles file
+    return $ map (setReplacement (appendIfNotDir " ")) files
+
+appendIfNotDir :: String -> FilePath -> FilePath
+appendIfNotDir str file | null (takeFileName file) = file
+                        | otherwise = file ++ str
+
+findFiles :: FilePath -> IO [Completion]
+-- NOTE: 'handle' catches exceptions from getDirectoryContents and getHomeDirectory.
+findFiles path = handle (\_ -> return []) $ do
+    fixedDir <- fixPath dir
+    dirExists <- doesDirectoryExist fixedDir
+    -- get all of the files in that directory, as basenames
+    allFiles <- if not dirExists
+                    then return []
+                    else fmap (map completion . filterPrefix) 
+                            $ getDirectoryContents fixedDir
+    -- The replacement text should include the directory part, and also 
+    -- have a trailing slash if it's itself a directory.
+    forM allFiles $ \c -> do
+            isDir <- doesDirectoryExist (fixedDir </> replacement c)
+            return $ setReplacement (fullName . maybeAddSlash isDir) c
+  where
+    (dir, file) = splitFileName path
+    filterPrefix = filter (\f -> not (f `elem` [".",".."])
+                                        && file `isPrefixOf` f)
+    maybeAddSlash False = id
+    maybeAddSlash True = addTrailingPathSeparator
+    -- NOTE In order for completion to work properly, all of the alternatives
+    -- must have the exact same prefix.  As a result, </> is a little too clever;
+    -- for example, it doesn't prepend the directory if the file looks like
+    -- an absolute path (strange, but it can happen).
+    -- The FilePath docs state that (++) is an exact inverse of splitFileName, so
+    -- that's the right function to user here.
+    fullName f = dir ++ f
+
+-- turn a user-visible path into an internal version useable by System.FilePath.
+fixPath :: String -> IO String
+fixPath "" = return "."
+fixPath ('~':c:path) | isPathSeparator c = do
+    home <- getHomeDirectory
+    return (home </> path)
+fixPath path = return path
+
diff --git a/System/Console/Haskeline/Emacs.hs b/System/Console/Haskeline/Emacs.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Emacs.hs
@@ -0,0 +1,50 @@
+module System.Console.Haskeline.Emacs where
+
+import System.Console.Haskeline.Command
+import System.Console.Haskeline.Command.Completion
+import System.Console.Haskeline.Command.History
+import System.Console.Haskeline.LineState
+import System.Console.Haskeline.InputT
+
+import Data.Char
+
+type InputCmd s t = forall m . Monad m => Command (InputCmdT m) s t
+
+emacsCommands :: Monad m => KeyMap (InputCmdT m) InsertMode
+emacsCommands = runCommand $ choiceCmd [simpleActions, controlActions]
+
+simpleActions, controlActions :: InputCmd InsertMode InsertMode
+simpleActions = choiceCmd 
+            [ KeyChar '\n' +> finish
+	    , KeyChar '\r' +> finish
+            , KeyLeft +> change goLeft
+            , KeyRight +> change goRight
+            , Backspace +> change deletePrev
+            , KeyChar '\b' +> change deletePrev
+	    , DeleteForward +> change deleteNext 
+            , changeFromChar insertChar
+            , KeyChar '\t' +> completionCmd
+            , KeyUp +> historyBack
+            , KeyDown +> historyForward
+            , searchHistory
+            ] 
+            
+controlActions = choiceCmd
+            [ controlKey 'a' +> change moveToStart 
+            , controlKey 'e' +> change moveToEnd
+            , controlKey 'b' +> change goLeft
+            , controlKey 'c' +> change goRight
+            , controlKey 'd' +> deleteCharOrEOF
+            , controlKey 'l' +> clearScreenCmd
+            , KeyMeta 'f' +> change (skipRight isAlphaNum
+                                     . skipRight (not . isAlphaNum))
+            , KeyMeta 'b' +> change (skipLeft isAlphaNum
+                                     . skipLeft (not . isAlphaNum))
+            ]
+
+deleteCharOrEOF :: Key -> InputCmd InsertMode InsertMode
+deleteCharOrEOF k = k +> acceptKeyOrFail (\s -> if s == emptyIM
+            then Nothing
+            else Just $ Change (deleteNext s) >=> justDelete)
+    where
+        justDelete = try (change deleteNext k >|> justDelete)
diff --git a/System/Console/Haskeline/InputT.hs b/System/Console/Haskeline/InputT.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/InputT.hs
@@ -0,0 +1,83 @@
+module System.Console.Haskeline.InputT where
+
+
+import System.Console.Haskeline.Command.History
+import System.Console.Haskeline.Monads as Monads
+import System.Console.Haskeline.Prefs
+import System.Console.Haskeline.Command(Layout)
+import System.Console.Haskeline.Completion
+import System.Console.Haskeline.Backend
+import System.Console.Haskeline.Term
+
+import System.Directory(getHomeDirectory)
+import System.FilePath
+
+-- | Application-specific customizations to the user interface.
+data Settings m = Settings {complete :: CompletionFunc m, -- ^ Custom tab completion
+                            historyFile :: Maybe FilePath,
+                            handleSigINT :: Bool -- ^ Throw an 'Interrupt'
+                            -- exception if the user presses Ctrl-C
+                            }
+
+-- | Because 'complete' is the only field of 'Settings' depending on @m@,
+-- the expression @defaultSettings {completionFunc = f}@ leads to a type error
+-- from being too general.  This function may become unnecessary if another field
+-- depending on @m@ is added.
+
+setComplete :: CompletionFunc m -> Settings m -> Settings m
+setComplete f s = s {complete = f}
+
+
+-- | A monad transformer which carries all of the state and settings
+-- relevant to a line-reading application.
+newtype InputT m a = InputT {unInputT :: ReaderT (RunTerm (InputCmdT m))
+                                (StateT History (ReaderT Prefs 
+                                (ReaderT (Settings m) m))) a}
+                            deriving (Monad,MonadIO, MonadState History,
+                                        MonadReader Prefs, MonadReader (Settings m),
+                                        MonadReader (RunTerm (InputCmdT m)))
+
+
+instance MonadTrans InputT where
+    lift = InputT . lift . lift . lift . lift
+
+instance MonadException m => MonadException (InputT m) where
+    block = InputT . block . unInputT
+    unblock = InputT . unblock . unInputT
+    catch f h = InputT $ Monads.catch (unInputT f) (unInputT . h)
+
+-- for internal use only
+type InputCmdT m = ReaderT Layout (StateT HistLog (ReaderT Prefs (ReaderT (Settings m) m)))
+
+instance MonadIO m => MonadLayout (InputCmdT m) where
+
+runInputCmdT :: forall m a . MonadIO m => InputCmdT m a -> InputT m a
+runInputCmdT f = InputT $ do
+    run :: RunTerm (InputCmdT m) <- ask
+    layout <- liftIO $ getLayout run
+    lift $ runHistLog $ runReaderT' layout f
+
+
+liftCmdT :: Monad m => m a -> InputCmdT m a
+liftCmdT = lift  . lift . lift . lift
+
+runInputTWithPrefs :: MonadException m => Prefs -> Settings m -> InputT m a -> m a
+runInputTWithPrefs prefs settings (InputT f) = liftIO myRunTerm >>= \run -> 
+    runReaderT' settings $ runReaderT' prefs 
+        $ runHistoryFromFile (historyFile settings) (maxHistorySize prefs) 
+        $ runReaderT f run
+        
+-- | Run a line-reading application, reading user 'Prefs' from 
+-- @~/.haskeline@
+runInputT :: MonadException m => Settings m -> InputT m a -> m a
+runInputT settings f = do
+    prefs <- liftIO readPrefsFromHome
+    runInputTWithPrefs prefs settings f
+
+-- | Read 'Prefs' from @~/.haskeline.@   If there is an error reading the file,
+-- the 'defaultPrefs' will be returned.
+readPrefsFromHome :: IO Prefs
+readPrefsFromHome = handle (\_ -> return defaultPrefs) $ do
+    home <- getHomeDirectory
+    readPrefs (home </> ".haskeline")
+
diff --git a/System/Console/Haskeline/LineState.hs b/System/Console/Haskeline/LineState.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/LineState.hs
@@ -0,0 +1,168 @@
+module System.Console.Haskeline.LineState where
+
+
+class LineState s where
+    beforeCursor :: String -> s -> String -- text to left of cursor
+    afterCursor :: s -> String -- text under and to right of cursor
+    isTemporary :: s -> Bool
+    isTemporary _ = False
+
+class LineState s => Result s where
+    toResult :: s -> String
+
+lengthToEnd :: LineState s => s -> Int
+lengthToEnd = length . afterCursor
+
+class (Result s) => FromString s where
+    fromString :: String -> s
+
+class Move s where
+    goLeft, goRight, moveToStart, moveToEnd :: s -> s
+    
+
+data InsertMode = IMode String String 
+                    deriving (Show, Eq)
+
+instance LineState InsertMode where
+    beforeCursor prefix (IMode xs _) = prefix ++ reverse xs
+    afterCursor (IMode _ ys) = ys
+
+instance Result InsertMode where
+    toResult (IMode xs ys) = reverse xs ++ ys
+
+instance Move InsertMode where
+    goLeft im@(IMode [] _) = im 
+    goLeft (IMode (x:xs) ys) = IMode xs (x:ys)
+
+    goRight im@(IMode _ []) = im
+    goRight (IMode ys (x:xs)) = IMode (x:ys) xs
+
+    moveToStart (IMode xs ys) = IMode [] (reverse xs ++ ys)
+    moveToEnd (IMode xs ys) = IMode (reverse ys ++ xs) []
+
+instance FromString InsertMode where
+    fromString s = IMode (reverse s) []
+
+emptyIM :: InsertMode
+emptyIM = IMode "" ""
+
+insertChar :: Char -> InsertMode -> InsertMode
+insertChar c (IMode xs ys) = IMode (c:xs) ys
+
+insertString :: String -> InsertMode -> InsertMode
+insertString s (IMode xs ys) = IMode (reverse s ++ xs) ys
+
+deleteNext, deletePrev :: InsertMode -> InsertMode
+deleteNext im@(IMode _ []) = im
+deleteNext (IMode xs (_:ys)) = IMode xs ys
+
+deletePrev im@(IMode [] _) = im
+deletePrev (IMode (_:xs) ys) = IMode xs ys 
+
+skipLeft, skipRight :: (Char -> Bool) -> InsertMode -> InsertMode
+skipLeft f (IMode xs ys) = let (ws,zs) = span f xs 
+                           in IMode zs (reverse ws ++ ys)
+skipRight f (IMode xs ys) = let (ws,zs) = span f ys 
+                            in IMode (reverse ws ++ xs) zs
+
+
+data CommandMode = CMode String Char String | CEmpty
+                    deriving Show
+
+instance LineState CommandMode where
+    beforeCursor prefix CEmpty = prefix
+    beforeCursor prefix (CMode xs _ _) = prefix ++ reverse xs
+    afterCursor CEmpty = ""
+    afterCursor (CMode _ c ys) = c:ys
+
+instance Result CommandMode where
+    toResult CEmpty = ""
+    toResult (CMode xs c ys) = reverse xs ++ (c:ys)
+
+instance Move CommandMode where
+    goLeft (CMode (x:xs) c ys) = CMode xs x (c:ys)
+    goLeft cm = cm
+
+    goRight (CMode xs c (y:ys)) = CMode (c:xs) y ys
+    goRight cm = cm
+
+    moveToStart (CMode xs c ys) = let zs = reverse xs ++ (c:ys) in CMode [] (head zs) (tail zs)
+    moveToStart CEmpty = CEmpty
+
+    moveToEnd (CMode xs c ys) = let zs = reverse ys ++ (c:xs) in CMode (tail zs) (head zs) []
+    moveToEnd CEmpty = CEmpty
+
+instance FromString CommandMode where
+    fromString s = case reverse s of
+                    [] -> CEmpty
+                    (c:cs) -> CMode cs c []
+
+deleteChar :: CommandMode -> CommandMode
+deleteChar (CMode xs _ (y:ys)) = CMode xs y ys
+deleteChar (CMode (x:xs) _ []) = CMode xs x []
+deleteChar _ = CEmpty
+
+replaceChar :: Char -> CommandMode -> CommandMode
+replaceChar c (CMode xs _ ys) = CMode xs c ys
+replaceChar _ CEmpty = CEmpty
+
+
+
+------------------------
+-- Transitioning between modes
+
+enterCommandMode :: InsertMode -> CommandMode
+enterCommandMode (IMode (x:xs) ys) = CMode xs x ys
+enterCommandMode (IMode [] (y:ys)) = CMode [] y ys
+enterCommandMode _ = CEmpty
+
+insertFromCommandMode, appendFromCommandMode :: CommandMode -> InsertMode
+
+insertFromCommandMode CEmpty = emptyIM
+insertFromCommandMode (CMode xs c ys) = IMode xs (c:ys)
+
+appendFromCommandMode CEmpty = emptyIM
+appendFromCommandMode (CMode xs c ys) = IMode (c:xs) ys
+
+
+----------------------
+-- Supplementary modes
+
+data ArgMode s = ArgMode {arg :: Int, argState :: s}
+
+instance LineState s => LineState (ArgMode s) where
+    beforeCursor _ am = beforeCursor ("(arg: " ++ show (arg am) ++ ") ")
+                            (argState am)
+    afterCursor = afterCursor . argState
+
+instance Result s => Result (ArgMode s) where
+    toResult = toResult . argState
+
+startArg :: Int -> s -> ArgMode s
+startArg = ArgMode
+
+addNum :: Int -> ArgMode s -> ArgMode s
+addNum n am
+    | arg am >= 1000 = am -- shouldn't ever need more than 4 digits
+    | otherwise = am {arg = arg am * 10 + n} 
+
+-- todo: negatives
+applyArg :: (s -> s) -> ArgMode s -> s
+applyArg f am = repeatN (arg am) (argState am)
+    where
+        repeatN n | n <= 1 = f
+                    | otherwise = f . repeatN (n-1)
+
+---------------
+data Cleared = Cleared
+
+instance LineState Cleared where
+    beforeCursor _ Cleared = ""
+    afterCursor Cleared = ""
+
+data Message s = Message {messageState :: s, messageText :: String}
+
+instance LineState s => LineState (Message s) where
+    beforeCursor _ = messageText
+    afterCursor _ = ""
+    isTemporary _ = True
diff --git a/System/Console/Haskeline/MonadException.hs b/System/Console/Haskeline/MonadException.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/MonadException.hs
@@ -0,0 +1,59 @@
+{- | This module redefines some of the functions in "Control.Exception" to
+work for more general monads than only 'IO'.
+-}
+
+module System.Console.Haskeline.MonadException where
+
+import qualified Control.Exception as E
+import Prelude hiding (catch)
+import Control.Exception(Exception)
+import Control.Monad.Reader
+import Control.Monad.State
+
+class MonadIO m => MonadException m where
+    catch :: m a -> (Exception -> m a) -> m a
+    block :: m a -> m a
+    unblock :: m a -> m a
+
+handle :: MonadException m => (Exception -> m a) -> m a -> m a
+handle = flip catch
+
+finally :: MonadException m => m a -> m b -> m a
+finally f ender = block (do
+    r <- catch
+            (unblock f)
+            (\e -> do {ender; throwIO e})
+    ender
+    return r)
+
+throwIO :: MonadIO m => Exception -> m a
+throwIO = liftIO . E.throwIO
+
+bracket :: MonadException m => m a -> (a -> m b) -> (a -> m c) -> m c
+bracket before after thing =
+  block (do
+    a <- before 
+    r <- catch 
+	   (unblock (thing a))
+	   (\e -> do { after a; throwIO e })
+    after a
+    return r
+ )
+
+
+instance MonadException IO where
+    catch = E.catch
+    block = E.block
+    unblock = E.unblock
+
+instance MonadException m => MonadException (ReaderT r m) where
+    catch f h = ReaderT $ \r -> catch (runReaderT f r) 
+                            (\e -> runReaderT (h e) r)
+    block = mapReaderT block
+    unblock = mapReaderT unblock
+
+instance MonadException m => MonadException (StateT s m) where
+    catch f h = StateT $ \s -> catch (runStateT f s)
+                                (\e -> runStateT (h e) s)
+    block = mapStateT block
+    unblock = mapStateT unblock
diff --git a/System/Console/Haskeline/Monads.hs b/System/Console/Haskeline/Monads.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Monads.hs
@@ -0,0 +1,72 @@
+module System.Console.Haskeline.Monads(
+                module Control.Monad.Trans,
+                module System.Console.Haskeline.MonadException,
+                ReaderT(..),
+                runReaderT',
+                asks,
+                StateT(..),
+                evalStateT',
+                modify,
+                update,
+                MonadReader(..),
+                MonadState(..)
+                ) where
+
+import Control.Monad.Trans
+import System.Console.Haskeline.MonadException
+
+import Control.Monad.Reader hiding (MonadReader,ask,asks,local)
+import qualified Control.Monad.Reader as Reader
+import Control.Monad.State hiding (MonadState,get,put,modify)
+import qualified Control.Monad.State as State
+
+class Monad m => MonadReader r m where
+    ask :: m r
+    local :: r -> m a -> m a
+
+instance Monad m => MonadReader r (ReaderT r m) where
+    ask = Reader.ask
+    local r = Reader.local (const r)
+
+instance MonadReader r m => MonadReader r (ReaderT t m) where
+    ask = lift ask
+    local r = mapReaderT (local r)
+    
+instance MonadReader r m => MonadReader r (StateT s m) where
+    ask = lift ask
+    local r = mapStateT (local r)
+
+asks :: MonadReader r m => (r -> a) -> m a
+asks f = liftM f ask
+
+class Monad m => MonadState s m where
+    get :: m s
+    put :: s -> m ()
+
+instance Monad m => MonadState s (StateT s m) where
+    get = State.get
+    put = State.put
+
+instance MonadState s m => MonadState s (StateT t m) where
+    get = lift get
+    put = lift . put
+
+instance MonadState s m => MonadState s (ReaderT r m) where
+    get = lift get
+    put = lift . put
+
+modify :: MonadState s m => (s -> s) -> m ()
+modify f = get >>= put . f
+
+update :: MonadState s m => (s -> (a,s)) -> m a
+update f = do
+    s <- get
+    let (x,s') = f s
+    put s'
+    return x
+
+runReaderT' :: Monad m => r -> ReaderT r m a -> m a
+runReaderT' = flip runReaderT
+
+evalStateT' :: Monad m => s -> StateT s m a -> m a
+evalStateT' = flip evalStateT
diff --git a/System/Console/Haskeline/Prefs.hs b/System/Console/Haskeline/Prefs.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Prefs.hs
@@ -0,0 +1,102 @@
+{- |
+'Prefs' allow the user to customize the line-editing interface.  They are
+read by default from @~/.haskeline@; to override that behavior, use
+'readPrefs' and 'runInputTWithPrefs'.  
+
+Each line of a @.haskeline@ file defines
+one field of the 'Prefs' datatype; field names are case-insensitive and
+unparseable lines are ignored.  For example:
+
+> editMode: Vi
+> completionType: MenuCompletion
+> maxhistorysize: Just 40
+
+-}
+module System.Console.Haskeline.Prefs where
+
+import Language.Haskell.TH
+import Data.Char(isSpace,toLower)
+import Data.List(foldl')
+import Control.Exception(handle)
+
+
+data Prefs = Prefs { bellStyle :: !BellStyle,
+                     editMode :: !EditMode,
+                     maxHistorySize :: !(Maybe Int),
+                     completionType :: !CompletionType,
+                     completionPaging :: !Bool, 
+                        -- ^ When listing completion alternatives, only display
+                        -- one screen of possibilities at a time.
+                     completionPromptLimit :: !(Maybe Int),
+                        -- ^ If more than this number of completion
+                        -- possibilities are found, then ask before listing
+                        -- them.
+                     listCompletionsImmediately :: !Bool
+                        -- ^ If 'False', completions with multiple possibilities
+                        -- will ring the bell and only display them if the user
+                        -- presses @TAB@ again.
+                     }
+                        deriving (Read,Show)
+
+data CompletionType = ListCompletion | MenuCompletion
+            deriving (Read,Show)
+
+
+data BellStyle = NoBell | VisualBell | AudibleBell
+                    deriving (Show, Read)
+
+data EditMode = Vi | Emacs
+                    deriving (Show,Read)
+
+{- | The default preferences which may be overwritten in the @.haskeline@ file:
+
+> defaultPrefs = Prefs {bellStyle = AudibleBell,
+>                      maxHistorySize = Nothing,
+>                      editMode = Emacs,
+>                      completionType = ListCompletion,
+>                      completionPaging = True,
+>                      completionPromptLimit = Just 100,
+>                      listCompletionsImmediately = True
+>                    }
+
+-}
+defaultPrefs :: Prefs
+defaultPrefs = Prefs {bellStyle = AudibleBell,
+                      maxHistorySize = Nothing,
+                      editMode = Emacs,
+                      completionType = ListCompletion,
+                      completionPaging = True,
+                      completionPromptLimit = Just 100,
+                      listCompletionsImmediately = True
+                    }
+
+mkSettor :: Read a => (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
+mkSettor f str = case reads str of
+                [(x,_)] -> f x
+                _ -> id
+
+settors :: [(String,String -> Prefs -> Prefs)]
+settors = $(do
+    DataConI _ _ prefsType _ <- reify 'Prefs
+    TyConI (DataD _ _ _ [RecC _ fields] _) <- reify prefsType
+    x <- newName "x"
+    p <- newName "p"
+    -- settor f => ("f", mkSettor (\x p -> p {f=x}))
+    let settor (f,_,_) = TupE [LitE (StringL (map toLower $ nameBase f)),
+                        AppE (VarE 'mkSettor) $ LamE [VarP x,VarP p]
+                        $ RecUpdE (VarE p) [(f,VarE x)]]
+    return $ ListE $ map settor fields)
+
+-- | Read 'Prefs' from a given file.  If there is an error reading the file,
+-- the 'defaultPrefs' will be returned.
+readPrefs :: FilePath -> IO Prefs
+readPrefs file = handle (\_ -> return defaultPrefs) $ do
+    ls <- fmap lines $ readFile file
+    return $ foldl' applyField defaultPrefs ls
+  where
+    applyField p l = case break (==':') l of
+                (name,val)  -> case lookup (map toLower $ trimSpaces name) settors of
+                        Nothing -> p
+                        Just set -> set (drop 1 val) p  -- drop initial ":", don't crash if val==""
+    trimSpaces = dropWhile isSpace . reverse . dropWhile isSpace . reverse
+                    
diff --git a/System/Console/Haskeline/Term.hs b/System/Console/Haskeline/Term.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Term.hs
@@ -0,0 +1,56 @@
+module System.Console.Haskeline.Term where
+
+import System.Console.Haskeline.Monads
+import System.Console.Haskeline.LineState
+import System.Console.Haskeline.Command
+
+import Control.Concurrent
+import Control.Concurrent.STM
+
+-- TODO: Cache the RunTerm in between runs?
+-- If do this, should make sure in Terminfo and dumb terms that they 
+-- cache the input keymaps too.
+
+class MonadIO m => Term m where
+    withReposition :: Layout -> m a -> m a
+    moveToNextLine :: LineState s => s -> m ()
+    printLines :: [String] -> m ()
+    drawLineDiff :: (LineState s, LineState r)
+                    => String -> s -> r -> m ()
+    clearLayout :: m ()
+    ringBell :: Bool -> m ()
+    
+
+data RunTerm m = forall t . (Term (t m), MonadTrans t) => RunTerm {
+            getLayout :: IO Layout,
+            withGetEvent :: forall a . Bool -> (t m Event -> t m a) -> t m a,
+            runTerm :: forall a . t m a -> m a,
+            putStrTerm :: String -> IO ()
+    }
+
+-- Utility function for drawLineDiff instances.
+matchInit :: Eq a => [a] -> [a] -> ([a],[a])
+matchInit (x:xs) (y:ys)  | x == y = matchInit xs ys
+matchInit xs ys = (xs,ys)
+
+keyEventLoop :: (TChan Event -> IO ()) -> TChan Event -> IO Event
+keyEventLoop readKey eventChan = do
+    -- first, see if any events are already queued up (from a key/ctrl-c
+    -- event or from a previous call to getEvent where we read in multiple
+    -- keys)    
+    me <- atomically $ tryReadTChan eventChan
+    case me of
+        Just e -> return e
+        Nothing -> do
+            -- no events are queued yet, so fork off a thread to read keys.
+            -- if we receive a different type of event before it's done,
+            -- we'll kill it.
+            tid <- forkIO (readKey eventChan)
+            e <- atomically $ readTChan eventChan -- key or other event
+            killThread tid
+            return e
+
+tryReadTChan :: TChan a -> STM (Maybe a)
+tryReadTChan chan = fmap Just (readTChan chan) `orElse` return Nothing
+
+class (MonadReader Layout m, MonadIO m) => MonadLayout m where
diff --git a/System/Console/Haskeline/Vi.hs b/System/Console/Haskeline/Vi.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/Haskeline/Vi.hs
@@ -0,0 +1,152 @@
+module System.Console.Haskeline.Vi where
+
+import System.Console.Haskeline.Command
+import System.Console.Haskeline.Command.Completion
+import System.Console.Haskeline.Command.History
+import System.Console.Haskeline.LineState
+import System.Console.Haskeline.InputT
+
+
+type InputCmd s t = forall m . Monad m => Command (InputCmdT m) s t
+
+viActions :: Monad m => KeyMap (InputCmdT m) InsertMode
+viActions = runCommand insertionCommands
+
+insertionCommands :: InputCmd InsertMode InsertMode
+insertionCommands = choiceCmd [startCommand, simpleInsertions]
+                            
+simpleInsertions :: InputCmd InsertMode InsertMode
+simpleInsertions = choiceCmd
+                [ KeyChar '\n' +> finish
+		   , KeyChar '\r' +> finish
+                   , KeyLeft +> change goLeft 
+                   , KeyRight +> change goRight
+                   , Backspace +> change deletePrev 
+		   , KeyChar '\b' +> change deletePrev
+                   , DeleteForward +> change deleteNext 
+                   , changeFromChar insertChar
+                   , KeyChar '\t' +> completionCmd
+                   , KeyUp +> historyBack
+                   , KeyDown +> historyForward
+                   , controlKey 'd' +> eofIfEmpty
+                   , searchHistory
+                   ]
+
+-- If we receive a ^D and the line is empty, return Nothing
+-- otherwise, ignore it.
+eofIfEmpty :: Key -> InputCmd InsertMode InsertMode
+eofIfEmpty k = k +> acceptKeyOrFail (\s -> if s == emptyIM
+                    then Nothing
+                    else Just $ Change s >=> continue)
+
+startCommand :: InputCmd InsertMode InsertMode
+startCommand = KeyChar '\ESC' +> change enterCommandMode
+                    >|> viCommandActions
+
+viCommandActions :: InputCmd CommandMode InsertMode
+viCommandActions = simpleCmdActions `loopUntil` exitingCommands
+
+exitingCommands :: InputCmd CommandMode InsertMode
+exitingCommands =  choiceCmd [ KeyChar 'i' +> change insertFromCommandMode
+                    , KeyChar 'I' +> change (moveToStart . insertFromCommandMode)
+                    , KeyChar 'a' +> change appendFromCommandMode
+                    , KeyChar 'A' +> change (moveToEnd . appendFromCommandMode)
+                    , KeyChar 's' +> change (insertFromCommandMode . deleteChar)
+                    , KeyChar 'S' +> change (const emptyIM)
+                    , deleteIOnce
+                    , repeated
+                    ]
+
+simpleCmdActions :: InputCmd CommandMode CommandMode
+simpleCmdActions = choiceCmd [ KeyChar '\n'  +> finish
+                    , KeyChar '\ESC' +> change id -- helps break out of loops
+                    , KeyChar 'r'   +> replaceOnce 
+                    , KeyChar 'R'   +> loopReplace
+                    , KeyChar 'x' +> change deleteChar
+                    , KeyUp +> historyBack
+                    , KeyDown +> historyForward
+                    , deleteOnce
+                    , useMovements id
+                    ]
+
+replaceOnce :: Key -> InputCmd CommandMode CommandMode
+replaceOnce k = k >+> try (changeFromChar replaceChar)
+
+loopReplace :: Key -> InputCmd CommandMode CommandMode
+loopReplace k = k >+> loop
+    where
+        loop = choiceCmd [changeFromChar (\c -> goRight . replaceChar c) >|> loop
+                         , continue]
+
+repeated :: InputCmd CommandMode InsertMode
+repeated = let
+    start = foreachDigit startArg ['1'..'9']
+    addDigit = foreachDigit addNum ['0'..'9']
+    deleteR = KeyChar 'd' 
+                >+> choiceCmd [useMovements (deleteFromRepeatedMove),
+                             KeyChar 'd' +> change (const CEmpty)]
+    deleteIR = KeyChar 'c'
+                >+> choiceCmd [useMovements deleteAndInsertR,
+                             KeyChar 'c' +> change (const emptyIM)]
+    loop = choiceCmd [addDigit >|> loop
+                     , useMovements applyArg >|> viCommandActions
+                     , deleteR >|> viCommandActions
+                     , deleteIR
+                     , KeyChar 'x' +> change (applyArg deleteChar)
+                        >|> viCommandActions
+                     , changeWithoutKey argState >|> viCommandActions
+                     ]
+    in start >|> loop
+
+movements :: [(Key,CommandMode -> CommandMode)]
+movements = [ (KeyChar 'h', goLeft)
+            , (KeyChar 'l', goRight)
+            , (KeyChar ' ', goRight)
+            , (KeyLeft, goLeft)
+            , (KeyRight, goRight)
+            , (KeyChar '0', moveToStart)
+            , (KeyChar '$', moveToEnd)
+            ]
+
+useMovements :: LineState t => ((CommandMode -> CommandMode) -> s -> t) 
+                -> InputCmd s t
+useMovements f = choiceCmd $ map (\(k,g) -> k +> change (f g))
+                                movements
+
+deleteOnce :: InputCmd CommandMode CommandMode
+deleteOnce = KeyChar 'd'
+            >+> choiceCmd [useMovements deleteFromMove,
+                         KeyChar 'd' +> change (const CEmpty)]
+
+deleteIOnce :: InputCmd CommandMode InsertMode
+deleteIOnce = KeyChar 'c'
+              >+> choiceCmd [useMovements deleteAndInsert,
+                            KeyChar 'c' +> change (const emptyIM)]
+
+deleteAndInsert :: (CommandMode -> CommandMode) -> CommandMode -> InsertMode
+deleteAndInsert f = insertFromCommandMode . deleteFromMove f
+
+deleteAndInsertR :: (CommandMode -> CommandMode) 
+                -> ArgMode CommandMode -> InsertMode
+deleteAndInsertR f = insertFromCommandMode . deleteFromRepeatedMove f
+
+
+foreachDigit :: (Monad m, LineState t) => (Int -> s -> t) -> [Char] 
+                -> Command m s t
+foreachDigit f ds = choiceCmd $ map digitCmd ds
+    where digitCmd d = KeyChar d +> change (f (toDigit d))
+          toDigit d = fromEnum d - fromEnum '0'
+
+
+deleteFromMove :: (CommandMode -> CommandMode) -> CommandMode -> CommandMode
+deleteFromMove f = \x -> deleteFromDiff x (f x)
+
+deleteFromRepeatedMove :: (CommandMode -> CommandMode)
+            -> ArgMode CommandMode -> CommandMode
+deleteFromRepeatedMove f am = deleteFromDiff (argState am) (applyArg f am)
+
+deleteFromDiff :: CommandMode -> CommandMode -> CommandMode
+deleteFromDiff (CMode xs1 c1 ys1) (CMode xs2 _ ys2)
+    | length xs1 < length xs2 = enterCommandMode (IMode xs1 ys2)
+    | otherwise = CMode xs2 c1 ys1
+deleteFromDiff _ after = after
diff --git a/cbits/win_console.c b/cbits/win_console.c
new file mode 100644
--- /dev/null
+++ b/cbits/win_console.c
@@ -0,0 +1,5 @@
+#include "win_console.h"
+
+BOOL SetPosition(HANDLE h, COORD* c) {
+    return SetConsoleCursorPosition(h,*c);
+}
diff --git a/haskeline.cabal b/haskeline.cabal
new file mode 100644
--- /dev/null
+++ b/haskeline.cabal
@@ -0,0 +1,79 @@
+Name:           haskeline
+Cabal-Version:  >=1.2
+Version:        0.2
+Category:       User Interfaces
+License:        BSD3
+License-File:   LICENSE
+Copyright:      (c) Judah Jacobson
+Author:         Judah Jacobson
+Maintainer:     Judah Jacobson <judah.jacobson@gmail.com>
+Category:       User Interfaces
+Synopsis:       A command-line interface for user input, written in Haskell.
+Description:    
+                Haskeline provides a user interface for line input in command-line
+                programs.  This library is similar in purpose to readline, but since
+                it is written in Haskell it is (hopefully) more easily used in other
+                Haskell programs.
+                .
+                Haskeline runs both on POSIX-compatible systems and on Windows
+                (under MinGW).
+Homepage:       http://code.haskell.org/haskeline
+Stability:      Experimental
+Build-Type:     Simple
+
+flag target-mingw
+    Description: Use native Win32 Console functionality (suitable for MinGW)
+    Default: False
+
+flag old-base
+    Description: Use the base packages from before version 6.8
+
+Library
+    if flag(old-base)
+        Build-depends: base < 3
+    else
+        Build-depends: base>=3.0, containers>=0.1, directory>=1.0
+    Build-depends:  stm>=2.0, filepath>=1.1, template-haskell>=2.1, 
+                    mtl>=1.1, utf8-string>=0.3.1.1, bytestring>=0.9.0.1
+    Extensions:     ForeignFunctionInterface, Rank2Types, FlexibleInstances,
+                TypeSynonymInstances
+                FlexibleContexts, ExistentialQuantification
+                ScopedTypeVariables, GeneralizedNewtypeDeriving
+                MultiParamTypeClasses, OverlappingInstances
+                PatternSignatures, CPP, DeriveDataTypeable,
+                PatternGuards, TemplateHaskell, StandaloneDeriving
+                -- Note: GADTs are needed to allow contexts of different
+                -- lengths (see code of Haskeline.repeatTillFinish)
+                GADTs
+    Exposed-Modules:
+                System.Console.Haskeline
+                System.Console.Haskeline.Completion
+                System.Console.Haskeline.Prefs
+                System.Console.Haskeline.MonadException
+    Other-Modules:
+                System.Console.Haskeline.Backend
+                System.Console.Haskeline.Command
+                System.Console.Haskeline.Command.Completion
+                System.Console.Haskeline.Command.History
+                System.Console.Haskeline.Emacs
+                System.Console.Haskeline.InputT
+                System.Console.Haskeline.LineState
+                System.Console.Haskeline.Monads
+                System.Console.Haskeline.Term
+                System.Console.Haskeline.Vi
+    include-dirs: includes
+    if flag(target-mingw) {
+        Build-depends: Win32>=2.0
+        Other-modules: System.Console.Haskeline.Backend.Win32
+        c-sources: cbits/win_console.c
+        includes: win_console.h
+        install-includes: win_console.h
+        cpp-options: -DMINGW
+    } else {
+        Build-depends: terminfo>=0.2, unix>=2.0
+        Other-modules: 
+                System.Console.Haskeline.Backend.Posix
+                System.Console.Haskeline.Backend.DumbTerm
+                System.Console.Haskeline.Backend.Terminfo
+    }
+    ghc-options: -Wall
diff --git a/includes/win_console.h b/includes/win_console.h
new file mode 100644
--- /dev/null
+++ b/includes/win_console.h
@@ -0,0 +1,7 @@
+#ifndef _WIN_CONSOLE_H
+#define _WIN_CONSOLE_H
+#include <windows.h>
+
+BOOL SetPosition(HANDLE h, COORD* c);
+
+#endif