king: Factored all terminal rendering logic into its own module.

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

@@ -28,15 +28,15 @@ import Urbit.Vere.Http.Server (serv)
 import Urbit.Vere.Log         (EventLog)
 import Urbit.Vere.Serf        (Serf, SerfState(..), doJob, sStderr)
 
-import qualified System.Console.Terminal.Size as TSize
-import qualified System.Entropy               as Ent
-import qualified Urbit.King.API               as King
-import qualified Urbit.Time                   as Time
-import qualified Urbit.Vere.Log               as Log
-import qualified Urbit.Vere.Serf              as Serf
-import qualified Urbit.Vere.Term              as Term
-import qualified Urbit.Vere.Term.API          as Term
-import qualified Urbit.Vere.Term.Demux        as Term
+import qualified System.Entropy         as Ent
+import qualified Urbit.King.API         as King
+import qualified Urbit.Time             as Time
+import qualified Urbit.Vere.Log         as Log
+import qualified Urbit.Vere.Serf        as Serf
+import qualified Urbit.Vere.Term        as Term
+import qualified Urbit.Vere.Term.API    as Term
+import qualified Urbit.Vere.Term.Demux  as Term
+import qualified Urbit.Vere.Term.Render as Term
 
 
 --------------------------------------------------------------------------------
@@ -225,7 +225,7 @@ pier (serf, log, ss) mStart = do
             drivers inst ship (isFake logId)
                 (writeTQueue computeQ)
                 shutdownEvent
-                (TSize.Window 80 24, muxed)
+                (Term.TSize{tsWide=80, tsTall=24}, muxed)
                 showErr
 
     io $ atomically $ for_ bootEvents (writeTQueue computeQ)
@@ -286,7 +286,7 @@ data Drivers e = Drivers
 drivers :: (HasLogFunc e, HasNetworkConfig e, HasPierConfig e)
         => KingId -> Ship -> Bool -> (Ev -> STM ())
         -> STM()
-        -> (TSize.Window Word, Term.Client)
+        -> (Term.TSize, Term.Client)
         -> (Text -> RIO e ())
         -> ([Ev], RAcquire e (Drivers e))
 drivers inst who isFake plan shutdownSTM termSys stderr =

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

@@ -29,12 +29,11 @@ import Urbit.King.API      (readPortsFile)
 import Urbit.King.App      (HasConfigDir(..))
 import Urbit.Vere.Term.API (Client(Client))
 
-import qualified Data.ByteString.Internal     as BS
-import qualified Data.ByteString.UTF8         as BS
-import qualified System.Console.Terminal.Size as TSize
-import qualified System.Console.Terminfo.Base as T
-import qualified Urbit.Vere.NounServ          as Serv
-import qualified Urbit.Vere.Term.API          as Term
+import qualified Data.ByteString.Internal as BS
+import qualified Data.ByteString.UTF8     as BS
+import qualified Urbit.Vere.NounServ      as Serv
+import qualified Urbit.Vere.Term.API      as Term
+import qualified Urbit.Vere.Term.Render   as T
 
 
 -- Types -----------------------------------------------------------------------
@@ -169,10 +168,10 @@ runTerminalClient pier = runRAcquire $ do
 -}
 localClient :: ∀e. HasLogFunc e
             => STM ()
-            -> RAcquire e (TSize.Window Word, Client)
+            -> RAcquire e (T.TSize, Client)
 localClient doneSignal = fst <$> mkRAcquire start stop
   where
-    start :: HasLogFunc e => RIO e ((TSize.Window Word, Client), Private)
+    start :: HasLogFunc e => RIO e ((T.TSize, Client), Private)
     start = do
       pTerminal     <- io $ T.setupTermFromEnv
       tsWriteQueue  <- newTQueueIO
@@ -199,12 +198,12 @@ localClient doneSignal = fst <$> mkRAcquire start stop
                           , give = writeTQueue tsWriteQueue
                           }
 
-      tsize <- io $ TSize.size <&> fromMaybe (TSize.Window 80 24)
+      tsize <- io $ T.tsize
 
       pure ((tsize, client), Private{..})
 
     stop :: HasLogFunc e
-         => ((TSize.Window Word, Client), Private) -> RIO e ()
+         => ((T.TSize, Client), Private) -> RIO e ()
     stop ((_, Client{..}), Private{..}) = do
       -- Note that we don't `cancel pReaderThread` here. This is a deliberate
       -- decision because fdRead calls into a native function which the runtime
@@ -521,7 +520,7 @@ localClient doneSignal = fst <$> mkRAcquire start stop
     Terminal Driver
 -}
 term :: forall e. (HasPierConfig e, HasLogFunc e)
-     => (TSize.Window Word, Client)
+     => (T.TSize, Client)
      -> (STM ())
      -> KingId
      -> QueueEv
@@ -529,7 +528,7 @@ term :: forall e. (HasPierConfig e, HasLogFunc e)
 term (tsize, Client{..}) shutdownSTM king enqueueEv =
     (initialEvents, runTerm)
   where
-    TSize.Window wi hi = tsize
+    T.TSize wi hi = tsize
 
     initialEvents = [(initialBlew wi hi), initialHail]
 

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

@@ -0,0 +1,61 @@
+{-|
+    Terminal Driver
+-}
+module Urbit.Vere.Term.Render
+    ( TSize(..)
+    , tsize
+    , Terminal
+    , Capability
+    , TermOutput
+    , termText
+    , runTermOutput
+    , setupTermFromEnv
+    , getCapability
+    , tiGetOutput1
+    ) where
+
+import ClassyPrelude
+
+import qualified System.Console.Terminal.Size as TSize
+import qualified System.Console.Terminfo.Base as TInfo
+
+
+--------------------------------------------------------------------------------
+
+type Terminal = TInfo.Terminal
+
+type Capability f = TInfo.Capability f
+
+type TermOutput = TInfo.TermOutput
+
+data TSize = TSize
+    { tsWide ∷ Word
+    , tsTall ∷ Word
+    }
+
+
+--------------------------------------------------------------------------------
+
+{- |
+    Get terminal size.  Produces 80x24 as a fallback if unable to figure
+    out terminal size.
+-}
+tsize ∷ IO TSize
+tsize = do
+    TSize.Window wi hi <- TSize.size <&> fromMaybe (TSize.Window 80 24)
+    pure $ TSize { tsWide = wi, tsTall = hi }
+
+termText ∷ String -> TermOutput
+termText = TInfo.termText
+
+runTermOutput ∷ Terminal -> TermOutput -> IO ()
+runTermOutput = TInfo.runTermOutput
+
+setupTermFromEnv ∷ IO Terminal
+setupTermFromEnv = TInfo.setupTermFromEnv
+
+getCapability ∷ Terminal -> Capability a -> Maybe a
+getCapability = TInfo.getCapability
+
+tiGetOutput1 ∷ TInfo.OutputCap f => String -> Capability f
+tiGetOutput1 = TInfo.tiGetOutput1