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

-----------------------------------------------------------------------------
-- |
-- Module      :  System.Terminal.Utils
-- Copyright   :  Alec Theriault 2019
-- License     :  BSD3
--
-- Maintainer  :  alec.theriault@gmail.com
-- Portability :  portable
--
-- Terminal-related utilities
module System.Terminal.Utils (
  getTerminalSize,
) where

import Foreign
import Foreign.C.Types
import Foreign.Marshal.Alloc ( alloca )




-- | Try to get the number of rows and columns respectively in the terminal
getTerminalSize :: IO (Maybe (Int,Int))
getTerminalSize = alloca $ \ws -> do
  res <- ioctl (1) (21523) ws
{-# LINE 28 "src-unix/System/Terminal/Utils.hsc" #-}
  if res == -1
    then pure Nothing
    else do
      WinSize row col <- peek ws
      pure (Just (fromIntegral row, fromIntegral col))

-- | @ioctl@ fills the struct at the pointer you passed in with the size info
foreign import ccall "sys/ioctl.h ioctl"
  ioctl :: CInt -> CInt -> Ptr WinSize -> IO CInt

-- | Match @struct winsize@ in @sys/ioctl.h@.
data WinSize = WinSize CUShort CUShort

instance Storable WinSize where
  sizeOf _ = ((8))
{-# LINE 43 "src-unix/System/Terminal/Utils.hsc" #-}
  alignment _ = (2)
{-# LINE 44 "src-unix/System/Terminal/Utils.hsc" #-}
  peek ptr = do
    row <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 46 "src-unix/System/Terminal/Utils.hsc" #-}
    col <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) ptr
{-# LINE 47 "src-unix/System/Terminal/Utils.hsc" #-}
    pure (WinSize row col)
  poke ptr (WinSize row col) = do
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr row
{-# LINE 50 "src-unix/System/Terminal/Utils.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) ptr col
{-# LINE 51 "src-unix/System/Terminal/Utils.hsc" #-}