winio: Implement new Console API

10 files changed, 2048 insertions, 0 deletions

diff --git a/libraries/base/GHC/IO/Handle/Windows.hs b/libraries/base/GHC/IO/Handle/Windows.hs
new file mode 100644
index 0000000000..3010b4d41e
--- /dev/null
+++ b/libraries/base/GHC/IO/Handle/Windows.hs
@@ -0,0 +1,239 @@
+  {-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Handle.Windows
+-- Copyright   :  (c) The University of Glasgow, 2017
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- Handle operations implemented by Windows native handles
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Handle.Windows (
+  stdin, stdout, stderr,
+  openFile, openBinaryFile, openFileBlocking,
+  handleToHANDLE
+ ) where
+
+import Data.Maybe
+import Data.Typeable
+
+import GHC.Base
+import GHC.MVar
+import GHC.IO
+import GHC.IO.BufferedIO hiding (flushWriteBuffer)
+import GHC.IO.Encoding
+import GHC.IO.Device as IODevice
+import GHC.IO.Exception
+import GHC.IO.IOMode
+import GHC.IO.Handle.Types
+import GHC.IO.Handle.Internals
+import qualified GHC.IO.Windows.Handle as Win
+
+-- ---------------------------------------------------------------------------
+-- Standard Handles
+
+-- Three handles are allocated during program initialisation.  The first
+-- two manage input or output from the Haskell program's standard input
+-- or output channel respectively.  The third manages output to the
+-- standard error channel. These handles are initially open.
+
+-- | If the std handles are redirected to file handles then WriteConsole etc
+--   won't work anymore. When the handle is created test it and if it's a file
+--   handle then just convert it to the proper IODevice so WriteFile is used
+--   instead. This is done here so it's buffered and only happens once.
+mkConsoleHandle :: Win.IoHandle Win.ConsoleHandle
+                -> FilePath
+                -> HandleType
+                -> Bool                     -- buffered?
+                -> Maybe TextEncoding
+                -> NewlineMode
+                -> Maybe HandleFinalizer
+                -> Maybe (MVar Handle__)
+                -> IO Handle
+mkConsoleHandle dev filepath ha_type buffered mb_codec nl finalizer other_side
+ = do isTerm <- IODevice.isTerminal dev
+      case isTerm of
+        True  -> mkHandle dev filepath ha_type buffered mb_codec nl finalizer
+                          other_side
+        False -> mkHandle (Win.convertHandle dev) filepath ha_type buffered
+                            mb_codec nl finalizer other_side
+
+-- | A handle managing input from the Haskell program's standard input channel.
+stdin :: Handle
+{-# NOINLINE stdin #-}
+stdin = unsafePerformIO $ do
+   -- ToDo: acquire lock
+   enc <- getLocaleEncoding
+   mkConsoleHandle Win.stdin "<stdin>" ReadHandle True (Just enc)
+                   nativeNewlineMode{-translate newlines-}
+                   (Just stdHandleFinalizer) Nothing
+
+-- | A handle managing output to the Haskell program's standard output channel.
+stdout :: Handle
+{-# NOINLINE stdout #-}
+stdout = unsafePerformIO $ do
+   -- ToDo: acquire lock
+   enc <- getLocaleEncoding
+   mkConsoleHandle Win.stdout "<stdout>" WriteHandle True (Just enc)
+                   nativeNewlineMode{-translate newlines-}
+                   (Just stdHandleFinalizer) Nothing
+
+-- | A handle managing output to the Haskell program's standard error channel.
+stderr :: Handle
+{-# NOINLINE stderr #-}
+stderr = unsafePerformIO $ do
+   -- ToDo: acquire lock
+   enc <- getLocaleEncoding
+   mkConsoleHandle Win.stderr "<stderr>" WriteHandle
+                   False{-stderr is unbuffered-} (Just enc)
+                   nativeNewlineMode{-translate newlines-}
+                  (Just stdHandleFinalizer) Nothing
+
+stdHandleFinalizer :: FilePath -> MVar Handle__ -> IO ()
+stdHandleFinalizer fp m = do
+  h_ <- takeMVar m
+  flushWriteBuffer h_
+  case haType h_ of
+      ClosedHandle -> return ()
+      _other       -> closeTextCodecs h_
+  putMVar m (ioe_finalizedHandle fp)
+
+-- ---------------------------------------------------------------------------
+-- Opening and Closing Files
+
+addFilePathToIOError :: String -> FilePath -> IOException -> IOException
+addFilePathToIOError fun fp ioe
+  = ioe{ ioe_location = fun, ioe_filename = Just fp }
+
+-- | Computation 'openFile' @file mode@ allocates and returns a new, open
+-- handle to manage the file @file@.  It manages input if @mode@
+-- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode',
+-- and both input and output if mode is 'ReadWriteMode'.
+--
+-- If the file does not exist and it is opened for output, it should be
+-- created as a new file.  If @mode@ is 'WriteMode' and the file
+-- already exists, then it should be truncated to zero length.
+-- Some operating systems delete empty files, so there is no guarantee
+-- that the file will exist following an 'openFile' with @mode@
+-- 'WriteMode' unless it is subsequently written to successfully.
+-- The handle is positioned at the end of the file if @mode@ is
+-- 'AppendMode', and otherwise at the beginning (in which case its
+-- internal position is 0).
+-- The initial buffer mode is implementation-dependent.
+--
+-- This operation may fail with:
+--
+--  * 'isAlreadyInUseError' if the file is already open and cannot be reopened;
+--
+--  * 'isDoesNotExistError' if the file does not exist; or
+--
+--  * 'isPermissionError' if the user does not have permission to open the file.
+--
+-- Note: if you will be working with files containing binary data, you'll want to
+-- be using 'openBinaryFile'.
+openFile :: FilePath -> IOMode -> IO Handle
+openFile fp im =
+  catchException
+    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True)
+    (\e -> ioError (addFilePathToIOError "openFile" fp e))
+
+-- | Like 'openFile', but opens the file in ordinary blocking mode.
+-- This can be useful for opening a FIFO for writing: if we open in
+-- non-blocking mode then the open will fail if there are no readers,
+-- whereas a blocking open will block until a reader appear.
+--
+-- @since 4.4.0.0
+openFileBlocking :: FilePath -> IOMode -> IO Handle
+openFileBlocking fp im =
+  catchException
+    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False)
+    (\e -> ioError (addFilePathToIOError "openFileBlocking" fp e))
+
+-- | Like 'openFile', but open the file in binary mode.
+-- On Windows, reading a file in text mode (which is the default)
+-- will translate CRLF to LF, and writing will translate LF to CRLF.
+-- This is usually what you want with text files.  With binary files
+-- this is undesirable; also, as usual under Microsoft operating systems,
+-- text mode treats control-Z as EOF.  Binary mode turns off all special
+-- treatment of end-of-line and end-of-file characters.
+-- (See also 'hSetBinaryMode'.)
+
+openBinaryFile :: FilePath -> IOMode -> IO Handle
+openBinaryFile fp m =
+  catchException
+    (openFile' fp m True True)
+    (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
+
+openFile' :: String -> IOMode -> Bool -> Bool -> IO Handle
+openFile' filepath iomode binary non_blocking = do
+  -- first open the file to get a Win32 handle
+  (hwnd, hwnd_type) <- Win.openFile filepath iomode non_blocking
+
+  mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding
+
+  -- then use it to make a Handle
+  mkHandleFromHANDLE hwnd hwnd_type filepath iomode mb_codec
+            `onException` IODevice.close hwnd
+        -- NB. don't forget to close the Handle if mkHandleFromHANDLE fails,
+        -- otherwise this Handle leaks.
+
+-- ---------------------------------------------------------------------------
+-- Converting Windows Handles from/to Handles
+
+mkHandleFromHANDLE
+   :: (RawIO dev, IODevice.IODevice dev, BufferedIO dev, Typeable dev) => dev
+   -> IODeviceType
+   -> FilePath  -- a string describing this Windows handle (e.g. the filename)
+   -> IOMode
+   -> Maybe TextEncoding
+   -> IO Handle
+
+mkHandleFromHANDLE dev hw_type filepath iomode mb_codec
+  = do
+    let nl | isJust mb_codec = nativeNewlineMode
+           | otherwise       = noNewlineTranslation
+
+    case hw_type of
+        Directory ->
+           ioException (IOError Nothing InappropriateType "openFile"
+                           "is a directory" Nothing Nothing)
+
+        Stream
+           -- only *Streams* can be DuplexHandles.  Other read/write
+           -- Handles must share a buffer.
+           | ReadWriteMode <- iomode ->
+                mkDuplexHandle dev filepath mb_codec nl
+
+
+        _other ->
+           mkFileHandle dev filepath iomode mb_codec nl
+
+-- | Turn an existing Handle into a Win32 HANDLE. This function throws an
+-- IOError if the Handle does not reference a HANDLE
+handleToHANDLE :: Handle -> IO Win.HANDLE
+handleToHANDLE h = case h of
+  FileHandle _ mv -> do
+    Handle__{haDevice = dev} <- readMVar mv
+    case (cast dev :: Maybe (Win.Io Win.NativeHandle)) of
+      Just hwnd -> return $ Win.toHANDLE hwnd
+      Nothing   -> throwErr "not a file HANDLE"
+  DuplexHandle{} -> throwErr "not a file handle"
+  where
+    throwErr msg = ioException $ IOError (Just h)
+      InappropriateType "handleToHANDLE" msg Nothing Nothing
+
+-- ---------------------------------------------------------------------------
+-- Are files opened by default in text or binary mode, if the user doesn't
+-- specify? The thing is, to the Win32 APIs which are lowerlevel there exist no
+-- such thing as binary/text mode. That's strictly a thing of the C library on
+-- top of it.  So I'm not sure what to do with this. -Tamar
+
+dEFAULT_OPEN_IN_BINARY_MODE :: Bool
+dEFAULT_OPEN_IN_BINARY_MODE = False
diff --git a/libraries/base/GHC/IO/SmartHandles.hs b/libraries/base/GHC/IO/SmartHandles.hs
new file mode 100644
index 0000000000..10e1488b0f
--- /dev/null
+++ b/libraries/base/GHC/IO/SmartHandles.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE Trustworthy       #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE CPP               #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.SmartHandles
+-- Copyright   :  (c) The University of Glasgow, 2017
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- This model abtracts away the platform specific handles that can be toggled
+-- through the RTS.
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.SmartHandles
+  ( -- std handles
+    stdin, stdout, stderr,
+    openFile, openBinaryFile, openFileBlocking
+  ) where
+
+import GHC.IO
+import GHC.IO.IOMode
+import GHC.IO.SubSystem
+import GHC.IO.Handle.Types
+
+import qualified GHC.IO.Handle.FD as POSIX
+#if defined(mingw32_HOST_OS)
+import qualified GHC.IO.Handle.Windows as Win
+#endif
+
+stdin :: Handle
+stdin = POSIX.stdin <!> Win.stdin
+
+stdout :: Handle
+stdout = POSIX.stdout <!> Win.stdout
+
+stderr :: Handle
+stderr = POSIX.stderr <!> Win.stderr
+
+openFile :: FilePath -> IOMode -> IO Handle
+openFile = POSIX.openFile <!> Win.openFile
+
+openBinaryFile :: FilePath -> IOMode -> IO Handle
+openBinaryFile = POSIX.openBinaryFile <!> Win.openBinaryFile
+
+openFileBlocking :: FilePath -> IOMode -> IO Handle
+openFileBlocking = POSIX.openFileBlocking <!> Win.openFileBlocking
diff --git a/libraries/base/GHC/IO/SmartHandles.hs-boot b/libraries/base/GHC/IO/SmartHandles.hs-boot
new file mode 100644
index 0000000000..4bcea5eb20
--- /dev/null
+++ b/libraries/base/GHC/IO/SmartHandles.hs-boot
@@ -0,0 +1,23 @@
+{-# LANGUAGE Trustworthy       #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE CPP               #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.SmartHandles [boot]
+-- Copyright   :  (c) The University of Glasgow, 2017
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.SmartHandles where
+
+import GHC.IO.Handle.Types
+
+-- used in GHC.Conc, which is below GHC.IO.Handle.FD
+stdout :: Handle
+
diff --git a/libraries/base/GHC/IO/SubSystem.hs b/libraries/base/GHC/IO/SubSystem.hs
new file mode 100644
index 0000000000..87a353b639
--- /dev/null
+++ b/libraries/base/GHC/IO/SubSystem.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE Trustworthy       #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE CPP               #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.SubSystem
+-- Copyright   :  (c) The University of Glasgow, 2017
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- The SubSystem control interface.  These methods can be used to disambiguate
+-- between the two operations.
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.SubSystem (
+  setIoSubSystem,
+  getIoSubSystem,
+  withIoSubSystem,
+  withIoSubSystem',
+  whenIoSubSystem,
+  IoSubSystem(..),
+  conditional,
+  (<!>),
+  isWindowsNativeIO
+ ) where
+
+import GHC.Base
+
+import GHC.IO.Unsafe
+import GHC.IORef
+import GHC.RTS.Flags
+
+infixl 7 <!>
+
+-- | Conditionally execute an action depending on the configured I/O subsystem.
+-- If POSIX then execute first action, if Windows then execute second.
+-- On POSIX systems but NATIVE and POSIX will execute the first action.
+conditional :: a -> a -> a
+conditional posix windows = withIoSubSystem' sub
+  where
+    sub = \s -> case s of
+                  IoPOSIX -> posix
+#if defined(mingw32_HOST_OS)
+                  IoNative -> windows
+#else
+                  IoNative -> posix
+#endif
+
+-- | Infix version of `conditional`.
+(<!>) :: a -> a -> a
+(<!>) = conditional
+
+isWindowsNativeIO :: Bool
+isWindowsNativeIO = False <!> True
+
+ioSubSystem :: IORef IoSubSystem
+ioSubSystem = unsafePerformIO sub
+  where
+    sub = do misc <- getMiscFlags
+             newIORef (ioManager misc)
+
+setIoSubSystem :: IoSubSystem -> IO ()
+setIoSubSystem = writeIORef ioSubSystem
+
+getIoSubSystem :: IO IoSubSystem
+getIoSubSystem = readIORef ioSubSystem
+
+withIoSubSystem :: (IoSubSystem -> IO a) -> IO a
+withIoSubSystem f = do sub <- getIoSubSystem
+                       f sub
+
+withIoSubSystem' :: (IoSubSystem -> a) -> a
+withIoSubSystem' f = unsafePerformIO inner
+  where inner = do sub <- getIoSubSystem
+                   return (f sub)
+
+whenIoSubSystem :: IoSubSystem -> IO () -> IO ()
+whenIoSubSystem m f = do sub <- getIoSubSystem
+                         when (sub == m) f
+
diff --git a/libraries/base/GHC/IO/Windows/Encoding.hs b/libraries/base/GHC/IO/Windows/Encoding.hs
new file mode 100644
index 0000000000..78e4b87f12
--- /dev/null
+++ b/libraries/base/GHC/IO/Windows/Encoding.hs
@@ -0,0 +1,229 @@
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE NoImplicitPrelude    #-}
+{- |
+   Module      :  System.Win32.Encoding
+   Copyright   :  2012 shelarcy
+   License     :  BSD-style
+
+   Maintainer  :  shelarcy@gmail.com
+   Stability   :  Provisional
+   Portability :  Non-portable (Win32 API)
+
+   Enocode/Decode mutibyte charactor using Win32 API.
+-}
+
+module GHC.IO.Windows.Encoding
+  ( encodeMultiByte
+  , encodeMultiByteIO
+  , encodeMultiByteRawIO
+  , decodeMultiByte
+  , decodeMultiByteIO
+  , wideCharToMultiByte
+  , multiByteToWideChar
+  , withGhcInternalToUTF16
+  , withUTF16ToGhcInternal
+  ) where
+
+import Data.Word (Word8, Word16)
+import Foreign.C.Types        (CInt(..))
+import Foreign.C.String       (peekCAStringLen, peekCWStringLen,
+                               withCWStringLen, withCAStringLen, )
+import Foreign.Ptr (nullPtr, Ptr ())
+import Foreign.Marshal.Array  (allocaArray)
+import Foreign.Marshal.Unsafe (unsafeLocalState)
+import GHC.Windows
+import GHC.IO.Encoding.CodePage (CodePage, getCurrentCodePage)
+import GHC.IO
+import GHC.Base
+import GHC.Real
+
+#include "windows_cconv.h"
+
+-- | The "System.IO" output functions (e.g. `putStr`) don't
+-- automatically convert to multibyte string on Windows, so this
+-- function is provided to make the conversion from a Unicode string
+-- in the given code page to a proper multibyte string.  To get the
+-- code page for the console, use `getCurrentCodePage`.
+--
+encodeMultiByte :: CodePage -> String -> String
+encodeMultiByte cp = unsafeLocalState . encodeMultiByteIO cp
+
+encodeMultiByteIO :: CodePage -> String -> IO String
+encodeMultiByteIO _ "" = return ""
+  -- WideCharToMultiByte doesn't handle empty strings
+encodeMultiByteIO cp wstr =
+  withCWStringLen wstr $ \(cwstr,len) -> do
+    mbchars' <- failIfZero "WideCharToMultiByte" $ wideCharToMultiByte
+                cp
+                0
+                cwstr
+                (fromIntegral len)
+                nullPtr 0
+                nullPtr nullPtr
+    -- mbchar' is the length of buffer required
+    allocaArray (fromIntegral mbchars') $ \mbstr -> do
+      mbchars <- failIfZero "WideCharToMultiByte" $ wideCharToMultiByte
+                 cp
+                 0
+                 cwstr
+                 (fromIntegral len)
+                 mbstr mbchars'
+                 nullPtr nullPtr
+      peekCAStringLen (mbstr,fromIntegral mbchars)  -- converts [Char] to UTF-16
+
+encodeMultiByteRawIO :: CodePage -> String -> IO (LPCSTR, CInt)
+encodeMultiByteRawIO _ "" = return (nullPtr, 0)
+  -- WideCharToMultiByte doesn't handle empty strings
+encodeMultiByteRawIO cp wstr =
+  withCWStringLen wstr $ \(cwstr,len) -> do
+    mbchars' <- failIfZero "WideCharToMultiByte" $ wideCharToMultiByte
+                cp
+                0
+                cwstr
+                (fromIntegral len)
+                nullPtr 0
+                nullPtr nullPtr
+    -- mbchar' is the length of buffer required
+    allocaArray (fromIntegral mbchars') $ \mbstr -> do
+      mbchars <- failIfZero "WideCharToMultiByte" $ wideCharToMultiByte
+                 cp
+                 0
+                 cwstr
+                 (fromIntegral len)
+                 mbstr mbchars'
+                 nullPtr nullPtr
+      return (mbstr,fromIntegral mbchars)  -- converts [Char] to UTF-16
+
+foreign import WINDOWS_CCONV "WideCharToMultiByte"
+  wideCharToMultiByte
+        :: CodePage
+        -> DWORD   -- dwFlags,
+        -> LPCWSTR -- lpWideCharStr
+        -> CInt    -- cchWideChar
+        -> LPSTR   -- lpMultiByteStr
+        -> CInt    -- cbMultiByte
+        -> LPCSTR  -- lpMultiByteStr
+        -> LPBOOL  -- lpbFlags
+        -> IO CInt
+
+-- | The `System.IO` input functions (e.g. `getLine`) don't
+-- automatically convert to Unicode, so this function is provided to
+-- make the conversion from a multibyte string in the given code page
+-- to a proper Unicode string.  To get the code page for the console,
+-- use `getConsoleCP`.
+stringToUnicode :: CodePage -> String -> IO String
+stringToUnicode _cp "" = return ""
+     -- MultiByteToWideChar doesn't handle empty strings (#1929)
+stringToUnicode cp mbstr =
+  withCAStringLen mbstr $ \(cstr,len) -> do
+    wchars <- failIfZero "MultiByteToWideChar" $ multiByteToWideChar
+                cp
+                0
+                cstr
+                (fromIntegral len)
+                nullPtr 0
+    -- wchars is the length of buffer required
+    allocaArray (fromIntegral wchars) $ \cwstr -> do
+      wchars' <- failIfZero "MultiByteToWideChar" $ multiByteToWideChar
+                cp
+                0
+                cstr
+                (fromIntegral len)
+                cwstr wchars
+      peekCWStringLen (cwstr,fromIntegral wchars')  -- converts UTF-16 to [Char]
+
+foreign import WINDOWS_CCONV unsafe "MultiByteToWideChar"
+  multiByteToWideChar
+        :: CodePage
+        -> DWORD   -- dwFlags,
+        -> LPCSTR  -- lpMultiByteStr
+        -> CInt    -- cbMultiByte
+        -> LPWSTR  -- lpWideCharStr
+        -> CInt    -- cchWideChar
+        -> IO CInt
+
+decodeMultiByte :: CodePage -> String -> String
+decodeMultiByte cp = unsafeLocalState . decodeMultiByteIO cp
+
+-- | Because of `stringToUnicode` is unclear name, we use `decodeMultiByteIO`
+-- for alias of `stringToUnicode`.
+decodeMultiByteIO :: CodePage -> String -> IO String
+decodeMultiByteIO = stringToUnicode
+{-# INLINE decodeMultiByteIO #-}
+
+foreign import WINDOWS_CCONV unsafe "MultiByteToWideChar"
+  multiByteToWideChar'
+        :: CodePage
+        -> DWORD   -- dwFlags,
+        -> Ptr Word8  -- lpMultiByteStr
+        -> CInt    -- cbMultiByte
+        -> Ptr Word16  -- lpWideCharStr
+        -> CInt    -- cchWideChar
+        -> IO CInt
+
+-- TODO: GHC is internally UTF-32 which means we have re-encode for
+--       Windows which is annoying. Switch to UTF-16 on IoNative
+--       being default.
+withGhcInternalToUTF16 :: Ptr Word8 -> Int -> ((Ptr Word16, CInt) -> IO a)
+                       -> IO a
+withGhcInternalToUTF16 ptr len fn
+ = do cp <- getCurrentCodePage
+      wchars <- failIfZero "withGhcInternalToUTF16" $
+                  multiByteToWideChar' cp 0 ptr (fromIntegral len) nullPtr 0
+      -- wchars is the length of buffer required
+      allocaArray (fromIntegral wchars) $ \cwstr -> do
+        wchars' <- failIfZero "withGhcInternalToUTF16" $
+                    multiByteToWideChar' cp 0 ptr (fromIntegral len) cwstr wchars
+        fn (cwstr, wchars')
+
+foreign import WINDOWS_CCONV "WideCharToMultiByte"
+  wideCharToMultiByte'
+        :: CodePage
+        -> DWORD   -- dwFlags,
+        -> Ptr Word16 -- lpWideCharStr
+        -> CInt    -- cchWideChar
+        -> Ptr Word8   -- lpMultiByteStr
+        -> CInt    -- cbMultiByte
+        -> LPCSTR  -- lpMultiByteStr
+        -> LPBOOL  -- lpbFlags
+        -> IO CInt
+
+-- TODO: GHC is internally UTF-32 which means we have re-encode for
+--       Windows which is annoying. Switch to UTF-16 on IoNative
+--       being default.
+
+-- | Decode a UTF16 buffer into the given buffer in the current code page.
+-- The source UTF16 buffer is filled by the function given as argument.
+withUTF16ToGhcInternal :: Ptr Word8 -- Buffer to store the encoded string in.
+                       -> Int       -- Length of the buffer
+                       -- Function to fill source buffer.
+                       ->  ( CInt       -- Size of available buffer in bytes
+                          -> Ptr Word16 -- Temporary source buffer.
+                          -> IO CInt    -- Actual length of buffer content.
+                           )
+                       -> IO Int    -- Returns number of bytes stored in buffer.
+withUTF16ToGhcInternal ptr len fn
+ = do cp <- getCurrentCodePage
+      -- Annoyingly the IO system is very UTF-32 oriented and asks for bytes
+      -- as buffer reads.  Problem is we don't know how many bytes we'll end up
+      -- having as UTF-32 MultiByte encoded UTF-16. So be conservative.  We assume
+      -- that a single byte may expand to atmost 1 Word16.  So assume that each
+      -- byte does and divide the requested number of bytes by two since each
+      -- Word16 encoded wchar may expand to only two Word8 sequences.
+      let reqBytes = fromIntegral (len `div` 2)
+      allocaArray reqBytes $ \w_ptr -> do
+        w_len <- fn (fromIntegral reqBytes) w_ptr
+        if w_len == 0
+           then return 0 else do
+                -- Get required length of encoding
+                mbchars' <- failIfZero "withUTF16ToGhcInternal" $
+                              wideCharToMultiByte' cp 0 w_ptr
+                                                  (fromIntegral w_len) nullPtr
+                                                  0 nullPtr nullPtr
+                assert (mbchars' <= (fromIntegral len)) $ do
+                  -- mbchar' is the length of buffer required
+                  mbchars <- failIfZero "withUTF16ToGhcInternal" $
+                                wideCharToMultiByte' cp 0 w_ptr
+                                                    (fromIntegral w_len) ptr
+                                                    mbchars' nullPtr nullPtr
+                  return $ fromIntegral mbchars
diff --git a/libraries/base/GHC/IO/Windows/Handle.hsc b/libraries/base/GHC/IO/Windows/Handle.hsc
new file mode 100644
index 0000000000..f0a000e626
--- /dev/null
+++ b/libraries/base/GHC/IO/Windows/Handle.hsc
@@ -0,0 +1,893 @@
+{-# LANGUAGE Trustworthy          #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE NoImplicitPrelude    #-}
+{-# LANGUAGE BangPatterns         #-}
+{-# LANGUAGE GADTs                #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE FlexibleContexts     #-}
+-- Whether there are identities depends on the platform
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Windows.Handle
+-- Copyright   :  (c) The University of Glasgow, 2017
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- Raw read/write operations on Windows Handles
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Windows.Handle
+ ( -- * Basic Types
+   NativeHandle(),
+   ConsoleHandle(),
+   IoHandle(),
+   HANDLE,
+   Io(),
+
+   -- * Utility functions
+   convertHandle,
+   toHANDLE,
+
+   -- * Standard Handles
+   stdin,
+   stdout,
+   stderr,
+
+   -- * File utilities
+   openFile,
+   release
+ ) where
+
+#include <windows.h>
+#include <ntstatus.h>
+##include "windows_cconv.h"
+
+import Data.Bits ((.|.), shiftL)
+import Data.Word (Word8, Word16, Word64)
+import Data.Functor ((<$>))
+import Data.Typeable
+
+import GHC.Base
+import GHC.Enum
+import GHC.Num
+import GHC.Real
+import GHC.List
+
+import GHC.IO
+import GHC.IO.Buffer
+import GHC.IO.BufferedIO
+import qualified GHC.IO.Device
+import GHC.IO.Device (SeekMode(..), IODeviceType(..), IODevice(), devType, setSize)
+import GHC.IO.Exception
+import GHC.IO.IOMode
+import GHC.IO.Windows.Encoding (withGhcInternalToUTF16, withUTF16ToGhcInternal)
+import GHC.IO.Windows.Paths (getDevicePath)
+import GHC.IO.Handle.Internals (debugIO)
+import GHC.IORef
+import GHC.Event.Windows (LPOVERLAPPED, withOverlapped, IOResult(..))
+import Foreign.Ptr
+import Foreign.C
+import Foreign.Marshal.Array (pokeArray)
+import Foreign.Marshal.Alloc (alloca, allocaBytes)
+import Foreign.Marshal.Utils (with, fromBool)
+import Foreign.Storable (Storable (..))
+import qualified GHC.Event.Windows as Mgr
+
+import GHC.Windows (LPVOID, LPDWORD, DWORD, HANDLE, BOOL, LPCTSTR, ULONG, WORD,
+                    UCHAR, failIf, iNVALID_HANDLE_VALUE, failWith,
+                    failIfFalse_, getLastError)
+import Text.Show
+
+-- -----------------------------------------------------------------------------
+-- The Windows IO device handles
+
+data NativeHandle
+data ConsoleHandle
+
+-- | Bit of a Hack, but we don't want every handle to have a cooked entry
+--   but all copies of the handles for which we do want one need to share
+--   the same value.
+--   We can't store it separately because we don't know when the handle will
+--   be destroyed or invalidated.
+data IoHandle a where
+  NativeHandle  :: { getNativeHandle  :: HANDLE } -> IoHandle NativeHandle
+  ConsoleHandle :: { getConsoleHandle :: HANDLE
+                   , cookedHandle :: IORef Bool
+                   } -> IoHandle ConsoleHandle
+
+type Io a = IoHandle a
+
+-- | Convert a ConsoleHandle into a general FileHandle
+--   This will change which DeviceIO is used.
+convertHandle :: Io ConsoleHandle -> Io NativeHandle
+convertHandle = fromHANDLE . toHANDLE
+
+-- | @since 4.11.0.0
+instance Show (Io NativeHandle) where
+  show = show . toHANDLE
+
+-- | @since 4.11.0.0
+instance Show (Io ConsoleHandle) where
+  show = show . getConsoleHandle
+
+-- | @since 4.11.0.0
+instance GHC.IO.Device.RawIO (Io NativeHandle) where
+  read             = hwndRead
+  readNonBlocking  = hwndReadNonBlocking
+  write            = hwndWrite
+  writeNonBlocking = hwndWriteNonBlocking
+
+-- | @since 4.11.0.0
+instance GHC.IO.Device.RawIO (Io ConsoleHandle) where
+  read             = consoleRead
+  readNonBlocking  = consoleReadNonBlocking
+  write            = consoleWrite
+  writeNonBlocking = consoleWriteNonBlocking
+
+-- | Generalize a way to get and create handles.
+class (GHC.IO.Device.RawIO a, IODevice a, BufferedIO a, Typeable a)
+      => RawHandle a where
+  toHANDLE   :: a -> HANDLE
+  fromHANDLE :: HANDLE -> a
+  isLockable :: a -> Bool
+  setCooked  :: a -> Bool -> IO a
+  isCooked   :: a -> IO Bool
+
+instance RawHandle (Io NativeHandle) where
+  toHANDLE     = getNativeHandle
+  fromHANDLE   = NativeHandle
+  isLockable _ = True
+  setCooked    = const . return
+  isCooked   _ = return False
+
+instance RawHandle (Io ConsoleHandle) where
+  toHANDLE         = getConsoleHandle
+  fromHANDLE h     = unsafePerformIO $ ConsoleHandle h <$> newIORef False
+  isLockable _     = False
+  setCooked  h val =
+    do writeIORef (cookedHandle h) val
+       return h
+  isCooked   h     = readIORef (cookedHandle h)
+
+-- -----------------------------------------------------------------------------
+-- The Windows IO device implementation
+
+-- | @since 4.11.0.0
+instance GHC.IO.Device.IODevice (Io NativeHandle) where
+  ready      = handle_ready
+  close      = handle_close
+  isTerminal = handle_is_console
+  isSeekable = handle_is_seekable
+  seek       = handle_seek
+  tell       = handle_tell
+  getSize    = handle_get_size
+  setSize    = handle_set_size
+  setEcho    = handle_set_echo
+  getEcho    = handle_get_echo
+  setRaw     = handle_set_buffering
+  devType    = handle_dev_type
+  dup        = handle_duplicate
+
+-- | @since 4.11.0.0
+instance GHC.IO.Device.IODevice (Io ConsoleHandle) where
+  ready      = handle_ready
+  close      = handle_close . convertHandle
+  isTerminal = handle_is_console
+  isSeekable = handle_is_seekable
+  seek       = handle_console_seek
+  tell       = handle_console_tell
+  getSize    = handle_get_console_size
+  setSize    = handle_set_console_size
+  setEcho    = handle_set_echo
+  getEcho    = handle_get_echo
+  setRaw     = console_set_buffering
+  devType    = handle_dev_type
+  dup        = handle_duplicate
+
+-- Default sequential read buffer size.
+-- for Windows 8k seems to be the optimal
+-- buffer size.
+dEFAULT_BUFFER_SIZE :: Int
+dEFAULT_BUFFER_SIZE = 8192
+
+-- | @since 4.11.0.0
+-- See libraries/base/GHC/IO/BufferedIO.hs
+instance BufferedIO (Io NativeHandle) where
+  newBuffer _dev state = newByteBuffer dEFAULT_BUFFER_SIZE state
+  fillReadBuffer       = readBuf'
+  fillReadBuffer0      = readBufNonBlocking
+  flushWriteBuffer     = writeBuf'
+  flushWriteBuffer0    = writeBufNonBlocking
+
+-- | @since 4.11.0.0
+-- See libraries/base/GHC/IO/BufferedIO.hs
+instance BufferedIO (Io ConsoleHandle) where
+  newBuffer _dev state = newByteBuffer dEFAULT_BUFFER_SIZE state
+  fillReadBuffer       = readBuf'
+  fillReadBuffer0      = readBufNonBlocking
+  flushWriteBuffer     = writeBuf'
+  flushWriteBuffer0    = writeBufNonBlocking
+
+
+readBuf' :: RawHandle a => a -> Buffer Word8 -> IO (Int, Buffer Word8)
+readBuf' hnd buf = do
+  debugIO ("readBuf handle=" ++ show (toHANDLE hnd) ++ " " ++
+           summaryBuffer buf ++ "\n")
+  (r,buf') <- readBuf hnd buf
+  debugIO ("after: " ++ summaryBuffer buf' ++ "\n")
+  return (r,buf')
+
+writeBuf' :: RawHandle a => a -> Buffer Word8 -> IO (Buffer Word8)
+writeBuf' hnd buf = do
+  debugIO ("writeBuf handle=" ++ show (toHANDLE hnd) ++ " " ++
+           summaryBuffer buf ++ "\n")
+  writeBuf hnd buf
+
+-- -----------------------------------------------------------------------------
+-- Standard I/O handles
+
+type StdHandleId  = DWORD
+
+#{enum StdHandleId,
+ , sTD_INPUT_HANDLE  = STD_INPUT_HANDLE
+ , sTD_OUTPUT_HANDLE = STD_OUTPUT_HANDLE
+ , sTD_ERROR_HANDLE  = STD_ERROR_HANDLE
+}
+
+getStdHandle :: StdHandleId -> IO HANDLE
+getStdHandle hid =
+  failIf (== iNVALID_HANDLE_VALUE) "GetStdHandle" $ c_GetStdHandle hid
+
+stdin, stdout, stderr :: Io ConsoleHandle
+stdin  = unsafePerformIO $ mkConsoleHandle =<< getStdHandle sTD_INPUT_HANDLE
+stdout = unsafePerformIO $ mkConsoleHandle =<< getStdHandle sTD_OUTPUT_HANDLE
+stderr = unsafePerformIO $ mkConsoleHandle =<< getStdHandle sTD_ERROR_HANDLE
+
+mkConsoleHandle :: HANDLE -> IO (Io ConsoleHandle)
+mkConsoleHandle hwnd
+  = do ref <- newIORef False
+       return $ ConsoleHandle hwnd ref
+
+-- -----------------------------------------------------------------------------
+-- Some console internal types to detect EOF.
+
+-- ASCII Ctrl+D (EOT) character.  Typically used by Unix consoles.
+-- use for cross platform compatibility and to adhere to the ASCII standard.
+acCtrlD :: Int
+acCtrlD = 0x04
+-- ASCII Ctrl+Z (SUB) character. Typically used by Windows consoles to denote
+-- EOT.  Use for compatibility with user expectations.
+acCtrlZ :: Int
+acCtrlZ = 0x1A
+
+-- Mask to use to trigger ReadConsole input processing end.
+acEotMask :: ULONG
+acEotMask = (1 `shiftL` acCtrlD) .|. (1 `shiftL` acCtrlZ)
+
+-- Structure to hold the control character masks
+type PCONSOLE_READCONSOLE_CONTROL = Ptr CONSOLE_READCONSOLE_CONTROL
+data CONSOLE_READCONSOLE_CONTROL = CONSOLE_READCONSOLE_CONTROL
+  { crcNLength           :: ULONG
+  , crcNInitialChars     :: ULONG
+  , crcDwCtrlWakeupMask  :: ULONG
+  , crcDwControlKeyState :: ULONG
+  } deriving Show
+
+instance Storable CONSOLE_READCONSOLE_CONTROL where
+  sizeOf = const #size CONSOLE_READCONSOLE_CONTROL
+  alignment = const #alignment CONSOLE_READCONSOLE_CONTROL
+  poke buf crc = do
+    (#poke CONSOLE_READCONSOLE_CONTROL, nLength)           buf
+        (crcNLength           crc)
+    (#poke CONSOLE_READCONSOLE_CONTROL, nInitialChars)     buf
+        (crcNInitialChars     crc)
+    (#poke CONSOLE_READCONSOLE_CONTROL, dwCtrlWakeupMask)  buf
+        (crcDwCtrlWakeupMask  crc)
+    (#poke CONSOLE_READCONSOLE_CONTROL, dwControlKeyState) buf
+        (crcDwControlKeyState crc)
+
+  peek buf = do
+    vNLength           <-
+      (#peek CONSOLE_READCONSOLE_CONTROL, nLength)           buf
+    vNInitialChars     <-
+      (#peek CONSOLE_READCONSOLE_CONTROL, nInitialChars)     buf
+    vDwCtrlWakeupMask  <-
+      (#peek CONSOLE_READCONSOLE_CONTROL, dwCtrlWakeupMask)  buf
+    vDwControlKeyState <-
+      (#peek CONSOLE_READCONSOLE_CONTROL, dwControlKeyState) buf
+    return $ CONSOLE_READCONSOLE_CONTROL {
+        crcNLength           = vNLength,
+        crcNInitialChars     = vNInitialChars,
+        crcDwCtrlWakeupMask  = vDwCtrlWakeupMask,
+        crcDwControlKeyState = vDwControlKeyState
+      }
+
+-- Create CONSOLE_READCONSOLE_CONTROL for breaking on control characters
+-- specified by acEotMask
+eotControl :: CONSOLE_READCONSOLE_CONTROL
+eotControl =
+  CONSOLE_READCONSOLE_CONTROL
+    { crcNLength           = fromIntegral $
+                               sizeOf (undefined :: CONSOLE_READCONSOLE_CONTROL)
+    , crcNInitialChars     = 0
+    , crcDwCtrlWakeupMask  = acEotMask
+    , crcDwControlKeyState = 0
+    }
+
+type PINPUT_RECORD = Ptr ()
+-- -----------------------------------------------------------------------------
+-- Foreign imports
+
+
+foreign import WINDOWS_CCONV safe "windows.h CreateFileW"
+    c_CreateFile :: LPCTSTR -> DWORD -> DWORD -> LPSECURITY_ATTRIBUTES
+                 -> DWORD -> DWORD -> HANDLE
+                 -> IO HANDLE
+
+foreign import WINDOWS_CCONV safe "windows.h SetFileCompletionNotificationModes"
+    c_SetFileCompletionNotificationModes :: HANDLE -> UCHAR -> IO BOOL
+
+foreign import WINDOWS_CCONV safe "windows.h ReadFile"
+    c_ReadFile :: HANDLE -> LPVOID -> DWORD -> LPDWORD -> LPOVERLAPPED
+               -> IO BOOL
+
+foreign import WINDOWS_CCONV safe "windows.h WriteFile"
+    c_WriteFile :: HANDLE -> LPVOID -> DWORD -> LPDWORD -> LPOVERLAPPED
+                -> IO BOOL
+
+foreign import WINDOWS_CCONV safe "windows.h GetStdHandle"
+    c_GetStdHandle :: StdHandleId -> IO HANDLE
+
+foreign import ccall safe "__handle_ready"
+    c_handle_ready :: HANDLE -> BOOL -> CInt -> IO CInt
+
+foreign import ccall safe "__is_console"
+    c_is_console :: HANDLE -> IO BOOL
+
+foreign import ccall safe "__set_console_buffering"
+    c_set_console_buffering :: HANDLE -> BOOL -> IO BOOL
+
+foreign import ccall safe "__set_console_echo"
+    c_set_console_echo :: HANDLE -> BOOL -> IO BOOL
+
+foreign import ccall safe "__get_console_echo"
+    c_get_console_echo :: HANDLE -> IO BOOL
+
+foreign import ccall safe "__close_handle"
+    c_close_handle :: HANDLE -> IO Bool
+
+foreign import ccall safe "__handle_type"
+    c_handle_type :: HANDLE -> IO Int
+
+foreign import ccall safe "__set_file_pointer"
+  c_set_file_pointer :: HANDLE -> CLong -> DWORD -> Ptr CLong -> IO BOOL
+
+foreign import ccall safe "__get_file_pointer"
+  c_get_file_pointer :: HANDLE -> IO CLong
+
+foreign import ccall safe "__get_file_size"
+  c_get_file_size :: HANDLE -> IO CLong
+
+foreign import ccall safe "__set_file_size"
+  c_set_file_size :: HANDLE -> CLong -> IO BOOL
+
+foreign import ccall safe "__duplicate_handle"
+  c_duplicate_handle :: HANDLE -> Ptr HANDLE -> IO BOOL
+
+foreign import ccall safe "__set_console_pointer"
+  c_set_console_pointer :: HANDLE -> CLong -> DWORD -> Ptr CLong -> IO BOOL
+
+foreign import ccall safe "__get_console_pointer"
+  c_get_console_pointer :: HANDLE -> IO CLong
+
+foreign import ccall safe "__get_console_buffer_size"
+  c_get_console_buffer_size :: HANDLE -> IO CLong
+
+foreign import ccall safe "__set_console_buffer_size"
+  c_set_console_buffer_size :: HANDLE -> CLong -> IO BOOL
+
+foreign import WINDOWS_CCONV safe "windows.h ReadConsoleW"
+  c_read_console :: HANDLE -> Ptr Word16 -> DWORD -> Ptr DWORD
+                 -> PCONSOLE_READCONSOLE_CONTROL -> IO BOOL
+
+foreign import WINDOWS_CCONV safe "windows.h WriteConsoleW"
+  c_write_console :: HANDLE -> Ptr Word16 -> DWORD -> Ptr DWORD -> Ptr ()
+                  -> IO BOOL
+
+foreign import WINDOWS_CCONV safe "windows.h ReadConsoleInputW"
+  c_read_console_input :: HANDLE -> PINPUT_RECORD -> DWORD -> LPDWORD -> IO BOOL
+
+type LPSECURITY_ATTRIBUTES = LPVOID
+
+-- -----------------------------------------------------------------------------
+-- Reading and Writing
+
+-- For this to actually block, the file handle must have
+-- been created with FILE_FLAG_OVERLAPPED not set. As an implementation note I
+-- am choosing never to let this block. But this can be easily accomplished by
+-- a getOverlappedResult call with True
+hwndRead :: Io NativeHandle -> Ptr Word8 -> Word64 -> Int -> IO Int
+hwndRead hwnd ptr offset bytes
+  = fmap fromIntegral $ Mgr.withException "hwndRead" $
+      withOverlapped "hwndRead" (toHANDLE hwnd) offset (startCB ptr) completionCB
+  where
+    startCB outBuf lpOverlapped = do
+      debugIO ":: hwndRead"
+      -- See Note [ReadFile/WriteFile].
+      ret <- c_ReadFile (toHANDLE hwnd) (castPtr outBuf)
+                        (fromIntegral bytes) nullPtr lpOverlapped
+      return $ Mgr.CbNone ret
+
+    completionCB err dwBytes
+      | err == #{const ERROR_SUCCESS}      = Mgr.ioSuccess $ fromIntegral dwBytes
+      | err == #{const ERROR_HANDLE_EOF}   = Mgr.ioSuccess 0
+      | err == #{const STATUS_END_OF_FILE} = Mgr.ioSuccess 0
+      | err == #{const ERROR_MORE_DATA}    = Mgr.ioSuccess $ fromIntegral dwBytes
+      | otherwise                          = Mgr.ioFailed err
+
+-- In WinIO we'll never block in the FFI call, so this call is equivalent to
+-- hwndRead,  Though we may revisit this when implementing sockets and pipes.
+-- It still won't block, but may set up extra book keeping so threadWait and
+-- threadWrite may work.
+hwndReadNonBlocking :: Io NativeHandle -> Ptr Word8 -> Word64 -> Int
+                    -> IO (Maybe Int)
+hwndReadNonBlocking hwnd ptr offset bytes
+  = do val <- withOverlapped "hwndReadNonBlocking" (toHANDLE hwnd) offset
+                              (startCB ptr) completionCB
+       return $ Just $ fromIntegral $ ioValue val
+  where
+    startCB inputBuf lpOverlapped = do
+      debugIO ":: hwndReadNonBlocking"
+      -- See Note [ReadFile/WriteFile].
+      ret <- c_ReadFile (toHANDLE hwnd) (castPtr inputBuf)
+                        (fromIntegral bytes) nullPtr lpOverlapped
+      return $ Mgr.CbNone ret
+
+    completionCB err dwBytes
+      | err == #{const ERROR_SUCCESS}      = Mgr.ioSuccess $ fromIntegral dwBytes
+      | err == #{const ERROR_HANDLE_EOF}   = Mgr.ioSuccess 0
+      | err == #{const STATUS_END_OF_FILE} = Mgr.ioSuccess 0
+      | otherwise                          = Mgr.ioFailed err
+
+hwndWrite :: Io NativeHandle -> Ptr Word8 -> Word64 -> Int -> IO ()
+hwndWrite hwnd ptr offset bytes
+  = do _ <- Mgr.withException "hwndWrite" $
+          withOverlapped "hwndWrite" (toHANDLE hwnd) offset (startCB ptr)
+                         completionCB
+       return ()
+  where
+    startCB outBuf lpOverlapped = do
+      debugIO ":: hwndWrite"
+      -- See Note [ReadFile/WriteFile].
+      ret <- c_WriteFile (toHANDLE hwnd) (castPtr outBuf)
+                         (fromIntegral bytes) nullPtr lpOverlapped
+      return $ Mgr.CbNone ret
+
+    completionCB err dwBytes
+        | err == #{const ERROR_SUCCESS}  =   Mgr.ioSuccess $ fromIntegral dwBytes
+        | err == #{const ERROR_HANDLE_EOF} = Mgr.ioSuccess $ fromIntegral dwBytes
+        | otherwise                        = Mgr.ioFailed err
+
+hwndWriteNonBlocking :: Io NativeHandle -> Ptr Word8 -> Word64 -> Int -> IO Int
+hwndWriteNonBlocking hwnd ptr offset bytes
+  = do val <- withOverlapped "hwndReadNonBlocking" (toHANDLE hwnd) offset
+                             (startCB ptr) completionCB
+       return $ fromIntegral $ ioValue val
+  where
+    startCB outBuf lpOverlapped = do
+      debugIO ":: hwndWriteNonBlocking"
+      -- See Note [ReadFile/WriteFile].
+      ret <- c_WriteFile (toHANDLE hwnd) (castPtr outBuf)
+                         (fromIntegral bytes) nullPtr lpOverlapped
+      return $ Mgr.CbNone ret
+
+    completionCB err dwBytes
+        | err == #{const ERROR_SUCCESS}    = Mgr.ioSuccess $ fromIntegral dwBytes
+        | err == #{const ERROR_HANDLE_EOF} = Mgr.ioSuccess $ fromIntegral dwBytes
+        | otherwise                        = Mgr.ioFailed err
+
+-- Note [ReadFile/WriteFile]
+-- The results of these functions are somewhat different when working in an
+-- asynchronous manner. The returning bool has two meaning.
+--
+-- True: The operation is done and was completed synchronously.  This is
+--       possible because of the optimization flags we enable.  In this case
+--       there won't be a completion event for this call and so we shouldn't
+--       queue one up. If we do this request will never terminate.  It's also
+--       safe to free the OVERLAPPED structure immediately.
+--
+-- False: Only indicates that the operation was not completed synchronously, a
+--        call to GetLastError () is needed to find out the actual status. If
+--        the result is ERROR_IO_PENDING then the operation has been queued on
+--        the completion port and we should proceed asynchronously.  Any other
+--        state is usually an indication that the call failed.
+--
+-- NB. reading an EOF will result in ERROR_HANDLE_EOF or STATUS_END_OF_FILE
+-- during the checking of the completion results.  We need to check for these
+-- so we don't incorrectly fail.
+
+
+consoleWrite :: Io ConsoleHandle -> Ptr Word8 -> Word64 -> Int -> IO ()
+consoleWrite hwnd ptr _offset bytes
+  = alloca $ \res ->
+      do failIfFalse_ "GHC.IO.Handle.consoleWrite" $ do
+           debugIO ":: consoleWrite"
+           withGhcInternalToUTF16 ptr bytes $ \(w_ptr, w_len) -> do
+              success <- c_write_console (toHANDLE hwnd) w_ptr
+                                         (fromIntegral w_len) res nullPtr
+              if not success
+                 then return False
+                 else do val <- fromIntegral <$> peek res
+                         return $ val == w_len
+
+consoleWriteNonBlocking :: Io ConsoleHandle -> Ptr Word8 -> Word64 -> Int -> IO Int
+consoleWriteNonBlocking hwnd ptr _offset bytes
+  = alloca $ \res ->
+      do failIfFalse_ "GHC.IO.Handle.consoleWriteNonBlocking" $ do
+            debugIO ":: consoleWriteNonBlocking"
+            withGhcInternalToUTF16 ptr bytes $ \(w_ptr, w_len) -> do
+              c_write_console (toHANDLE hwnd) w_ptr (fromIntegral w_len)
+                              res nullPtr
+         val <- fromIntegral <$> peek res
+         return val
+
+consoleRead :: Io ConsoleHandle -> Ptr Word8 -> Word64 -> Int -> IO Int
+consoleRead hwnd ptr _offset bytes
+  = withUTF16ToGhcInternal ptr bytes $ \reqBytes w_ptr ->
+      alloca $ \res -> do
+       cooked <- isCooked hwnd
+       -- Cooked input must be handled differently when the STD handles are
+       -- attached to a real console handle.  For File based handles we can't do
+       -- proper cooked inputs, but since the actions are async you would get
+       -- results as soon as available.
+       --
+       -- For console handles We have to use a lower level API then ReadConsole,
+       -- namely we must use ReadConsoleInput which requires us to process
+       -- all console message manually.
+       --
+       -- Do note that MSYS2 shells such as bash don't attach to a real handle,
+       -- and instead have by default a pipe/file based std handles.  Which
+       -- means the cooked behaviour is best when used in a native Windows
+       -- terminal such as cmd, powershell or ConEmu.
+       case cooked of
+        False -> do
+          debugIO "consoleRead :: un-cooked I/O read."
+          -- eotControl allows us to handle control characters like EOL
+          -- without needing a newline, which would sort of defeat the point
+          -- of an EOL.
+          res_code <- with eotControl $ \p_eotControl ->
+                c_read_console (toHANDLE hwnd) w_ptr (fromIntegral reqBytes) res
+                               p_eotControl
+
+          -- Restore a quirk of the POSIX read call, which only returns a fail
+          -- when the handle is invalid, e.g. closed or not a handle.  It how-
+          -- ever returns 0 when the handle is valid but unreadable, such as
+          -- passing a handle with no GENERIC_READ permission, like /dev/null
+          err <- getLastError
+          when (not res_code) $
+            case () of
+             _ | err == #{const ERROR_INVALID_FUNCTION} -> return ()
+               | otherwise -> failWith "GHC.IO.Handle.consoleRead" err
+          b_read <- fromIntegral <$> peek res
+          if b_read /= 1
+              then return b_read
+              else do w_first <- peekElemOff w_ptr 0
+                      case () of
+                        -- Handle Ctrl+Z which is the actual EOL sequence on
+                        -- windows, but also hanlde Ctrl+D which is what the
+                        -- ASCII standard defines as EOL.
+                        _ | w_first == fromIntegral acCtrlD -> return 0
+                          | w_first == fromIntegral acCtrlZ -> return 0
+                          | otherwise                       -> return b_read
+        True -> do
+          debugIO "consoleRead :: cooked I/O read."
+          -- Input is cooked, don't wait till a line return and consume all
+          -- characters as they are.  Technically this function can handle any
+          -- console event.  Including mouse, window and virtual key events
+          -- but for now I'm only interested in key presses.
+          let entries = fromIntegral $ reqBytes `div` (#size INPUT_RECORD)
+          allocaBytes entries $ \p_inputs ->
+            readEvent p_inputs entries res w_ptr
+
+    where readEvent p_inputs entries res w_ptr = do
+            failIfFalse_ "GHC.IO.Handle.consoleRead" $
+              c_read_console_input (toHANDLE hwnd) p_inputs
+                                   (fromIntegral entries) res
+
+            b_read <- fromIntegral <$> peek res
+            read <- cobble b_read w_ptr p_inputs
+            if read > 0
+               then return $ fromIntegral read
+               else readEvent p_inputs entries res w_ptr
+
+          -- Dereference and read console input records.  We only read the bare
+          -- minimum required to know which key/sequences were pressed.  To do
+          -- this and prevent having to fully port the PINPUT_RECORD structure
+          -- in Haskell we use some GCC builtins to find the correct offsets.
+          cobble :: Int -> Ptr Word16 -> PINPUT_RECORD -> IO Int
+          cobble 0 _ _ = do debugIO "cobble: done."
+                            return 0
+          cobble n w_ptr p_inputs =
+            do eventType <- peekByteOff p_inputs 0 :: IO WORD
+               debugIO $ "cobble: Length=" ++ show n
+               debugIO $ "cobble: Type=" ++ show eventType
+               let ni_offset      = #size INPUT_RECORD
+               let event          = #{const __builtin_offsetof (INPUT_RECORD, Event)}
+               let char_offset    = event + #{const __builtin_offsetof (KEY_EVENT_RECORD, uChar)}
+               let btnDown_offset = event + #{const __builtin_offsetof (KEY_EVENT_RECORD, bKeyDown)}
+               let repeat_offset  = event + #{const __builtin_offsetof (KEY_EVENT_RECORD, wRepeatCount)}
+               let n'             = n - 1
+               let p_inputs'      = p_inputs `plusPtr` ni_offset
+               btnDown  <- peekByteOff p_inputs btnDown_offset
+               repeated <- fromIntegral <$> (peekByteOff p_inputs repeat_offset :: IO WORD)
+               debugIO $ "cobble: BtnDown=" ++ show btnDown
+               -- Handle the key only on button down and not on button up.
+               if eventType == #{const KEY_EVENT} && btnDown
+                  then do debugIO $ "cobble: read-char."
+                          char <- peekByteOff p_inputs char_offset
+                          let w_ptr'      = w_ptr `plusPtr` 1
+                          debugIO $ "cobble: offset - " ++ show char_offset
+                          debugIO $ "cobble: show > " ++ show char
+                          debugIO $ "cobble: repeat: " ++ show repeated
+                          pokeArray w_ptr $ replicate repeated char
+                          (+1) <$> cobble n' w_ptr' p_inputs'
+                  else do debugIO $ "cobble: skip event."
+                          cobble n' w_ptr p_inputs'
+
+
+consoleReadNonBlocking :: Io ConsoleHandle -> Ptr Word8 -> Word64 -> Int
+                       -> IO (Maybe Int)
+consoleReadNonBlocking hwnd ptr offset bytes
+  = Just <$> consoleRead hwnd ptr offset bytes
+
+-- -----------------------------------------------------------------------------
+-- Operations on file handles
+
+handle_ready :: RawHandle a => a -> Bool -> Int -> IO Bool
+handle_ready hwnd write msecs = do
+  r <- throwErrnoIfMinus1Retry "GHC.IO.Windows.Handle.handle_ready" $
+          c_handle_ready (toHANDLE hwnd) write (fromIntegral msecs)
+  return (toEnum (fromIntegral r))
+
+handle_is_console :: RawHandle a => a -> IO Bool
+handle_is_console = c_is_console . toHANDLE
+
+handle_close :: RawHandle a => a -> IO ()
+handle_close h = do release h
+                    failIfFalse_ "handle_close" $ c_close_handle (toHANDLE h)
+
+handle_dev_type :: RawHandle a => a -> IO IODeviceType
+handle_dev_type hwnd = do _type <- c_handle_type $ toHANDLE hwnd
+                          return $ case _type of
+                                     _ | _type == 3 -> Stream
+                                       | _type == 5 -> RawDevice
+                                       | otherwise  -> RegularFile
+
+handle_is_seekable :: RawHandle a => a -> IO Bool
+handle_is_seekable hwnd = do
+  t <- handle_dev_type hwnd
+  return (t == RegularFile || t == RawDevice)
+
+handle_seek :: RawHandle a => a -> SeekMode -> Integer -> IO Integer
+handle_seek hwnd mode off =
+  with 0 $ \off_rel -> do
+    failIfFalse_ "GHC.IO.Handle.handle_seek" $
+        c_set_file_pointer (toHANDLE hwnd) (fromIntegral off) seektype off_rel
+    fromIntegral <$> peek off_rel
+ where
+    seektype :: DWORD
+    seektype = case mode of
+                   AbsoluteSeek -> #{const FILE_BEGIN}
+                   RelativeSeek -> #{const FILE_CURRENT}
+                   SeekFromEnd  -> #{const FILE_END}
+
+handle_tell :: RawHandle a => a -> IO Integer
+handle_tell hwnd =
+   fromIntegral `fmap`
+      (throwErrnoIfMinus1Retry "GHC.IO.Handle.handle_tell" $
+          c_get_file_pointer (toHANDLE hwnd))
+
+handle_set_size :: RawHandle a => a -> Integer -> IO ()
+handle_set_size hwnd size =
+  failIfFalse_ "GHC.IO.Handle.handle_set_size" $
+      c_set_file_size (toHANDLE hwnd) (fromIntegral size)
+
+handle_get_size :: RawHandle a => a -> IO Integer
+handle_get_size hwnd =
+   fromIntegral `fmap`
+      (throwErrnoIfMinus1Retry "GHC.IO.Handle.handle_set_size" $
+          c_get_file_size (toHANDLE hwnd))
+
+handle_set_echo :: RawHandle a => a -> Bool -> IO ()
+handle_set_echo hwnd value =
+  failIfFalse_ "GHC.IO.Handle.handle_set_echo" $
+      c_set_console_echo (toHANDLE hwnd) value
+
+handle_get_echo :: RawHandle a => a -> IO Bool
+handle_get_echo = c_get_console_echo . toHANDLE
+
+handle_duplicate :: RawHandle a => a -> IO a
+handle_duplicate hwnd = alloca $ \ptr -> do
+  failIfFalse_ "GHC.IO.Handle.handle_duplicate" $
+      c_duplicate_handle (toHANDLE hwnd) ptr
+  fromHANDLE <$> peek ptr
+
+console_set_buffering :: Io ConsoleHandle -> Bool -> IO ()
+console_set_buffering hwnd value = setCooked hwnd value >> return ()
+
+handle_set_buffering :: RawHandle a => a -> Bool -> IO ()
+handle_set_buffering hwnd value =
+  failIfFalse_ "GHC.IO.Handle.handle_set_buffering" $
+      c_set_console_buffering (toHANDLE hwnd) value
+
+handle_console_seek :: RawHandle a => a -> SeekMode -> Integer -> IO Integer
+handle_console_seek hwnd mode off =
+  with 0 $ \loc_ptr -> do
+    failIfFalse_ "GHC.IO.Handle.handle_console_seek" $
+      c_set_console_pointer (toHANDLE hwnd) (fromIntegral off) seektype loc_ptr
+    fromIntegral <$> peek loc_ptr
+ where
+    seektype :: DWORD
+    seektype = case mode of
+                 AbsoluteSeek -> #{const FILE_BEGIN}
+                 RelativeSeek -> #{const FILE_CURRENT}
+                 SeekFromEnd  -> #{const FILE_END}
+
+handle_console_tell :: RawHandle a => a -> IO Integer
+handle_console_tell hwnd =
+   fromIntegral `fmap`
+      (throwErrnoIfMinus1Retry "GHC.IO.Handle.handle_console_tell" $
+          c_get_console_pointer (toHANDLE hwnd))
+
+handle_set_console_size :: RawHandle a => a -> Integer -> IO ()
+handle_set_console_size hwnd size =
+  failIfFalse_ "GHC.IO.Handle.handle_set_console_size" $
+      c_set_console_buffer_size (toHANDLE hwnd) (fromIntegral size)
+
+handle_get_console_size :: RawHandle a => a -> IO Integer
+handle_get_console_size hwnd =
+   fromIntegral `fmap`
+      (throwErrnoIfMinus1Retry "GHC.IO.Handle.handle_get_console_size" $
+          c_get_console_buffer_size (toHANDLE hwnd))
+
+-- -----------------------------------------------------------------------------
+-- opening files
+
+-- | Open a file and make an 'NativeHandle' for it.  Truncates the file to zero
+-- size when the `IOMode` is `WriteMode`.
+openFile
+  :: FilePath -- ^ file to open
+  -> IOMode   -- ^ mode in which to open the file
+  -> Bool     -- ^ open the file in non-blocking mode?
+  -> IO (Io NativeHandle, IODeviceType)
+openFile filepath iomode non_blocking =
+   do devicepath <- getDevicePath filepath
+      h <- createFile devicepath
+      -- Attach the handle to the I/O manager's CompletionPort.  This allows the
+      -- I/O manager to service requests for this Handle.
+      Mgr.associateHandle' h
+      let hwnd = fromHANDLE h
+      _type <- devType hwnd
+
+      -- Use the rts to enforce any file locking we may need.
+      let write_lock = iomode /= ReadMode
+
+      case _type of
+        -- Regular files need to be locked.
+        RegularFile -> do
+          optimizeFileAccess h -- Set a few optimization flags on file handles.
+          (unique_dev, unique_ino) <- getUniqueFileInfo hwnd
+          r <- lockFile (fromIntegral $ ptrToWordPtr h) unique_dev unique_ino
+                        (fromBool write_lock)
+          when (r == -1)  $
+               ioException (IOError Nothing ResourceBusy "openFile"
+                                  "file is locked" Nothing Nothing)
+
+        -- I don't see a reason for blocking directories.  So unlike the FD
+        -- implementation I'll allow it.
+        _ -> return ()
+
+      -- We want to truncate() if this is an open in WriteMode, but only
+      -- if the target is a RegularFile.  but TRUNCATE_EXISTING would fail if
+      -- the file didn't exit.  So just set the size afterwards.
+      when (iomode == WriteMode && _type == RegularFile) $
+        setSize hwnd 0
+
+      return (hwnd, _type)
+        where
+          -- We have to use in-process locking (e.g. use the locking mechanism
+          -- in the rts) so we're consistent with the linux behavior and the
+          -- rts knows about the lock.  See #4363 for more.
+          file_share_mode =  #{const FILE_SHARE_READ}
+                         .|. #{const FILE_SHARE_WRITE}
+                         .|. #{const FILE_SHARE_DELETE}
+
+          file_access_mode =
+            case iomode of
+              ReadMode      -> #{const GENERIC_READ}
+              WriteMode     -> #{const GENERIC_WRITE}
+              ReadWriteMode -> #{const GENERIC_READ}
+                            .|. #{const GENERIC_WRITE}
+              AppendMode    -> #{const GENERIC_WRITE}
+                            .|. #{const FILE_APPEND_DATA}
+
+          file_open_mode =
+            case iomode of
+              ReadMode      -> #{const OPEN_EXISTING} -- O_RDONLY
+              WriteMode     -> #{const OPEN_ALWAYS}   -- O_CREAT | O_WRONLY | O_TRUNC
+              ReadWriteMode -> #{const OPEN_ALWAYS}   -- O_CREAT | O_RDWR
+              AppendMode    -> #{const OPEN_ALWAYS}   -- O_APPEND
+
+          file_create_flags =
+            if non_blocking
+               -- On Windows, the choice of whether an operation completes
+               -- asynchronously or not depends on how the Handle was created
+               -- and not on the operation called.  As in, the behaviour of
+               -- ReadFile and WriteFile depends on the flags used to open the
+               -- handle.   For WinIO we always use FILE_FLAG_OVERLAPPED, which
+               -- means we always issue asynchronous file operation using an
+               -- OVERLAPPED structure.  All blocking, if required must be done
+               -- on the Haskell side by using existing mechanisms such as MVar
+               -- or IOPorts.
+               then #{const FILE_FLAG_OVERLAPPED}
+                    -- I beleive most haskell programs do sequential scans, so
+                    -- optimize for the common case.  Though ideally, this would
+                    -- be parameterized by openFile.  This will absolutely trash
+                    -- the cache on reverse scans.
+                    --
+                    -- TODO: make a parameter to openFile and specify only for
+                    -- operations we know are sequential.  This parameter should
+                    -- be usable by madvise too.
+                    .|. #{const FILE_FLAG_SEQUENTIAL_SCAN}
+               else #{const FILE_ATTRIBUTE_NORMAL}
+
+          createFile devicepath =
+            withCWString devicepath $ \fp ->
+                failIf (== iNVALID_HANDLE_VALUE) "CreateFile" $
+                      c_CreateFile fp file_access_mode
+                                      file_share_mode
+                                      nullPtr
+                                      file_open_mode
+                                      file_create_flags
+                                      nullPtr
+
+          -- Tell the OS that we support skipping the request Queue if the
+          -- IRQ can be handled immediately, e.g. if the data is in the cache.
+          optimizeFileAccess handle =
+              failIfFalse_ "SetFileCompletionNotificationModes"  $
+                c_SetFileCompletionNotificationModes handle
+                    (    #{const FILE_SKIP_COMPLETION_PORT_ON_SUCCESS}
+                     .|. #{const FILE_SKIP_SET_EVENT_ON_HANDLE})
+
+release :: RawHandle a => a -> IO ()
+release h = if isLockable h
+               then do let handle = fromIntegral $ ptrToWordPtr $ toHANDLE h
+                       _ <- unlockFile handle
+                       return ()
+               else return ()
+
+-- -----------------------------------------------------------------------------
+-- Locking/unlocking
+
+foreign import ccall unsafe "lockFile"
+  lockFile :: CUIntPtr -> Word64 -> Word64 -> CInt -> IO CInt
+
+foreign import ccall unsafe "unlockFile"
+  unlockFile :: CUIntPtr -> IO CInt
+
+foreign import ccall unsafe "get_unique_file_info_hwnd"
+  c_getUniqueFileInfo :: HANDLE -> Ptr Word64 -> Ptr Word64 -> IO ()
+
+getUniqueFileInfo :: RawHandle a => a -> IO (Word64, Word64)
+getUniqueFileInfo handle = do
+  with 0 $ \devptr -> do
+    with 0 $ \inoptr -> do
+      c_getUniqueFileInfo (toHANDLE handle) devptr inoptr
+      liftM2 (,) (peek devptr) (peek inoptr)
diff --git a/libraries/base/GHC/IO/Windows/Paths.hs b/libraries/base/GHC/IO/Windows/Paths.hs
new file mode 100644
index 0000000000..851dc37508
--- /dev/null
+++ b/libraries/base/GHC/IO/Windows/Paths.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE Trustworthy          #-}
+{-# LANGUAGE NoImplicitPrelude    #-}
+{-# LANGUAGE CPP                  #-}
+-- Whether there are identities depends on the platform
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Windows.Paths
+-- Copyright   :  (c) The University of Glasgow, 2017
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- Windows FilePath handling utility for GHC code.
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Windows.Paths
+ (getDevicePath
+ ) where
+
+#include "windows_cconv.h"
+
+import GHC.Base
+import GHC.IO
+
+import Foreign.C.String
+import Foreign.Marshal.Alloc (free)
+
+foreign import WINDOWS_CCONV safe "__hs_create_device_name"
+    c_GetDevicePath :: CWString -> IO CWString
+
+-- | This function converts Windows paths between namespaces. More specifically
+-- It converts an explorer style path into a NT or Win32 namespace.
+-- This has several caveats but they are caviats that are native to Windows and
+-- not POSIX. See
+-- https://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx.
+-- Anything else such as raw device paths we leave untouched.  The main benefit
+-- of doing any of this is that we can break the MAX_PATH restriction and also
+-- access raw handles that we couldn't before.
+getDevicePath :: FilePath -> IO FilePath
+getDevicePath path
+  = do str <- withCWString path c_GetDevicePath
+       newPath <- peekCWString str
+       free str
+       return newPath
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index 841b5d251b..aee0c20d29 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -232,12 +232,16 @@ Library
         GHC.IO.FD
         GHC.IO.Handle
         GHC.IO.Handle.FD
+        GHC.IO.Handle.Windows
         GHC.IO.Handle.Internals
         GHC.IO.Handle.Lock
         GHC.IO.Handle.Text
         GHC.IO.Handle.Types
         GHC.IO.IOMode
         GHC.IO.Unsafe
+        GHC.IO.SmartHandles
+        GHC.IO.SubSystem
+        GHC.IO.Types
         GHC.IOArray
         GHC.IORef
         GHC.Int
@@ -339,6 +343,7 @@ Library
         cbits/md5.c
         cbits/primFloat.c
         cbits/sysconf.c
+        cbits/IOutils.c
         cbits/fs.c
 
     cmm-sources:
diff --git a/libraries/base/cbits/IOutils.c b/libraries/base/cbits/IOutils.c
new file mode 100644
index 0000000000..5b154e6616
--- /dev/null
+++ b/libraries/base/cbits/IOutils.c
@@ -0,0 +1,470 @@
+/*
+ * (c) The GHC Team 2017-2018.
+ *
+ * I/O Utility functions for Windows.
+ */
+
+#include <stdbool.h>
+#include <stdint.h>
+#include <winsock2.h>
+#include <windows.h>
+#include <io.h>
+#include <math.h>
+
+/* Import some functions defined in base.  */
+extern void maperrno(void);
+
+/* Enum of Handle type.  */
+typedef
+enum HandleType
+  {
+    TYPE_CHAR,   // 0
+    TYPE_DISK,   // 1
+    TYPE_PIPE,   // 2
+    TYPE_SOCKET, // 3
+    TYPE_REMOTE, // 4
+    TYPE_RAW,    // 5
+    TYPE_UNKNOWN // 6
+  } HANDLE_TYPE;
+
+/*
+ * handleReady(hwnd) checks to see whether input is available on the file
+ * handle 'hwnd'.  Input meaning 'can I safely read at least a
+ * *character* from this file object without blocking?'
+ */
+int
+__handle_ready(HANDLE hFile, bool write, int msecs)
+{
+    DWORD handleType = GetFileType (hFile);
+
+    DWORD rc;
+        DWORD avail;
+
+    switch (handleType)
+      {
+        case FILE_TYPE_CHAR:
+        {
+            INPUT_RECORD buf[1];
+            DWORD count;
+
+            /* A Console Handle will appear to be ready
+             (WaitForSingleObject() returned WAIT_OBJECT_0) when
+             it has events in its input buffer, but these events might
+             not be keyboard events, so when we read from the Handle the
+             read() will block.  So here we try to discard non-keyboard
+             events from a console handle's input buffer and then try
+             the WaitForSingleObject() again.
+             Phyx: I'm worried that we're discarding events someone else may need.  */
+            while (true) // keep trying until we find a real key event
+            {
+                rc = WaitForSingleObject( hFile, msecs );
+                switch (rc)
+                  {
+                    case WAIT_TIMEOUT:
+                        return false;
+                    case WAIT_OBJECT_0:
+                        break;
+                    default:
+                        /* WAIT_FAILED */
+                        maperrno();
+                        return -1;
+                  }
+
+                while (true) // discard non-key events
+                {
+                    /* I wonder if we can do better by grabbing a list of
+                       input records at a time by using PeekConsoleInput.  */
+                    rc = PeekConsoleInput(hFile, buf, 1, &count);
+                    if (rc == 0) {
+                        rc = GetLastError();
+                        if (rc == ERROR_INVALID_HANDLE || rc == ERROR_INVALID_FUNCTION)
+                            return true;
+                        else {
+                            maperrno();
+                            return -1;
+                        }
+                    }
+
+                    if (count == 0)
+                        break; /* no more events => wait again.  */
+
+                    /* discard console events that are not "key down", because
+                       these will also be discarded by ReadFile().  */
+                    if (buf[0].EventType == KEY_EVENT &&
+                        buf[0].Event.KeyEvent.bKeyDown &&
+                        buf[0].Event.KeyEvent.uChar.AsciiChar != '\0')
+                          return true; /* it's a proper keypress.  */
+                    else
+                    {
+                        /* it's a non-key event, a key up event, or a
+                           non-character key (e.g. shift).  discard it.  */
+                        rc = ReadConsoleInput(hFile, buf, 1, &count);
+                        if (rc == 0) {
+                            rc = GetLastError();
+                            if (rc == ERROR_INVALID_HANDLE || rc == ERROR_INVALID_FUNCTION)
+                                return true;
+                            else {
+                                maperrno();
+                                return -1;
+                            }
+                        }
+                    }
+                }
+            }
+        }
+        case FILE_TYPE_DISK:
+            /* assume that disk files are always ready.  */
+            return true;
+
+        case FILE_TYPE_PIPE:
+        {
+            // Try to see if this is a socket
+            //-------------------------
+            // Create new event
+            WSAEVENT newEvent = WSACreateEvent();
+
+            //-------------------------
+            // Associate event types FD_WRITE or FD_READ
+            // with the listening socket and NewEvent
+            rc = WSAEventSelect((SOCKET)hFile, newEvent, write ? FD_WRITE : FD_READ);
+
+            if (rc == WSAENOTSOCK)
+            {
+                CloseHandle (newEvent);
+
+                // WaitForMultipleObjects() doesn't work for pipes (it
+                // always returns WAIT_OBJECT_0 even when no data is
+                // available).  If the HANDLE is a pipe, therefore, we try
+                // PeekNamedPipe:
+                //
+                rc = PeekNamedPipe( hFile, NULL, 0, NULL, &avail, NULL );
+                if (rc != 0)
+                    return avail != 0;
+                else {
+                    rc = GetLastError();
+                    if (rc == ERROR_BROKEN_PIPE)
+                        return true; // this is probably what we want
+
+                    if (rc != ERROR_INVALID_HANDLE && rc != ERROR_INVALID_FUNCTION) {
+                        maperrno();
+                        return -1;
+                    }
+                }
+                /* PeekNamedPipe didn't work - fall through to the general case */
+            }
+            else if (rc != 0)
+            {
+                CloseHandle (newEvent);
+                // It seems to be a socket but can't determine the state.
+                // Maybe not initialized. Either way, we know enough.
+                return false;
+            }
+
+            // Wait for the socket event to trigger.
+            rc = WaitForSingleObject( newEvent, msecs );
+            CloseHandle (newEvent);
+
+            /* 1 => Input ready, 0 => not ready, -1 => error */
+            switch (rc)
+              {
+                case WAIT_TIMEOUT:
+                    return false;
+                case WAIT_OBJECT_0:
+                    return true;
+                default:
+                {
+                    /* WAIT_FAILED */
+                    maperrno();
+                    return -1;
+                }
+              }
+        }
+        default:
+            rc = WaitForSingleObject( hFile, msecs );
+
+            /* 1 => Input ready, 0 => not ready, -1 => error */
+            switch (rc)
+              {
+                case WAIT_TIMEOUT:
+                    return false;
+                case WAIT_OBJECT_0:
+                    return true;
+                default:
+                {
+                    /* WAIT_FAILED */
+                    maperrno();
+                    return -1;
+                }
+              }
+      }
+}
+
+bool
+__is_console(HANDLE hFile)
+{
+    /* Broken handle can't be terminal */
+    if (hFile == INVALID_HANDLE_VALUE)
+        return false;
+
+    DWORD handleType = GetFileType (hFile);
+
+    /* TTY must be a character device */
+    if (handleType == FILE_TYPE_CHAR)
+        return true;
+
+    DWORD st;
+    /* GetConsoleMode appears to fail when it's not a TTY.  In
+       particular, it's what most of our terminal functions
+       assume works, so if it doesn't work for all intents
+       and purposes we're not dealing with a terminal. */
+    if (!GetConsoleMode(hFile, &st)) {
+        /* Clear the error buffer before returning.  */
+        SetLastError (ERROR_SUCCESS);
+        return false;
+    }
+
+    return true;
+}
+
+#if !defined(ENABLE_VIRTUAL_TERMINAL_INPUT)
+#define ENABLE_VIRTUAL_TERMINAL_INPUT 0x0200
+#endif
+
+bool
+__set_console_buffering(HANDLE hFile, bool cooked)
+{
+    if (hFile == INVALID_HANDLE_VALUE) {
+        return false;
+    }
+
+    DWORD  st;
+    if (!GetConsoleMode(hFile, &st)) {
+        return false;
+    }
+
+    /* According to GetConsoleMode() docs, it is not possible to
+       leave ECHO_INPUT enabled without also having LINE_INPUT,
+       so we have to turn both off here.
+       We toggle ENABLE_VIRTUAL_TERMINAL_INPUT to enable us to receive
+       virtual keyboard keys in ReadConsole.  */
+    DWORD flgs = ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT;
+    DWORD enabled = (st & ~flgs) | ENABLE_VIRTUAL_TERMINAL_INPUT;
+    DWORD disabled = (st | ENABLE_LINE_INPUT) & ~ENABLE_VIRTUAL_TERMINAL_INPUT;
+
+
+        return SetConsoleMode(hFile, cooked ? enabled : disabled);
+}
+
+bool
+__set_console_echo(HANDLE hFile, bool on)
+{
+    DWORD  st;
+    DWORD flgs = ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT;
+
+    if (hFile == INVALID_HANDLE_VALUE) {
+        return false;
+    }
+
+        return GetConsoleMode(hFile, &st) &&
+               SetConsoleMode(hFile, ( on ? (st | flgs) : (st & ~flgs)));
+}
+
+bool
+__get_console_echo(HANDLE hFile)
+{
+    DWORD  st;
+
+    if (hFile == INVALID_HANDLE_VALUE) {
+        return false;
+    }
+
+        return GetConsoleMode(hFile, &st) &&
+               (st & ENABLE_ECHO_INPUT) == ENABLE_ECHO_INPUT;
+}
+
+bool
+__flush_input_console(HANDLE hFile)
+{
+    if ( hFile == INVALID_HANDLE_VALUE )
+      return false;
+
+        /* If the 'handle' isn't connected to a console; treat the flush
+         * operation as a NOP.
+         */
+        DWORD unused;
+        if ( !GetConsoleMode(hFile, &unused) &&
+             GetLastError() == ERROR_INVALID_HANDLE ) {
+            return false;
+        }
+
+        if ( FlushConsoleInputBuffer(hFile) )
+            return true;
+
+    maperrno();
+    return false;
+}
+
+HANDLE_TYPE
+__handle_type (HANDLE hFile)
+{
+    DWORD handleType = GetFileType (hFile);
+    switch (handleType)
+      {
+        case FILE_TYPE_PIPE:
+          {
+            WSAEVENT newEvent = WSACreateEvent();
+            DWORD rc = WSAEventSelect((SOCKET)hFile, newEvent, FD_CLOSE);
+            CloseHandle (newEvent);
+            if (rc == WSAENOTSOCK)
+              return TYPE_SOCKET;
+            else
+              return TYPE_PIPE;
+          }
+        case FILE_TYPE_CHAR:
+          return TYPE_CHAR;
+        case FILE_TYPE_DISK:
+          return TYPE_DISK;
+        case FILE_TYPE_REMOTE:
+          return TYPE_REMOTE;
+        case FILE_TYPE_UNKNOWN:
+        default:
+          return TYPE_UNKNOWN;
+      }
+}
+
+bool
+__close_handle (HANDLE hFile)
+{
+    switch (__handle_type (hFile))
+      {
+        case TYPE_SOCKET:
+            return closesocket ((SOCKET)hFile) == 0;
+        default:
+            return CloseHandle (hFile);
+      }
+}
+
+bool __set_file_pointer (HANDLE hFile, int64_t pos, DWORD moveMethod,
+                         int64_t* outPos)
+{
+    LARGE_INTEGER ret;
+    LARGE_INTEGER li;
+    li.QuadPart = pos;
+    bool success = SetFilePointerEx (hFile, li, &ret, moveMethod)
+                    != INVALID_SET_FILE_POINTER;
+    *outPos = ret.QuadPart;
+    return success;
+}
+
+int64_t __get_file_pointer (HANDLE hFile)
+{
+    LARGE_INTEGER ret;
+    LARGE_INTEGER pos;
+    pos.QuadPart = 0;
+    if (SetFilePointerEx(hFile, pos, &ret, FILE_CURRENT)
+        == INVALID_SET_FILE_POINTER)
+      return -1;
+
+    return ret.QuadPart;
+}
+
+int64_t __get_file_size (HANDLE hFile)
+{
+    LARGE_INTEGER ret;
+    if (!GetFileSizeEx(hFile, &ret))
+      return -1;
+
+    return ret.QuadPart;
+}
+
+bool __set_file_size (HANDLE hFile, int64_t size)
+{
+    LARGE_INTEGER li;
+    li.QuadPart = size;
+    if(!SetFilePointerEx (hFile, li, NULL, FILE_BEGIN))
+        return false;
+
+    return SetEndOfFile (hFile);
+}
+
+bool __duplicate_handle (HANDLE hFile, HANDLE* hFileDup)
+{
+    switch (__handle_type (hFile))
+    {
+        case TYPE_SOCKET:
+            // should use WSADuplicateSocket
+            return false;
+        default:
+            return DuplicateHandle(GetCurrentProcess(),
+                                hFile,
+                                GetCurrentProcess(),
+                                hFileDup,
+                                0,
+                                FALSE,
+                                DUPLICATE_SAME_ACCESS);
+    }
+}
+
+bool __set_console_pointer (HANDLE hFile, int64_t pos, DWORD moveMethod,
+                            int64_t* outPos)
+{
+    CONSOLE_SCREEN_BUFFER_INFO info;
+    if(!GetConsoleScreenBufferInfo (hFile, &info))
+        return false;
+
+    COORD point;
+    switch (moveMethod)
+    {
+        case FILE_END:
+          {
+              int64_t end = info.dwSize.X * info.dwSize.Y;
+              pos = end + pos;
+              point = (COORD) { pos % info.dwSize.X, pos / info.dwSize.X };
+              break;
+          }
+        case FILE_CURRENT:
+          {
+              int64_t current = (info.dwCursorPosition.Y * info.dwSize.X)
+                              + info.dwCursorPosition.X;
+              pos = current + pos;
+              point = (COORD) { pos % info.dwSize.X, pos / info.dwSize.X };
+              break;
+          }
+        case FILE_BEGIN:
+        default:
+          point = (COORD) { pos % info.dwSize.X, pos / info.dwSize.X };
+          break;
+    }
+
+    *outPos = pos;
+    return SetConsoleCursorPosition (hFile, point);
+}
+
+int64_t __get_console_pointer (HANDLE hFile)
+{
+    CONSOLE_SCREEN_BUFFER_INFO info;
+    if(!GetConsoleScreenBufferInfo (hFile, &info))
+        return -1;
+
+    return (info.dwCursorPosition.Y * info.dwSize.X) + info.dwCursorPosition.X;
+}
+
+int64_t __get_console_buffer_size (HANDLE hFile)
+{
+    CONSOLE_SCREEN_BUFFER_INFO ret;
+    if (!GetConsoleScreenBufferInfo(hFile, &ret))
+      return -1;
+
+    return ret.dwSize.X * ret.dwSize.Y;
+}
+
+bool __set_console_buffer_size (HANDLE hFile, int64_t size)
+{
+    CONSOLE_SCREEN_BUFFER_INFO ret;
+    if (!GetConsoleScreenBufferInfo(hFile, &ret))
+      return false;
+
+    COORD sz = {ret.dwSize.X, (int)ceil(size / ret.dwSize.X)};
+    return SetConsoleScreenBufferSize (hFile, sz);
+}
+
diff --git a/libraries/base/include/alignment.h b/libraries/base/include/alignment.h
new file mode 100644
index 0000000000..cb2f7da35f
--- /dev/null
+++ b/libraries/base/include/alignment.h
@@ -0,0 +1,3 @@
+#if __GLASGOW_HASKELL__ < 711
+#define hsc_alignment(t ) hsc_printf ( "%lu", (unsigned long)offsetof(struct {char x__; t(y__); }, y__));
+#endif