--------------------------------------------------------------------------------
module Patat.Size
    ( Size (..)
    , getTerminalSize
    ) where


--------------------------------------------------------------------------------
import           Data.Maybe                   (fromMaybe)
import qualified System.Console.Terminal.Size as Terminal


--------------------------------------------------------------------------------
data Size = Size {Size -> Int
sRows :: Int, Size -> Int
sCols :: Int} deriving (Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Size -> ShowS
showsPrec :: Int -> Size -> ShowS
$cshow :: Size -> String
show :: Size -> String
$cshowList :: [Size] -> ShowS
showList :: [Size] -> ShowS
Show)


--------------------------------------------------------------------------------
getTerminalSize :: IO Size
getTerminalSize :: IO Size
getTerminalSize = do
    Maybe (Window Int)
mbWindow <- IO (Maybe (Window Int))
forall n. Integral n => IO (Maybe (Window n))
Terminal.size
    let rows :: Int
rows = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
24 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Window Int -> Int
forall a. Window a -> a
Terminal.height (Window Int -> Int) -> Maybe (Window Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Window Int)
mbWindow
        cols :: Int
cols = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
72 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Window Int -> Int
forall a. Window a -> a
Terminal.width  (Window Int -> Int) -> Maybe (Window Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Window Int)
mbWindow
    Size -> IO Size
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Size -> IO Size) -> Size -> IO Size
forall a b. (a -> b) -> a -> b
$ Size {sRows :: Int
sRows = Int
rows, sCols :: Int
sCols = Int
cols}