ui: register screen: use full terminal width

This uses a clunky hack for now. To adapt to a window resize,
you must exit and re-enter the register screen (maybe twice).

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -103,9 +103,10 @@ handleAccountsScreen st@AppState{aScreen=scr@AccountsScreen{asState=is}} e = do
         Vty.EvKey Vty.KEsc []        -> halt st
         Vty.EvKey (Vty.KChar 'q') [] -> halt st
         Vty.EvKey (Vty.KLeft) []     -> continue $ popScreen st
-        Vty.EvKey (Vty.KRight) []    -> continue st'
+        Vty.EvKey (Vty.KRight) []    -> do
+          (w,h) <- getViewportSize "accounts"
+          continue $ screenEnter d args RS2.screen{rs2Size=(w,h)} st
           where
-            st' = screenEnter d args RS2.screen st
             args = case listSelectedElement is of
                     Just (_, ((acct, _, _), _)) -> ["acct:"++accountNameToAccountRegex acct]
                     Nothing -> []

hledger-ui/Hledger/UI/RegisterScreen2.hs

@@ -26,19 +26,23 @@ import Hledger.UI.UIUtils
 
 screen = RegisterScreen2{
    rs2State  = list "register" V.empty 1
+  ,rs2Size   = (0,0)
   ,sInitFn    = initRegisterScreen2
   ,sDrawFn    = drawRegisterScreen2
   ,sHandleFn = handleRegisterScreen2
   }
 
 initRegisterScreen2 :: Day -> [String] -> AppState -> AppState
-initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{}} =
+initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{rs2Size=size}} =
   st{aScreen=s{rs2State=is'}}
   where
     is' =
       -- listMoveTo (length items) $
-      list (Name "register") (V.fromList items) 1
+      list (Name "register") (V.fromList items') 1
 
+    -- XXX temporary hack: include saved viewport size in list elements
+    -- for element draw function
+    items' = zip (repeat size) items
     (_label,items) = accountTransactionsReport ropts j thisacctq q
       where
         -- XXX temp
@@ -77,8 +81,8 @@ drawRegisterScreen2 AppState{aopts=_opts, aScreen=RegisterScreen2{rs2State=is}}
                           ]
 drawRegisterScreen2 _ = error "draw function called with wrong screen type, should not happen"
 
-drawRegisterItem :: Bool -> AccountTransactionsReportItem -> Widget
+drawRegisterItem :: Bool -> ((Int,Int), AccountTransactionsReportItem) -> Widget
-drawRegisterItem sel item =
+drawRegisterItem sel ((w,_h),item) =
 
   -- (w,_) <- getViewportSize "register" -- getCurrentViewportSize
   -- st@AppState{aopts=opts} <- getAppState
@@ -99,7 +103,7 @@ drawRegisterItem sel item =
             acctnames = nub $ sort $ splitOn ", " acctsstr -- XXX
         in
          intercalate ", " $ map strip $ lines $ 
-         postingsReportItemAsText defcliopts{width_=Just "160"} $ -- XXX
+         postingsReportItemAsText defcliopts{width_=Just (show w)} $
          mkpostingsReportItem True True PrimaryDate Nothing p totalamt
       -- fmt = BottomAligned [
       --     FormatField False (Just 20) Nothing TotalField

hledger-ui/Hledger/UI/UITypes.hs

@@ -36,12 +36,13 @@ data Screen =
     ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
     ,sDrawFn :: AppState -> [Widget]
     }
-  deriving (Show)
   | RegisterScreen2 {
-     rs2State :: List AccountTransactionsReportItem
+     rs2Size :: (Int,Int) -- ^ XXX prev screen's viewport size on entering this screen
+    ,rs2State :: List ((Int,Int), AccountTransactionsReportItem)
     ,sInitFn :: Day -> [String] -> AppState -> AppState
     ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
     ,sDrawFn :: AppState -> [Widget]
     }
+  deriving (Show)
 
 instance Show (List a) where show _ = "<List>"

hledger-ui/Hledger/UI/UIUtils.hs

@@ -7,10 +7,12 @@ module Hledger.UI.UIUtils (
  ,attrMap
  ,customAttrMap
  ,customAttr
+ ,getViewportSize
  ) where
 
--- import Control.Lens ((^.))
+import Control.Lens ((^.))
 -- import Control.Monad
+import Control.Monad.IO.Class
 -- import Data.Default
 import Data.Monoid              -- 
 import Data.Time.Calendar (Day)
@@ -49,4 +51,15 @@ customAttrMap = attrMap V.defAttr
     ]
 
 customAttr :: AttrName
+
+-- | In the EventM monad, get the named current viewport's width and height,
+-- or (0,0) if the named viewport is not found.
+getViewportSize :: Name -> EventM (Int,Int)
+getViewportSize name = do
+  mvp <- lookupViewport name
+  let (w,h) = case mvp of
+        Just vp -> vp ^. vpSize
+        Nothing -> (0,0)
+  return (w,h)
+
 customAttr = listSelectedAttr <> "custom"