{-# LINE 1 "src/unix/System/Terminal.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module System.Terminal
( getTerminalWidth
) where

import           Foreign
import           Foreign.C.Types




newtype WindowWidth = WindowWidth CUShort
    deriving (Eq, Ord, Show)

instance Storable WindowWidth where
  sizeOf _ = ((8))
{-# LINE 18 "src/unix/System/Terminal.hsc" #-}
  alignment _ = (2)
{-# LINE 19 "src/unix/System/Terminal.hsc" #-}
  peek p = WindowWidth <$> ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 20 "src/unix/System/Terminal.hsc" #-}
  poke p (WindowWidth w) = do
    ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p w
{-# LINE 22 "src/unix/System/Terminal.hsc" #-}

foreign import ccall "sys/ioctl.h ioctl"
  ioctl :: CInt -> CInt -> Ptr WindowWidth -> IO CInt

-- | Get the width, in columns, of the terminal if we can.
getTerminalWidth :: IO (Maybe Int)
getTerminalWidth =
  alloca $ \p -> do
    errno <- ioctl (1) (21523) p
{-# LINE 31 "src/unix/System/Terminal.hsc" #-}
    if errno < 0
      then return Nothing
      else do
        WindowWidth w <- peek p
        return . Just . fromIntegral $ w