urbit-king: Library for getting current terminal size (SIGWINCH).

pkg/hs/stack.yaml

@@ -7,6 +7,7 @@ packages:
   - urbit-atom
   - urbit-azimuth
   - urbit-king
+  - urbit-termsize
 
 extra-deps:
   - flat-0.3.4@sha256:002a0e0ae656ea8cc02a772d0bcb6ea7dbd7f2e79070959cc748ad1e7138eb38

pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs

@@ -505,7 +505,7 @@ term (tsize, Client{..}) shutdownSTM king enqueueEv =
   where
     T.TSize wi hi = tsize
 
-    initialEvents = [(initialBlew wi hi), initialHail]
+    initialEvents = [initialBlew wi hi, initialHail]
 
     runTerm :: RAcquire e (EffCb e TermEf)
     runTerm = do

pkg/hs/urbit-termsize/.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+urbit-termsize.cabal
+*~

pkg/hs/urbit-termsize/LICENSE

@@ -0,0 +1,21 @@
+The MIT License (MIT)
+
+Copyright (c) 2016 urbit
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

pkg/hs/urbit-termsize/app/Main.hs

@@ -0,0 +1,13 @@
+module Main where
+
+import Prelude
+
+import Urbit.TermSize (liveTermSize)
+import System.IO (getLine)
+
+main :: IO ()
+main = do
+  init <- liveTermSize (putStrLn . ("New Size: " <>) . show)
+  putStrLn ("Initial Size: " <> show init)
+  _ <- getLine
+  pure ()

pkg/hs/urbit-termsize/lib/Urbit/TermSize.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE DeriveAnyClass  #-}
+{-# LANGUAGE LambdaCase      #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Urbit.TermSize
+  ( TermSize(..)
+  , termSize
+  , liveTermSize
+  )
+where
+
+import Prelude
+
+import Data.Functor                 ((<&>))
+import System.Console.Terminal.Size (Window(..), size)
+
+import qualified System.Posix.Signals      as Sys
+import qualified System.Posix.Signals.Exts as Sys
+
+
+-- Types -----------------------------------------------------------------------
+
+data TermSize = TermSize
+  { tsWide :: !Word
+  , tsTall :: !Word
+  }
+ deriving (Eq, Ord, Show)
+
+
+-- Utilities -------------------------------------------------------------------
+
+termSize :: IO TermSize
+termSize = size <&> \case
+  Nothing            -> TermSize 80 24
+  Just (Window {..}) -> TermSize width height
+
+liveTermSize :: (TermSize -> IO ()) -> IO TermSize
+liveTermSize cb = do
+  Sys.installHandler Sys.sigWINCH (Sys.Catch (termSize >>= cb)) Nothing
+  termSize

pkg/hs/urbit-termsize/package.yaml

@@ -0,0 +1,26 @@
+name: urbit-termsize
+version: 0.1.0
+license: MIT
+license-file: LICENSE
+
+dependencies:
+  - base
+  - terminal-size
+  - unix
+
+ghc-options:
+  - -fwarn-incomplete-patterns
+  - -fwarn-unused-binds
+  - -fwarn-unused-imports
+  - -O2
+
+library:
+  source-dirs: lib
+
+executables:
+  live-termsize:
+    main: Main.hs
+    source-dirs: app
+    dependencies:
+      - urbit-termsize
+    ghc-options: "-threaded -rtsopts -with-rtsopts=-N"