Get rid of concurrent-output

Also improve some NO_COLOR foo.

lib/System/Console/Terminal/Common.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveTraversable #-}
+
+#if __GLASGOW_HASKELL__ >= 702
+#define LANGUAGE_DeriveGeneric
+{-# LANGUAGE DeriveGeneric #-}
+#endif
+
+module System.Console.Terminal.Common
+  ( Window(..)
+  ) where
+
+import Data.Data (Typeable, Data)
+
+#if __GLASGOW_HASKELL__ < 710
+import Data.Foldable (Foldable)
+import Data.Traversable (Traversable)
+#endif
+
+#ifdef LANGUAGE_DeriveGeneric
+import GHC.Generics
+  ( Generic
+#if __GLASGOW_HASKELL__ >= 706
+  , Generic1
+#endif
+  )
+#endif
+
+-- | Terminal window width and height
+data Window a = Window
+  { height :: !a
+  , width  :: !a
+  } deriving
+    ( Show, Eq, Read, Data, Typeable
+    , Foldable, Functor, Traversable
+#ifdef LANGUAGE_DeriveGeneric
+    , Generic
+#if __GLASGOW_HASKELL__ >= 706
+    , Generic1
+#endif
+#endif
+    )

lib/System/Console/Terminal/Posix.hsc

@@ -0,0 +1,65 @@
+{-# LANGUAGE CApiFFI #-}
+
+module System.Console.Terminal.Posix
+  ( size, fdSize, hSize
+  ) where
+
+import System.Console.Terminal.Common
+import Control.Exception (catch)
+import Data.Typeable (cast)
+import Foreign
+import Foreign.C.Error
+import Foreign.C.Types
+import GHC.IO.FD (FD(FD, fdFD))
+import GHC.IO.Handle.Internals (withHandle_)
+import GHC.IO.Handle.Types (Handle, Handle__(Handle__, haDevice))
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 706)
+import Prelude hiding (catch)
+#endif
+import System.Posix.Types (Fd(Fd))
+
+#include <sys/ioctl.h>
+#include <unistd.h>
+
+
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+
+
+-- Interesting part of @struct winsize@
+data CWin = CWin CUShort CUShort
+
+instance Storable CWin where
+  sizeOf _ = (#size struct winsize)
+  alignment _ = (#alignment struct winsize)
+  peek ptr = do
+    row <- (#peek struct winsize, ws_row) ptr
+    col <- (#peek struct winsize, ws_col) ptr
+    return $ CWin row col
+  poke ptr (CWin row col) = do
+    (#poke struct winsize, ws_row) ptr row
+    (#poke struct winsize, ws_col) ptr col
+
+
+fdSize :: Integral n => Fd -> IO (Maybe (Window n))
+fdSize (Fd fd) = with (CWin 0 0) $ \ws -> do
+  _ <- throwErrnoIfMinus1 "ioctl" $
+    ioctl fd (#const TIOCGWINSZ) ws
+  CWin row col <- peek ws
+  return . Just $ Window (fromIntegral row) (fromIntegral col)
+ `catch`
+  handler
+ where
+  handler :: IOError -> IO (Maybe (Window h))
+  handler _ = return Nothing
+
+foreign import capi "sys/ioctl.h ioctl"
+  ioctl :: CInt -> CULong -> Ptr CWin -> IO CInt
+
+size :: Integral n => IO (Maybe (Window n))
+size = fdSize (Fd (#const STDOUT_FILENO))
+
+hSize :: Integral n => Handle -> IO (Maybe (Window n))
+hSize h = withHandle_ "hSize" h $ \Handle__ { haDevice = dev } ->
+  case cast dev of
+    Nothing -> return Nothing
+    Just FD { fdFD = fd } -> fdSize (Fd fd)