{-# LINE 1 "src/System/Console/Terminal/Size.hsc" #-}
{- |
{-# LINE 2 "src/System/Console/Terminal/Size.hsc" #-}
Get terminal window height and width without ncurses dependency

Only tested to work on GNU/Linux systems

Based on answer by Andreas Hammar at <http://stackoverflow.com/a/12807521/972985>
-}
module System.Console.Terminal.Size
  ( Window(..), size
  ) where

import Control.Exception (catch)
import Foreign
import Foreign.C.Error
import Foreign.C.Types

{-# LINE 19 "src/System/Console/Terminal/Size.hsc" #-}


{-# LINE 21 "src/System/Console/Terminal/Size.hsc" #-}

{-# LINE 22 "src/System/Console/Terminal/Size.hsc" #-}



{-# LINE 25 "src/System/Console/Terminal/Size.hsc" #-}


-- Interesting part of @struct winsize@
data CWin = CWin CUShort CUShort

instance Storable CWin where
  sizeOf _ = ((8))
{-# LINE 32 "src/System/Console/Terminal/Size.hsc" #-}
  alignment _ = (2)
{-# LINE 33 "src/System/Console/Terminal/Size.hsc" #-}
  peek ptr = do
    row <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 35 "src/System/Console/Terminal/Size.hsc" #-}
    col <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) ptr
{-# LINE 36 "src/System/Console/Terminal/Size.hsc" #-}
    return $ CWin row col
  poke ptr (CWin row col) = do
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr row
{-# LINE 39 "src/System/Console/Terminal/Size.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) ptr col
{-# LINE 40 "src/System/Console/Terminal/Size.hsc" #-}


-- | Terminal window width and height
data Window a = Window
  { height :: !a
  , width  :: !a
  } deriving (Show, Read)

instance Functor Window where
  fmap f (Window { height = h, width = w }) = Window { height = f h, width = f w }


-- | Get terminal window width and height
--
-- >>> import System.Console.Terminal.Size
-- >>> size
-- Just (Window {height = 60, width = 112})
size :: Integral n => IO (Maybe (Window n))
size = with (CWin 0 0) $ \ws -> do
  throwErrnoIfMinus1 "ioctl" $
    ioctl (1) (21523) ws
{-# LINE 61 "src/System/Console/Terminal/Size.hsc" #-}
  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 ccall "sys/ioctl.h ioctl"
  ioctl :: CInt -> CInt -> Ptr CWin -> IO CInt