Import of source files

16 files changed, 1219 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..08ba6e8
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+.ghc.environment.*
+dist/
+dist-newstyle/
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..9afdd75
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+Copyright (c) 2019 Tom Smeding
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/src/Numeric/InfInt.hs b/src/Numeric/InfInt.hs
new file mode 100644
index 0000000..871e5eb
--- /dev/null
+++ b/src/Numeric/InfInt.hs
@@ -0,0 +1,60 @@
+{-|
+Module      : Numeric.InfInt
+Copyright   : (c) UU, 2019
+License     : MIT
+Maintainer  : Tom Smeding
+Stability   : experimental
+Portability : POSIX, macOS, Windows
+-}
+module Numeric.InfInt where
+
+
+-- | The integers with ±∞ added. This is not a full ring ('∞ + -∞' is
+-- undefined, for instance), but it works well enough.
+data InfInt = MInfinity | Finite Int | Infinity
+  deriving (Show, Eq, Ord)
+
+instance Num InfInt where
+    Infinity  + MInfinity = undefined
+    Infinity  + _         = Infinity
+    MInfinity + Infinity  = undefined
+    MInfinity + _         = MInfinity
+    Finite n  + Finite m  = Finite (n + m)
+    Finite _  + Infinity  = Infinity
+    Finite _  + MInfinity = MInfinity
+
+    Finite n  * Finite m  = Finite (n * m)
+    Finite 0  * _         = undefined
+    Finite n  * Infinity  = if n < 0 then MInfinity else Infinity
+    Finite n  * MInfinity = if n < 0 then Infinity else MInfinity
+    Infinity  * Finite m  = Finite m * Infinity
+    Infinity  * Infinity  = Infinity
+    Infinity  * MInfinity = MInfinity
+    MInfinity * Finite m  = Finite m * MInfinity
+    MInfinity * Infinity  = MInfinity
+    MInfinity * MInfinity = Infinity
+
+    abs (Finite n) = Finite (abs n)
+    abs _          = Infinity
+
+    signum (Finite n) = Finite (signum n)
+    signum MInfinity  = (-1)
+    signum Infinity   = 1
+
+    fromInteger n = Finite (fromInteger n)
+
+    negate (Finite n) = Finite (-n)
+    negate Infinity = MInfinity
+    negate MInfinity = Infinity
+
+
+-- | If the number is finite, return the finite component.
+toFinite :: InfInt -> Maybe Int
+toFinite (Finite n) = Just n
+toFinite Infinity   = Nothing
+toFinite MInfinity  = Nothing
+
+-- | @isFinite = isJust . toFinite@
+isFinite :: InfInt -> Bool
+isFinite (Finite _) = True
+isFinite _          = False
diff --git a/src/System/IO/Terminal.hs b/src/System/IO/Terminal.hs
new file mode 100644
index 0000000..0846d9f
--- /dev/null
+++ b/src/System/IO/Terminal.hs
@@ -0,0 +1,31 @@
+{-|
+Module      : System.IO.Terminal
+Copyright   : (c) UU, 2019
+License     : MIT
+Maintainer  : Tom Smeding
+Stability   : experimental
+Portability : POSIX, macOS, Windows
+
+Top-level module for building an application using terminal I/O.
+
+The library is loosely modelled after the [termio](https://github.com/tomsmeding/termio)
+library for C. See the documentation of the re-exported modules for more
+information.
+-}
+module System.IO.Terminal
+    (module System.IO.Terminal.Input
+    ,module System.IO.Terminal.Render
+    ,TUI, withTUI)
+    where
+
+import Control.Monad.Trans
+import System.IO.Terminal.Input
+import System.IO.Terminal.Render
+
+
+-- | The monad for doing terminal I/O operations.
+type TUI = RenderT Input
+
+-- | Run a 'TUI' computation in the 'IO' monad.
+withTUI :: TUI a -> IO a
+withTUI = withInput . withRender
diff --git a/src/System/IO/Terminal/Characters.hs b/src/System/IO/Terminal/Characters.hs
new file mode 100644
index 0000000..85f8b5f
--- /dev/null
+++ b/src/System/IO/Terminal/Characters.hs
@@ -0,0 +1,140 @@
+{-|
+Module      : System.IO.Terminal.Characters
+Copyright   : (c) UU, 2019
+License     : MIT
+Maintainer  : Tom Smeding
+Stability   : experimental
+Portability : POSIX, macOS, Windows
+
+Access to a small database of box-drawing characters.
+-}
+module System.IO.Terminal.Characters
+    (boxChar, BoxChar, BoxWeight(..))
+    where
+
+import qualified Data.Map.Strict as Map
+
+
+-- | Description of a box-drawing character: (up, right, down, left)
+type BoxChar = (BoxWeight, BoxWeight, BoxWeight, BoxWeight)
+
+-- | Description of one arm of a box-drawing character.
+data BoxWeight = BoxNone | BoxSingle | BoxHeavy | BoxDouble
+  deriving (Eq, Ord, Show)
+
+-- | Look up a box drawing character in the unicode table. Note that not
+-- all combinations are valid; currently, the function throws an error if
+-- the character doesn't exist.
+boxChar :: BoxChar -> Char
+boxChar tup = mapping Map.! tup
+  where
+    mapping = Map.fromList
+        [((BoxNone, BoxNone, BoxNone, BoxSingle), '╴')
+        ,((BoxNone, BoxNone, BoxNone, BoxHeavy), '╸')
+        ,((BoxSingle, BoxNone, BoxNone, BoxNone), '╵')
+        ,((BoxHeavy, BoxNone, BoxNone, BoxNone), '╹')
+        ,((BoxNone, BoxSingle, BoxNone, BoxNone), '╶')
+        ,((BoxNone, BoxHeavy, BoxNone, BoxNone), '╺')
+        ,((BoxNone, BoxNone, BoxSingle, BoxNone), '╷')
+        ,((BoxNone, BoxNone, BoxHeavy, BoxNone), '╻')
+        ,((BoxNone, BoxSingle, BoxNone, BoxSingle), '─')
+        ,((BoxNone, BoxHeavy, BoxNone, BoxHeavy), '━')
+        ,((BoxNone, BoxHeavy, BoxNone, BoxSingle), '╼')
+        ,((BoxNone, BoxSingle, BoxNone, BoxHeavy), '╾')
+        ,((BoxSingle, BoxNone, BoxSingle, BoxNone), '│')
+        ,((BoxHeavy, BoxNone, BoxHeavy, BoxNone), '┃')
+        ,((BoxSingle, BoxNone, BoxHeavy, BoxNone), '╽')
+        ,((BoxHeavy, BoxNone, BoxSingle, BoxNone), '╿')
+        ,((BoxNone, BoxSingle, BoxSingle, BoxNone), '┌')
+        ,((BoxNone, BoxHeavy, BoxSingle, BoxNone), '┍')
+        ,((BoxNone, BoxSingle, BoxHeavy, BoxNone), '┎')
+        ,((BoxNone, BoxHeavy, BoxHeavy, BoxNone), '┏')
+        ,((BoxNone, BoxNone, BoxSingle, BoxSingle), '┐')
+        ,((BoxNone, BoxNone, BoxSingle, BoxHeavy), '┑')
+        ,((BoxNone, BoxNone, BoxHeavy, BoxSingle), '┒')
+        ,((BoxNone, BoxNone, BoxHeavy, BoxHeavy), '┓')
+        ,((BoxSingle, BoxSingle, BoxNone, BoxNone), '└')
+        ,((BoxSingle, BoxHeavy, BoxNone, BoxNone), '┕')
+        ,((BoxHeavy, BoxSingle, BoxNone, BoxNone), '┖')
+        ,((BoxHeavy, BoxHeavy, BoxNone, BoxNone), '┗')
+        ,((BoxSingle, BoxNone, BoxNone, BoxSingle), '┘')
+        ,((BoxSingle, BoxNone, BoxNone, BoxHeavy), '┙')
+        ,((BoxHeavy, BoxNone, BoxNone, BoxSingle), '┚')
+        ,((BoxHeavy, BoxNone, BoxNone, BoxHeavy), '┛')
+        ,((BoxSingle, BoxSingle, BoxSingle, BoxNone), '├')
+        ,((BoxSingle, BoxHeavy, BoxSingle, BoxNone), '┝')
+        ,((BoxHeavy, BoxSingle, BoxSingle, BoxNone), '┞')
+        ,((BoxSingle, BoxSingle, BoxHeavy, BoxNone), '┟')
+        ,((BoxHeavy, BoxSingle, BoxHeavy, BoxNone), '┠')
+        ,((BoxHeavy, BoxHeavy, BoxSingle, BoxNone), '┡')
+        ,((BoxSingle, BoxHeavy, BoxHeavy, BoxNone), '┢')
+        ,((BoxHeavy, BoxHeavy, BoxHeavy, BoxNone), '┣')
+        ,((BoxSingle, BoxNone, BoxSingle, BoxSingle), '┤')
+        ,((BoxSingle, BoxNone, BoxSingle, BoxHeavy), '┥')
+        ,((BoxHeavy, BoxNone, BoxSingle, BoxSingle), '┦')
+        ,((BoxSingle, BoxNone, BoxHeavy, BoxSingle), '┧')
+        ,((BoxHeavy, BoxNone, BoxHeavy, BoxSingle), '┨')
+        ,((BoxHeavy, BoxNone, BoxSingle, BoxHeavy), '┩')
+        ,((BoxSingle, BoxNone, BoxHeavy, BoxHeavy), '┪')
+        ,((BoxHeavy, BoxNone, BoxHeavy, BoxHeavy), '┫')
+        ,((BoxNone, BoxSingle, BoxSingle, BoxSingle), '┬')
+        ,((BoxNone, BoxSingle, BoxSingle, BoxHeavy), '┭')
+        ,((BoxNone, BoxHeavy, BoxSingle, BoxSingle), '┮')
+        ,((BoxNone, BoxHeavy, BoxSingle, BoxHeavy), '┯')
+        ,((BoxNone, BoxSingle, BoxHeavy, BoxSingle), '┰')
+        ,((BoxNone, BoxSingle, BoxHeavy, BoxHeavy), '┱')
+        ,((BoxNone, BoxHeavy, BoxHeavy, BoxSingle), '┲')
+        ,((BoxNone, BoxHeavy, BoxHeavy, BoxHeavy), '┳')
+        ,((BoxSingle, BoxSingle, BoxNone, BoxSingle), '┴')
+        ,((BoxSingle, BoxSingle, BoxNone, BoxHeavy), '┵')
+        ,((BoxSingle, BoxHeavy, BoxNone, BoxSingle), '┶')
+        ,((BoxSingle, BoxHeavy, BoxNone, BoxHeavy), '┷')
+        ,((BoxHeavy, BoxSingle, BoxNone, BoxSingle), '┸')
+        ,((BoxHeavy, BoxSingle, BoxNone, BoxHeavy), '┹')
+        ,((BoxHeavy, BoxHeavy, BoxNone, BoxSingle), '┺')
+        ,((BoxHeavy, BoxHeavy, BoxNone, BoxHeavy), '┻')
+        ,((BoxSingle, BoxSingle, BoxSingle, BoxSingle), '┼')
+        ,((BoxSingle, BoxSingle, BoxSingle, BoxHeavy), '┽')
+        ,((BoxSingle, BoxHeavy, BoxSingle, BoxSingle), '┾')
+        ,((BoxSingle, BoxHeavy, BoxSingle, BoxHeavy), '┿')
+        ,((BoxHeavy, BoxSingle, BoxSingle, BoxSingle), '╀')
+        ,((BoxSingle, BoxSingle, BoxHeavy, BoxSingle), '╁')
+        ,((BoxHeavy, BoxSingle, BoxHeavy, BoxSingle), '╂')
+        ,((BoxHeavy, BoxSingle, BoxSingle, BoxHeavy), '╃')
+        ,((BoxHeavy, BoxHeavy, BoxSingle, BoxSingle), '╄')
+        ,((BoxSingle, BoxSingle, BoxHeavy, BoxHeavy), '╅')
+        ,((BoxSingle, BoxHeavy, BoxHeavy, BoxSingle), '╆')
+        ,((BoxHeavy, BoxHeavy, BoxSingle, BoxHeavy), '╇')
+        ,((BoxSingle, BoxHeavy, BoxHeavy, BoxHeavy), '╈')
+        ,((BoxHeavy, BoxSingle, BoxHeavy, BoxHeavy), '╉')
+        ,((BoxHeavy, BoxHeavy, BoxHeavy, BoxSingle), '╊')
+        ,((BoxHeavy, BoxHeavy, BoxHeavy, BoxHeavy), '╋')
+        ,((BoxNone, BoxDouble, BoxNone, BoxDouble), '═')
+        ,((BoxDouble, BoxNone, BoxDouble, BoxNone), '║')
+        ,((BoxNone, BoxDouble, BoxSingle, BoxNone), '╒')
+        ,((BoxNone, BoxSingle, BoxDouble, BoxNone), '╓')
+        ,((BoxNone, BoxDouble, BoxDouble, BoxNone), '╔')
+        ,((BoxNone, BoxNone, BoxSingle, BoxDouble), '╕')
+        ,((BoxNone, BoxNone, BoxDouble, BoxSingle), '╖')
+        ,((BoxNone, BoxNone, BoxDouble, BoxDouble), '╗')
+        ,((BoxSingle, BoxDouble, BoxNone, BoxNone), '╘')
+        ,((BoxDouble, BoxSingle, BoxNone, BoxNone), '╙')
+        ,((BoxDouble, BoxDouble, BoxNone, BoxNone), '╚')
+        ,((BoxSingle, BoxNone, BoxNone, BoxDouble), '╛')
+        ,((BoxDouble, BoxNone, BoxNone, BoxSingle), '╜')
+        ,((BoxDouble, BoxNone, BoxNone, BoxDouble), '╝')
+        ,((BoxSingle, BoxDouble, BoxSingle, BoxNone), '╞')
+        ,((BoxDouble, BoxSingle, BoxDouble, BoxNone), '╟')
+        ,((BoxDouble, BoxDouble, BoxDouble, BoxNone), '╠')
+        ,((BoxSingle, BoxNone, BoxSingle, BoxDouble), '╡')
+        ,((BoxDouble, BoxNone, BoxDouble, BoxSingle), '╢')
+        ,((BoxDouble, BoxNone, BoxDouble, BoxDouble), '╣')
+        ,((BoxNone, BoxDouble, BoxSingle, BoxDouble), '╤')
+        ,((BoxNone, BoxSingle, BoxDouble, BoxSingle), '╥')
+        ,((BoxNone, BoxDouble, BoxDouble, BoxDouble), '╦')
+        ,((BoxSingle, BoxDouble, BoxNone, BoxDouble), '╧')
+        ,((BoxDouble, BoxSingle, BoxNone, BoxSingle), '╨')
+        ,((BoxDouble, BoxDouble, BoxNone, BoxDouble), '╩')
+        ,((BoxSingle, BoxDouble, BoxSingle, BoxDouble), '╪')
+        ,((BoxDouble, BoxSingle, BoxDouble, BoxSingle), '╫')
+        ,((BoxDouble, BoxDouble, BoxDouble, BoxDouble), '╬')]
diff --git a/src/System/IO/Terminal/IO.hs b/src/System/IO/Terminal/IO.hs
new file mode 100644
index 0000000..fb0f1c2
--- /dev/null
+++ b/src/System/IO/Terminal/IO.hs
@@ -0,0 +1,57 @@
+{-|
+Module      : System.IO.Terminal.IO
+Copyright   : (c) UU, 2019
+License     : MIT
+Maintainer  : Tom Smeding
+Stability   : experimental
+Portability : POSIX, macOS, Windows
+
+Extra terminal management utility functions. This module basically extends
+the @ansi-terminal@ package.
+-}
+module System.IO.Terminal.IO
+    (queryTermSize
+    -- ,withWinchHandler
+    ,toAlternateScreen
+    ,fromAlternateScreen)
+    where
+
+-- import Foreign.C.Types
+import qualified System.Console.Terminal.Size as TS
+-- import System.Exit
+import System.IO
+-- import System.Posix.Signals
+
+
+-- sigWINCH :: CInt
+-- sigWINCH = 28
+
+
+-- | Request the current terminal size from the terminal. Probably not very
+-- fast.
+queryTermSize :: IO (Int, Int)
+queryTermSize = TS.size >>= \case
+    Just win -> return (TS.width win, TS.height win)
+    Nothing  -> error "Cannot get terminal size"
+
+-- withWinchHandler :: IO () -> IO a -> IO a
+-- withWinchHandler h act = do
+--     prevh <- installHandler sigWINCH (Catch h) Nothing
+--     case prevh of
+--         Default -> return ()
+--         Ignore -> return ()
+--         _ -> die "ERROR: A signal handler was already installed for the WINCH signal!"
+
+--     res <- act
+
+--     _ <- installHandler sigWINCH prevh Nothing
+--     return res
+
+-- | Switch to the \"alternate screen\", if the terminal supports it.
+toAlternateScreen :: IO ()
+toAlternateScreen = putStr "\x1B[?1049h" >> hFlush stdout
+
+-- | Switch from the \"alternate screen\" back to the normal buffer, if the
+-- terminal supports it.
+fromAlternateScreen :: IO ()
+fromAlternateScreen = putStr "\x1B[?1049l" >> hFlush stdout
diff --git a/src/System/IO/Terminal/Input.hs b/src/System/IO/Terminal/Input.hs
new file mode 100644
index 0000000..86db30d
--- /dev/null
+++ b/src/System/IO/Terminal/Input.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleInstances #-}
+{-|
+Module      : System.IO.Terminal.Input
+Copyright   : (c) UU, 2019
+License     : MIT
+Maintainer  : Tom Smeding
+Stability   : experimental
+Portability : POSIX, macOS, Windows
+
+Keyboard input for console applications.
+
+A monad transformer is defined that allows reading keys from the
+keyboard in symbolic form, i.e. escape sequences have already been
+parsed.
+-}
+module System.IO.Terminal.Input
+    (InputT, Input, withInput, liftIO, MonadInput(..)
+    ,Key(..)
+    ,InfInt(..), readKey)
+    where
+
+import Control.Monad.Trans
+import Control.Monad.State.Strict
+import Data.Maybe
+import Numeric.InfInt
+import System.IO.Terminal.Render
+import System.IO.Terminal.Input.Key
+import System.IO.Terminal.Input.SeqParser
+-- import qualified Utils.Debug as Debug
+import Utils.Time
+
+#if defined(OS_LINUX) || defined(OS_MACOS)
+import System.IO.Terminal.Input.Posix
+#else
+import System.IO.Terminal.Input.Windows
+#endif
+
+
+-- | Escape sequence timeout in milliseconds.
+gEscTimeoutMS :: Int
+gEscTimeoutMS = 100
+
+
+-- | The keyboard input monad transformer. The contained monad must be
+-- a monad over 'IO'.
+newtype InputT m a = InputT (StateT InputState m a)
+  deriving (Functor, Applicative, Monad, MonadState InputState, MonadTrans)
+
+deriving instance MonadIO m => MonadIO (InputT m)
+
+-- | The non-transformer variant of 'InputT'.
+type Input = InputT IO
+
+data InputState = InputState { sKeys :: [Key]
+                             , sParser :: SeqParser (Maybe Char) Key
+                               -- If the timeout event was already returned, Infinity
+                             , sLastKey :: InfInt }
+
+-- | Run an 'Input' computation within an IO-based monad.
+withInput :: MonadIO m => InputT m a -> m a
+withInput (InputT st) =
+    withRawMode $ evalStateT st (InputState [] seqParser Infinity)
+
+
+-- | The behavior class for the 'InputT' monad transformer.
+class Monad m => MonadInput m where
+    -- | Timeout in milliseconds; Infinity is no timeout. Returns Nothing
+    -- in case the timeout was reached.
+    readKeyTimeout :: InfInt -> m (Maybe Key)
+
+instance MonadIO m => MonadInput (InputT m) where
+    readKeyTimeout userTimeout =
+        get >>= \s -> case sKeys s of
+            [] -> do
+                let SeqParser parserFunc = sParser s
+
+                beforeKey <- timestampMS <$> liftIO getSystemTime
+
+                -- These timeouts are either 'Finite timeout' in milliseconds, or 'Infinity' in case
+                -- no timeout is needed.
+                let -- Possibly the amount of time left for the next escape sequence item
+                    escTimeout = let delta = Finite beforeKey - sLastKey s
+                                     left = Finite gEscTimeoutMS - delta
+                                 in if left < 0 then 0 else left
+                    -- We wait until either the user timeout or the escape timeout passes, whichever
+                    -- is earlier
+                    timeoutVal = min userTimeout escTimeout
+
+                -- Debug.logIO ("readKeyTimeout", beforeKey, userTimeout, sLastKey s, escTimeout, timeoutVal)
+
+                ch <- liftIO $ getCharTimeout (toFinite timeoutVal)
+
+                let userTimeoutTriggered = isNothing ch && userTimeout < escTimeout
+                -- If we hit the user timeout, return appropriately
+                if userTimeoutTriggered
+                    then {-Debug.logIO "returning Nothing" >>-} return Nothing
+                    else do
+                        -- We either got an actual key, or we hit the escape timeout. In either
+                        -- case, we advance the escape sequence parser.
+                        let (ks, p') = parserFunc ch
+                        -- Debug.logIO ("keys", ks)
+
+                        -- If we got an escape timeout, we'll be reporting it so we mark the last
+                        -- key as "long ago" to not report an escape timeout twice to the parser.
+                        -- Otherwise, we "start the escape timer" by storing the time of receipt of
+                        -- this key.
+                        afterKey <- timestampMS <$> liftIO getSystemTime
+                        let newLastKey = maybe Infinity (const $ Finite afterKey) ch
+                        modify $ \s' -> s' { sKeys = ks, sParser = p', sLastKey = newLastKey }
+
+                        -- Either way, we stored some stuff in sKeys, so either that contains keys
+                        -- to return, or we got nothing yet and need to retry; recursing handles
+                        -- both cases nicely.
+                        let userLeft = userTimeout - Finite (afterKey - beforeKey)
+                        readKeyTimeout userLeft
+
+            (k:ks) -> do
+                put (s { sKeys = ks })
+                -- Debug.logIO (Just k)
+                return (Just k)
+
+instance MonadInput (RenderT Input) where
+    readKeyTimeout = lift . readKeyTimeout
+
+-- | Read a key from standard input without timeout. Shortcut for
+-- @readKeyTimeout Infinity@.
+readKey :: MonadInput m => m Key
+readKey = fromJust <$> readKeyTimeout Infinity
diff --git a/src/System/IO/Terminal/Input/Key.hs b/src/System/IO/Terminal/Input/Key.hs
new file mode 100644
index 0000000..40b52c3
--- /dev/null
+++ b/src/System/IO/Terminal/Input/Key.hs
@@ -0,0 +1,27 @@
+{-|
+Module      : System.IO.Terminal.Input.Key
+Copyright   : (c) UU, 2019
+License     : MIT
+Maintainer  : Tom Smeding
+Stability   : experimental
+Portability : POSIX, macOS, Windows
+-}
+module System.IO.Terminal.Input.Key where
+
+
+-- | A keypress. This does not attempt to model all possible keypresses
+-- that the user may enter, since not all can be recognised in the terminal
+-- anyway. The argument to 'KInvalid' contains some description of the
+-- unknown key.
+data Key = KChar Char
+         | KUp | KDown | KRight | KLeft
+         | KEnter | KDelete | KBackspace
+         | KPageDown | KPageUp | KHome | KEnd
+         | KTab
+         | KEsc
+         | KMod { kShift :: Bool
+                , kCtrl :: Bool
+                , kAlt :: Bool
+                , kKey :: Key }
+         | KInvalid String
+  deriving (Eq, Ord, Show)
diff --git a/src/System/IO/Terminal/Input/Posix.hs b/src/System/IO/Terminal/Input/Posix.hs
new file mode 100644
index 0000000..85f0268
--- /dev/null
+++ b/src/System/IO/Terminal/Input/Posix.hs
@@ -0,0 +1,187 @@
+{-|
+Module      : System.IO.Terminal.Input.Posix
+Copyright   : (c) UU, 2019
+License     : MIT
+Maintainer  : Tom Smeding
+Stability   : experimental
+Portability : POSIX, macOS
+
+Platform-specific submodule of "System.IO.Terminal.Input" that works on POSIX-like platforms.
+-}
+module System.IO.Terminal.Input.Posix
+    (withRawMode, getCharTimeout
+    ,seqParser)
+    where
+
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.Char
+import Data.Function
+import Data.List
+import Data.Maybe
+import System.IO
+import System.IO.Terminal.Input.Key
+import System.IO.Terminal.Input.SeqParser
+import System.Timeout
+
+
+-- | Run an IO-monadic computation with terminal input buffering and echo
+-- turned off.
+withRawMode :: MonadIO m => m a -> m a
+withRawMode = withNoBuffering . withNoEcho
+  where
+    withNoBuffering = with (hGetBuffering stdin `takeLeft` hSetBuffering stdin NoBuffering) (hSetBuffering stdin)
+    withNoEcho      = with (hGetEcho stdin      `takeLeft` hSetEcho stdin False)            (hSetEcho stdin)
+    with start stop act = do
+        val <- liftIO start
+        res <- act
+        _ <- liftIO $ stop val
+        return res
+    takeLeft a b = a >>= \x -> b >> return x
+
+
+peekIO :: Show a => IO a -> IO a
+-- peekIO act = act >>= \x -> print ("peekIO", x) >> return x
+peekIO = id
+
+-- | Get a character from standard input, returning Nothing if no character
+-- has appeared after the specified number of milliseconds.
+getCharTimeout :: Maybe Int -> IO (Maybe Char)
+getCharTimeout (Just timeoutms) = peekIO (timeout (1000 * timeoutms) getChar)
+getCharTimeout Nothing = peekIO (Just <$> getChar)
+
+
+-- | An ANSI escape sequence parser. Pass Nothing to the input if the time
+-- between the surrounding characters was "very long", for some definition
+-- of "very long" (a reasonable value is ~10ms). This timeout value is used
+-- to determine whether certain characters belong together in an escape
+-- sequence or are just unrelated keys.
+seqParser :: SeqParser (Maybe Char) Key
+seqParser = SeqParser $ \case
+    Nothing     -> ([], seqParser)
+    Just '\ESC' -> ([], escParser)
+    Just c      -> ([recogSingle c], seqParser)
+  where
+    escParser :: SeqParser (Maybe Char) Key
+    escParser = SeqParser $ \case
+        Nothing     -> ([KEsc], seqParser)
+        Just '\ESC' -> ([], escEscParser)
+        Just '['    -> ([], ansiParser)
+        Just c      -> ([addAlt (recogSingle c)], seqParser)
+
+    escEscParser :: SeqParser (Maybe Char) Key
+    escEscParser = SeqParser $ \case
+        Nothing     -> ([addAlt KEsc], seqParser)
+        Just '['    -> ([], fmap1st addAlt ansiParser)
+        Just '\ESC' -> ([addAlt KEsc], escParser)
+        Just c      -> ([addAlt KEsc, KChar c], seqParser)
+
+    ansiParser :: SeqParser (Maybe Char) Key
+    ansiParser = fmap recogSequence (untilRangeParser (chr 0x40, chr 0x7e) 64)
+                    `followedBy` seqParser
+      where
+        recogSequence :: Maybe [Char] -> Key
+        recogSequence mstr = fromMaybe (KInvalid (show mstr)) $ do
+            str <- mstr
+            guard (not $ null str)
+            guard (length str < 64)
+            args <- parseArguments (init str)
+            recognise args (last str)
+
+    parseArguments :: String -> Maybe [Int]
+    parseArguments = collect . groupBy ((==) `on` isDigit)
+      where
+        collect :: [String] -> Maybe [Int]
+        collect []
+            = Just []
+        collect [num] | Just val <- parseNum num
+            = Just [val]
+        collect (num:sep:args) | Just val <- parseNum num, validSep sep
+            = (val:) <$> collect args
+        collect _
+            = Nothing
+
+    parseNum :: String -> Maybe Int
+    parseNum "" = Nothing
+    parseNum str
+        | all isDigit str = Just (read str)
+        | otherwise       = Nothing
+
+    validSep :: String -> Bool
+    validSep ";" = True
+    validSep ":" = True
+    validSep _   = False
+
+    -- Terminating character is included in string
+    -- If a timeout occurs, returns Nothing
+    untilRangeParser :: (Char, Char) -> Int -> SeqParserOnce (Maybe Char) (Maybe [Char])
+    untilRangeParser (from, to) maxlen = SeqParserOnce (charHandler 0)
+      where
+        charHandler :: Int -> Maybe Char -> SeqParserOnce' (Maybe Char) (Maybe [Char])
+        charHandler _   Nothing    = SeqParserVal Nothing
+        charHandler len (Just c)
+            | len >= maxlen        = SeqParserVal Nothing
+            | from <= c && c <= to = SeqParserVal (Just [c])
+            | otherwise            = SeqParserOnce' $ \mc' -> let rec = charHandler (len + 1) mc'
+                                                              in fmap (fmap (c :)) rec
+
+    recognise :: [Int] -> Char -> Maybe Key
+    recognise args   'A' = Just (arrowMod args KUp)
+    recognise args   'B' = Just (arrowMod args KDown)
+    recognise args   'C' = Just (arrowMod args KRight)
+    recognise args   'D' = Just (arrowMod args KLeft)
+    recognise []     'H' = Just KHome
+    recognise [1,2]  'H' = Just (addShift KHome)
+    recognise [1,5]  'H' = Just (addCtrl KHome)
+    recognise [1,6]  'H' = Just (addShift $ addCtrl KHome)
+    recognise [1,9]  'H' = Just (addAlt KHome)
+    recognise [1,13] 'H' = Just (addCtrl $ addAlt KHome)
+    recognise [1,10] 'H' = Just (addShift $ addAlt KHome)
+    recognise [1,14] 'H' = Just (addCtrl $ addShift $ addAlt KHome)
+    recognise []     'F' = Just KEnd
+    recognise [1,2]  'F' = Just (addShift KEnd)
+    recognise [1,5]  'F' = Just (addCtrl KEnd)
+    recognise [1,6]  'F' = Just (addShift $ addCtrl KEnd)
+    recognise [1,9]  'F' = Just (addAlt KEnd)
+    recognise [1,13] 'F' = Just (addCtrl $ addAlt KEnd)
+    recognise [1,10] 'F' = Just (addShift $ addAlt KEnd)
+    recognise [1,14] 'F' = Just (addCtrl $ addShift $ addAlt KEnd)
+    recognise _      'Z' = Just (addShift KTab)
+    recognise []     '~' = Just KDelete
+    recognise [1]    '~' = Just KHome
+    recognise [3]    '~' = Just KDelete
+    recognise [4]    '~' = Just KEnd
+    recognise [5]    '~' = Just KPageUp
+    recognise [6]    '~' = Just KPageDown
+    recognise [n,2]  '~' = addShift <$> recognise [n] '~'
+    recognise [n,5]  '~' = addCtrl  <$> recognise [n] '~'
+    recognise _      _   = Nothing
+
+    recogSingle :: Char -> Key
+    recogSingle '\HT'  = KTab
+    recogSingle '\LF'  = KEnter
+    recogSingle '\CR'  = KEnter
+    recogSingle '\DEL' = KBackspace
+    recogSingle '\NUL' = addCtrl (KChar ' ')
+    recogSingle c
+        | ord c < 27                = addCtrl (KChar (chr $ ord 'a' - 1 + ord c))
+        | 32 <= ord c, ord c <= 126 = KChar c
+        | otherwise                 = KInvalid [c]
+
+    arrowMod :: [Int] -> Key -> Key
+    arrowMod [1,2] = addShift
+    arrowMod [1,3] = addAlt
+    arrowMod [1,5] = addCtrl
+    arrowMod [1,6] = addCtrl . addShift
+    arrowMod [1,7] = addCtrl . addAlt
+    arrowMod _     = id  -- in particular, []
+
+    addCtrl, addShift, addAlt :: Key -> Key
+    addCtrl  = kmodify (\km -> km { kCtrl  = True })
+    addShift = kmodify (\km -> km { kShift = True })
+    addAlt   = kmodify (\km -> km { kAlt   = True })
+
+    kmodify :: (Key -> Key) -> Key -> Key
+    kmodify f k@(KMod {})  = f k
+    kmodify _ (KInvalid s) = KInvalid s
+    kmodify f k            = f (KMod False False False k)
diff --git a/src/System/IO/Terminal/Input/SeqParser.hs b/src/System/IO/Terminal/Input/SeqParser.hs
new file mode 100644
index 0000000..8dfdafc
--- /dev/null
+++ b/src/System/IO/Terminal/Input/SeqParser.hs
@@ -0,0 +1,49 @@
+{-|
+Module      : System.IO.Terminal.Input.SeqParser
+Copyright   : (c) UU, 2019
+License     : MIT
+Maintainer  : Tom Smeding
+Stability   : experimental
+Portability : POSIX, macOS, Windows
+
+This module defines a coroutine-like, finite-state-machine-like type,
+'SeqParser'. Sequence parsers consume an infinite stream of values,
+producing zero or more output values after each input value read. The
+described parser is explicitly lazy to have full and explicit control over
+the amount of input necessary to produce an output value.
+-}
+module System.IO.Terminal.Input.SeqParser where
+
+
+-- | Consumes an explicitly lazy stream of @a@\'s, producing a staggered
+-- infinite stream of @b@\'s.
+newtype SeqParser a b = SeqParser (a -> ([b], SeqParser a b))
+
+-- | Consumes an explicitly lazy stream of @a@\'s, and after some nonzero
+-- number of such values, produces a @b@.
+data SeqParserOnce  a b = SeqParserOnce (a -> SeqParserOnce' a b)
+-- | A 'SeqParserOnce' that does not guarantee to consume at least one
+-- @a@.
+data SeqParserOnce' a b = SeqParserOnce' (a -> SeqParserOnce' a b) | SeqParserVal b
+
+-- | Modify the next result from the 'SeqParser'.
+fmap1st :: (b -> b) -> SeqParser a b -> SeqParser a b
+fmap1st f (SeqParser g) =
+    SeqParser $ \a -> case g a of
+                        ([], p)     -> ([], fmap1st f p)
+                        (b : bs, p) -> (f b : bs, p)
+
+instance Functor (SeqParserOnce a) where
+    fmap f (SeqParserOnce g) = SeqParserOnce (fmap f . g)
+
+instance Functor (SeqParserOnce' a) where
+    fmap f (SeqParserVal x)   = SeqParserVal (f x)
+    fmap f (SeqParserOnce' g) = SeqParserOnce' (fmap f . g)
+
+-- | After the 'SeqParserOnce' is done, continue processing input with the
+-- 'SeqParser'.
+followedBy :: SeqParserOnce a b -> SeqParser a b -> SeqParser a b
+followedBy (SeqParserOnce g) p =
+    SeqParser $ \a -> case g a of
+        SeqParserVal b    -> ([b], p)
+        SeqParserOnce' g' -> ([], SeqParserOnce g' `followedBy` p)
diff --git a/src/System/IO/Terminal/Input/Windows.hs b/src/System/IO/Terminal/Input/Windows.hs
new file mode 100644
index 0000000..0ac4122
--- /dev/null
+++ b/src/System/IO/Terminal/Input/Windows.hs
@@ -0,0 +1,80 @@
+{-|
+Module      : System.IO.Terminal.Input.Windows
+Copyright   : (c) UU, 2019
+License     : MIT
+Maintainer  : Tom Smeding
+Stability   : experimental
+Portability : Windows
+
+Platform-specific submodule of "System.IO.Terminal.Input" that works on Windows.
+-}
+module System.IO.Terminal.Input.Windows
+    (withRawMode, getCharTimeout
+    ,seqParser)
+    where
+
+import Control.Monad.IO.Class
+import Data.Char
+import System.IO.HiddenChar
+import System.IO.Terminal.Input.Key
+import System.IO.Terminal.Input.SeqParser
+
+
+-- | Run an IO-monadic computation with terminal input buffering and echo
+-- turned off.
+--
+-- Note: on Windows this is currently nonfunctional.
+withRawMode :: MonadIO m => m a -> m a
+withRawMode = id
+
+
+peekIO :: Show a => IO a -> IO a
+-- peekIO act = act >>= \x -> print ("peekIO", x) >> return x
+peekIO = id
+
+-- | Get a character from standard input, returning Nothing if no character
+-- has appeared after the specified number of milliseconds.
+--
+-- Note: on Windows the timeout is currently ineffective.
+getCharTimeout :: Maybe Int -> IO (Maybe Char)
+getCharTimeout _ = peekIO (Just <$> getHiddenChar)
+
+
+-- | A Windows conio control sequence parser. Pass Nothing to the input if
+-- the time between the surrounding characters was "very long", for some
+-- definition of "very long" (a reasonable value is ~10ms). This timeout
+-- value is used to determine whether certain characters belong together in
+-- an escape sequence or are just unrelated keys.
+seqParser :: SeqParser (Maybe Char) Key
+seqParser = SeqParser $ \case
+    Nothing     -> ([], seqParser)
+    Just '\224' -> ([], escParser)
+    Just c      -> ([recogSingle c], seqParser)
+  where
+    escParser :: SeqParser (Maybe Char) Key
+    escParser = SeqParser $ \case
+        Nothing  -> ([KInvalid "timeout"], seqParser)
+        Just 'H' -> ([KUp], seqParser)
+        Just 'P' -> ([KDown], seqParser)
+        Just 'M' -> ([KRight], seqParser)
+        Just 'K' -> ([KLeft], seqParser)
+        Just c   -> ([KInvalid ['\224', c]], seqParser)
+
+    recogSingle :: Char -> Key
+    recogSingle '\ESC' = KEsc
+    recogSingle '\HT'  = KTab
+    recogSingle '\LF'  = KEnter
+    recogSingle '\CR'  = KEnter
+    recogSingle '\BS'  = KBackspace
+    recogSingle '\NUL' = addCtrl (KChar ' ')
+    recogSingle c
+        | ord c < 27                = addCtrl (KChar (chr $ ord 'a' - 1 + ord c))
+        | 32 <= ord c, ord c <= 126 = KChar c
+        | otherwise                 = KInvalid [c]
+
+    addCtrl :: Key -> Key
+    addCtrl  = kmodify (\km -> km { kCtrl  = True })
+
+    kmodify :: (Key -> Key) -> Key -> Key
+    kmodify f k@(KMod {}) = f k
+    kmodify f k           = f (KMod False False False k)
diff --git a/src/System/IO/Terminal/Render.hs b/src/System/IO/Terminal/Render.hs
new file mode 100644
index 0000000..6939c9f
--- /dev/null
+++ b/src/System/IO/Terminal/Render.hs
@@ -0,0 +1,312 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}
+{-|
+Module      : System.IO.Terminal.Render
+Copyright   : (c) UU, 2019
+License     : MIT
+Maintainer  : Tom Smeding
+Stability   : experimental
+Portability : POSIX, macOS, Windows
+
+Double-buffering terminal UI library.
+
+This library was inspired by [ncurses](https://www.gnu.org/software/ncurses/ncurses.html)
+in type of functionality and by [termio](https://github.com/tomsmeding/termio)
+in featureset and API. It offers a double-buffered interface for writing
+text on the terminal without being bound to the classical sequential-output
+model that one gets when just printing text without regard for the extra
+features of the terminal.
+
+The API is an imperative DSL that runs in the 'RenderT' monad
+transformer. Because the draw buffer (on which the drawing commands
+operate) is separate from the screen buffer (in which the actual screen
+contents live) (hence "double-buffered"), the user needs to
+__explicitly__ commit their changes to the screen using the 'redraw'
+function. The upside of this is that only the parts of the interface
+that actually changed since the last update are committed to the
+screen.
+
+Functions that write text to the draw buffer generally take the text
+position as an argument, so there is no "current cursor position" in
+the API. On the other hand, the drawing style /is/ stateful, in that
+the current foreground/background color and text formatting rules apply
+for all subsequent writes until the current style is changed to
+something else.
+
+All positions in the terminal are in (x, y) format, where the top-left
+corner is (0, 0).
+-}
+module System.IO.Terminal.Render
+    (Style(..), RGB, defaultStyle
+    ,RenderT, Render, withRender, liftIO
+    ,getTermSize
+    ,redraw, redrawFull
+    ,write, putc
+    ,readPixel
+    ,setStyle, setFg, setBg, setBold, setUnderline
+    ,savingStyle
+    ,fillRect, clearScreen
+    ,bel
+    ,module System.IO.Terminal.Characters)
+    where
+
+import Control.Concurrent
+import Control.Monad.State.Strict
+import Data.Array.IO
+import Data.Colour.SRGB hiding (RGB)
+import Data.Foldable (toList)
+import Data.Word
+import qualified System.Console.ANSI as A
+import System.Exit
+import System.IO
+import System.IO.Terminal.Characters
+import qualified System.IO.Terminal.IO as IO
+import Utils.Monad
+
+
+-- NOTE ON COORDINATES
+-- Friendly coordinates are in the form (x, y), but the world is not
+-- friendly.
+-- * Function arguments: (x, y)
+-- * Array indices: (y, x)
+-- * A.setCursorPosition: (y, x)
+-- Unless explicitly indicated otherwise.
+
+-- Other notes
+-- - For box-drawing characters, it _may_ be necessary to write the C0
+--   codes SO and SI; see https://stackoverflow.com/a/4499628
+
+
+-- | A color in red-green-blue format. (255, 255, 255) is white.
+type RGB = (Word8, Word8, Word8)
+
+-- | The monad transformer on which the drawing commands operate. The
+-- wrapped monad should be a monad over 'IO' (i.e. needs to be an instance
+-- of 'MonadIO').
+newtype RenderT m a = RenderT { unRenderT :: StateT RState m a }
+  deriving (Functor, Applicative, Monad, MonadState RState, MonadTrans)
+
+deriving instance MonadIO m => MonadIO (RenderT m)
+
+-- | A convenience type alias for if 'Render' is the bottom-most monad in
+-- the stack.
+type Render = RenderT IO
+
+data RState = RState { rDrawBuffer :: !(IOArray (Int, Int) Cell)
+                     , rScreenBuffer :: !(IOArray (Int, Int) Cell)
+                     , rCurrentStyle :: !Style }
+
+data Cell = Cell { cChar :: !Char
+                 , cStyle :: !Style }
+  deriving (Eq, Show)
+
+-- | A drawing style. If a color is 'Nothing', it is the color that the
+-- terminal uses by default.
+data Style = Style { sFg :: !(Maybe RGB)
+                   , sBg :: !(Maybe RGB)
+                   , sBold :: !Bool
+                   , sUnderline :: !Bool }
+  deriving (Eq, Show)
+
+-- | The default style of the terminal, i.e. the style that one would get
+-- without explicit styling in the terminal. Note in particular that the
+-- foreground and background colors may be anything: dark-on-light or
+-- light-on-dark are both possible.
+defaultStyle :: Style
+defaultStyle = Style { sFg = Nothing, sBg = Nothing, sBold = False, sUnderline = False }
+
+initRState :: IO RState
+initRState = do
+    (wid, hei) <- IO.queryTermSize
+    let emptyCell = Cell { cChar = ' ', cStyle = defaultStyle }
+        bufferConstructor = newArray ((0, 0), (hei - 1, wid - 1)) emptyCell
+    drawBuffer <- bufferConstructor
+    screenBuffer <- bufferConstructor
+    return $ RState { rDrawBuffer = drawBuffer
+                    , rScreenBuffer = screenBuffer
+                    , rCurrentStyle = defaultStyle }
+
+-- | Run a 'Render' computation in an IO-monad.
+withRender :: MonadIO m => RenderT m a -> m a
+withRender act = do
+    whenM (liftIO $ not <$> hIsTerminalDevice stdout) $
+        liftIO $ die "ERROR: Stdout is not connected to a terminal!"
+
+    liftIO $ A.hSupportsANSIWithoutEmulation stdout >>= \case
+        Just True  -> return ()
+        Just False -> die "ERROR: Terminal is not capable of interpreting ANSI escape sequences!"
+        Nothing    -> do
+            hPutStrLn stderr "WARNING: Cannot determine terminal capabilities; continuing anyway..."
+            threadDelay 1000000
+
+    liftIO IO.toAlternateScreen
+    liftIO A.clearScreen
+    liftIO A.hideCursor
+    st <- liftIO initRState
+    res <- evalStateT (unRenderT act) st
+    liftIO A.showCursor
+    liftIO IO.fromAlternateScreen
+    return res
+
+-- | Commit the changes from the draw buffer to the screen buffer.
+redraw :: MonadIO m => RenderT m ()
+redraw = redrawGen False
+
+-- | Commit the draw buffer to the screen buffer, disabling the caching
+-- mechanism: this unconditionally redraws the whole screen. This would
+-- normally be bound to e.g. a ctrl-L keyboard shortcut in a terminal
+-- application.
+redrawFull :: MonadIO m => RenderT m ()
+redrawFull = redrawGen True
+
+redrawGen :: MonadIO m => Bool -> RenderT m ()
+redrawGen full = do
+    drawBuffer <- gets rDrawBuffer
+    screenBuffer <- gets rScreenBuffer
+    size@(wid, hei) <- getTermSize
+    let indices = range ((0, 0), (hei - 1, wid - 1))
+
+    liftIO $ do
+        A.setSGR (styleToSGR defaultStyle)
+        foldM_ (applyCell drawBuffer screenBuffer size) (defaultStyle, (-1, -1)) indices
+        hFlush stdout
+
+    liftIO $ copyArray screenBuffer drawBuffer
+  where
+    applyCell :: IOArray (Int, Int) Cell  -- drawbuf
+              -> IOArray (Int, Int) Cell  -- screenbuf
+              -> (Int, Int)               -- screen size@(y, x)
+              -> (Style, (Int, Int))      -- current (style, curpos@(y, x))
+              -> (Int, Int)               -- index@(y, x)
+              -> IO (Style, (Int, Int))   -- new (style, curpos@(y, x))
+    applyCell drawbuf screenbuf size (style, curpos) idx = do
+        dcell <- readArray drawbuf idx
+        scell <- readArray screenbuf idx
+        if dcell /= scell || full
+        then do
+            when (cStyle dcell /= style) $ A.setSGR (styleToSGR (cStyle dcell))
+            when (curpos /= idx) $ uncurry A.setCursorPosition idx
+            putChar (cChar dcell)
+            return (cStyle dcell, incrCursorYX size idx)
+        else do
+            return (style, curpos)
+
+-- | Get the current terminal size. This is a cheap operation.
+getTermSize :: MonadIO m => RenderT m (Int, Int)
+getTermSize = do
+    drawBuffer <- gets rDrawBuffer
+    (_, (maxy, maxx)) <- liftIO (getBounds drawBuffer)
+    return (maxx + 1, maxy + 1)
+
+-- | Write some text to the draw buffer at the given position.
+write :: MonadIO m => (Int, Int) -> String -> RenderT m ()
+write (x, y1) str = do
+    (wid, hei) <- getTermSize
+    let writeLine y line = sequence_ [putc' (x', y) c | (x', c) <- zip [x..] line]
+    sequence_ [writeLine y (take (wid - x) line)
+              | (y, line) <- take (hei - y1) $ zip [y1..] (lines str)]
+
+-- | Write one character to the draw buffer at the given position.
+putc :: MonadIO m => (Int, Int) -> Char -> RenderT m ()
+putc (x, y) c = whenM (inBounds (x, y)) $ putc' (x, y) c
+
+putc' :: MonadIO m => (Int, Int) -> Char -> RenderT m ()
+putc' (x, y) c = do
+    drawBuffer <- gets rDrawBuffer
+    style <- gets rCurrentStyle
+    let cell = Cell { cChar = c, cStyle = style }
+    liftIO $ writeArray drawBuffer (y, x) cell
+
+-- | Obtain the current character and style in the draw buffer at the given
+-- position.
+readPixel :: MonadIO m => (Int, Int) -> RenderT m (Style, Char)
+readPixel (x, y) =
+    ifM (inBounds (x, y))
+        (do buf <- gets rDrawBuffer
+            Cell ch sty <- liftIO $ readArray buf (y, x)
+            return (sty, ch))
+        (return (defaultStyle, ' '))
+
+incrCursorYX :: (Int, Int) -> (Int, Int) -> (Int, Int)
+incrCursorYX (hei, wid) (y, x)
+    | x + 1 == wid = if y + 1 == hei then (y, 0) else (y + 1, 0)
+    | otherwise    = (y, x + 1)
+
+-- | Set the current style.
+setStyle :: Monad m => Style -> RenderT m ()
+setStyle style = modify' $ \s -> s { rCurrentStyle = style }
+
+modifyCurrentStyle :: Monad m => (Style -> Style) -> RenderT m ()
+modifyCurrentStyle f = modify' $ \s -> s { rCurrentStyle = f (rCurrentStyle s)}
+
+-- | Set the foreground color component of the current style.
+setFg :: Monad m => Maybe RGB -> RenderT m ()
+setFg clr = modifyCurrentStyle (\s -> s { sFg = clr })
+
+-- | Set the background color component of the current style.
+setBg :: Monad m => Maybe RGB -> RenderT m ()
+setBg clr = modifyCurrentStyle (\s -> s { sBg = clr })
+
+-- | Set the boldface component of the current style.
+setBold :: Monad m => Bool -> RenderT m ()
+setBold bold = modifyCurrentStyle (\s -> s { sBold = bold })
+
+-- | Set the text-underline component of the current style.
+setUnderline :: Monad m => Bool -> RenderT m ()
+setUnderline ul = modifyCurrentStyle (\s -> s { sUnderline = ul })
+
+-- | Fill a rectangle, specified using its top-left and bottom-right
+-- corners, with a particular character. Calling this function with a space
+-- character allows clearing a subregion of the screen.
+fillRect :: MonadIO m => (Int, Int) -> (Int, Int) -> Char -> RenderT m ()
+fillRect (fromx, fromy) (tox, toy) ch =
+    forM_ [(x, y) | y <- [fromy..toy], x <- [fromx..tox]] $ \(x, y) -> do
+        putc' (x, y) ch
+
+-- | Clear the whole screen. This may also be accomplished using 'fillRect'
+-- with appropriate bounds.
+clearScreen :: MonadIO m => RenderT m ()
+clearScreen = savingStyle $ do
+    (w, h) <- getTermSize
+    setStyle defaultStyle
+    fillRect (0, 0) (w-1, h-1) ' '
+
+-- | After running the computation, restore the current style as it was
+-- before running the computation.
+savingStyle :: MonadIO m => RenderT m a -> RenderT m a
+savingStyle act = do
+    st <- gets rCurrentStyle
+    res <- act
+    setStyle st
+    return res
+
+styleToSGR :: Style -> [A.SGR]
+styleToSGR style =
+    [A.Reset] ++
+    toList (A.SetRGBColor A.Foreground . fromRGB <$> sFg style) ++
+    toList (A.SetRGBColor A.Background . fromRGB <$> sBg style) ++
+    (if sBold style then [A.SetConsoleIntensity A.BoldIntensity] else []) ++
+    (if sUnderline style then [A.SetUnderlining A.SingleUnderline] else [])
+
+fromRGB :: RGB -> Colour Float
+fromRGB (r, g, b) = sRGB24 r g b
+
+-- | Sound the terminal bell (plonk, dong, BEEP). This bypasses the buffer
+-- model, i.e. it happens immediately.
+bel :: MonadIO m => RenderT m ()
+bel = liftIO $ putChar '\BEL' >> hFlush stdout
+
+inBounds :: MonadIO m => (Int, Int) -> RenderT m Bool
+inBounds (x, y) = do
+    (wid, hei) <- getTermSize
+    return $ x >= 0 && x < wid && y >= 0 && y < hei
+
+
+-- Bounds of dest and src should be equal!
+copyArray :: (MArray a e m, Ix i) => a i e -> a i e -> m ()
+copyArray dest src = do
+    destbounds <- getBounds dest
+    srcbounds <- getBounds src
+    when (srcbounds /= destbounds) $ error "Logic error: incompatible array bounds in copyArray"
+
+    forM_ (range destbounds) $ \idx ->
+        readArray src idx >>= writeArray dest idx
diff --git a/src/Utils/Monad.hs b/src/Utils/Monad.hs
new file mode 100644
index 0000000..3c1ad17
--- /dev/null
+++ b/src/Utils/Monad.hs
@@ -0,0 +1,26 @@
+{-|
+Module      : Utils.Monad
+Copyright   : (c) UU, 2019
+License     : MIT
+Maintainer  : Tom Smeding
+Stability   : experimental
+Portability : POSIX, macOS, Windows
+
+Some useful functions lifted to monadic actions.
+-}
+module Utils.Monad where
+
+
+-- | If the boolean resolves to True, returns the first argument, else the
+-- second.
+ifM :: Monad m => m Bool -> m a -> m a -> m a
+ifM b t e = b >>= \b' -> if b' then t else e
+
+-- | Runs the monadic action only if the boolean resolves to True.
+whenM :: Monad m => m Bool -> m () -> m ()
+whenM b t = ifM b t (return ())
+
+-- | whenJust m a = when (isJust m) (a (fromJust m)), but with less
+-- fromJust.
+whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
+whenJust = flip (maybe (return ()))
diff --git a/src/Utils/Time.hs b/src/Utils/Time.hs
new file mode 100644
index 0000000..2139c53
--- /dev/null
+++ b/src/Utils/Time.hs
@@ -0,0 +1,43 @@
+{-|
+Module      : Utils.Time
+Copyright   : (c) UU, 2019
+License     : MIT
+Maintainer  : Tom Smeding
+Stability   : experimental
+Portability : POSIX, macOS, Windows
+-}
+module Utils.Time where
+
+import Data.Time.Clock
+import Data.Time.Clock.System hiding (getSystemTime)
+import qualified Data.Time.Clock.System as Sys
+import Data.Time.Format
+
+
+-- | A timestamp in milliseconds.
+newtype TimeStamp = TimeStamp Int
+  deriving (Show, Read, Eq, Ord)
+
+-- | The number of milliseconds stored in the timestamp newtype.
+timestampMS :: TimeStamp -> Int
+timestampMS (TimeStamp n) = n
+
+-- | Offset the timestamp by the given number of milliseconds.
+plusMS :: TimeStamp -> Int -> TimeStamp
+plusMS (TimeStamp n) m = TimeStamp (n + m)
+
+-- | The number of milliseconds that the first timestamp is later than the
+-- second.
+subtractMS :: TimeStamp -> TimeStamp -> Int
+subtractMS (TimeStamp n) (TimeStamp m) = n - m
+
+-- | Return the current system time as a timestamp.
+getSystemTime :: IO TimeStamp
+getSystemTime = TimeStamp . systemToMS <$> Sys.getSystemTime
+  where
+    systemToMS tm = let MkSystemTime s ns = truncateSystemTimeLeapSecond tm
+                    in fromIntegral s * 1000 + fromIntegral ns `div` 1000000
+
+-- | Show a UTCTime in ISO-8601 format.
+iso8601Show :: UTCTime -> String
+iso8601Show = formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S"))
diff --git a/terminal-io.cabal b/terminal-io.cabal
new file mode 100644
index 0000000..531dc9d
--- /dev/null
+++ b/terminal-io.cabal
@@ -0,0 +1,53 @@
+cabal-version:       2.0
+name:                terminal-io
+version:             0.1.0.0
+-- synopsis:
+-- description:
+-- bug-reports:
+homepage:            https://git.tomsmeding.com/terminal-io-hs
+license:             MIT
+license-file:        LICENSE
+author:              Tom Smeding
+maintainer:          tom.smeding@gmail.com
+-- copyright:
+category:            Graphics
+build-type:          Simple
+
+library
+  ghc-options:         -Wall -O3
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  default-extensions:
+    LambdaCase
+    MultiWayIf
+  exposed-modules:
+    System.IO.Terminal
+    System.IO.Terminal.Characters
+    System.IO.Terminal.Input
+    System.IO.Terminal.Input.Key
+    System.IO.Terminal.Render
+  other-modules:
+    Numeric.InfInt
+    System.IO.Terminal.IO
+    System.IO.Terminal.Input.SeqParser
+    Utils.Monad
+    Utils.Time
+  build-depends:
+    base >= 4 && < 5,
+    ansi-terminal,
+    array,
+    colour,
+    containers,
+    mtl,
+    terminal-size,
+    time
+  if os(linux)
+    cpp-options: -DOS_LINUX
+    other-modules: System.IO.Terminal.Input.Posix
+  if os(darwin)
+    cpp-options: -DOS_MACOS
+    other-modules: System.IO.Terminal.Input.Posix
+  if os(windows)
+    cpp-options: -DOS_WINDOWS
+    other-modules: System.IO.Terminal.Input.Windows
+    build-depends: hidden-char