add cursor location widget

hamming.cabal

@@ -26,6 +26,7 @@ library
       Hamming.App.Draw
       Hamming.App.Events
       Hamming.App.Types
+      Hamming.App.Util
       Hamming.App.Widgets
       Hamming.App.Widgets.Internal
   other-modules:
@@ -67,6 +68,7 @@ test-suite hamming-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Hamming.App.UtilSpec
       Hamming.App.Widgets.InternalSpec
       Hamming.App.WidgetsSpec
       Hamming.AppSpec

src/Hamming/App/Util.hs

@@ -0,0 +1,43 @@
+{-|
+
+Module      : Hamming.App.Util
+Description : Utilities for working with Hamming codes
+Copyright   : (C) Jonathan Lamothe
+License     : AGPL-3.0-or-later
+Maintainer  : jonathan@jlamothe.net
+Stability   : experimental
+Portability : POSIX
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as
+published by the Free Software Foundation, either version 3 of the
+License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public
+License along with this program.  If not, see
+<https://www.gnu.org/licenses/>.
+
+**IMPORTANT NOTE:** This module is for internal use *only* and should be
+considered subject to change at any time.
+
+|-}
+
+module Hamming.App.Util (getLocation) where
+
+import Brick.Types (Location (..))
+import Lens.Micro ((^.))
+
+import Hamming.App.Types
+
+-- | Gets the location of the edit cursor (if available)
+getLocation :: AppState -> Maybe Location
+getLocation s = case s^.appMode of
+  EditMode es -> Just $ Location (es^.colNum + 1, es^.rowNum + 1)
+  _           -> Nothing
+
+--jl

src/Hamming/App/Widgets.hs

@@ -36,7 +36,7 @@ module Hamming.App.Widgets (
   ) where
 
 import Brick.Types (Widget)
-import Brick.Widgets.Core (hBox, str, vBox, withAttr)
+import Brick.Widgets.Core (hBox, showCursor, str, vBox, withAttr)
 
 import Hamming.App.Types
 import Hamming.App.Widgets.Internal
@@ -45,9 +45,13 @@ import Hamming.App.Widgets.Internal
 hammingW
   :: AppState
   -> Widget ResName
-hammingW = withAttr hammingAttr
+hammingW s = let
-  . vBox
+  (wData, mLoc) = hammingW' s
-  . map (hBox . map (\(a, w) -> withAttr a $ str [w]))
+  widget = vBox $ map
-  . hammingW'
+    (hBox . map (\(a, w) -> withAttr a $ str [w]))
+    wData
+  in case mLoc of
+    Just loc -> showCursor () loc widget
+    Nothing  -> widget
 
 --jl

src/Hamming/App/Widgets/Internal.hs

@@ -44,17 +44,20 @@ import Data.Bits ((.&.))
 import Lens.Micro (_2, (^.), (%~))
 
 import Brick.AttrMap (AttrName, attrName)
+import Brick.Types (Location)
 
 import Hamming.App.Types
+import Hamming.App.Util
 
-hammingW' :: AppState -> [[(AttrName, Char)]]
+hammingW' :: AppState -> ([[(AttrName, Char)]], Maybe Location)
 hammingW' state = let
   header = (hammingAttr, ' ') : map (marginAttr,) ['0'..'3']
   body   = hammingBody state
-  in header : zipWith
+  widget = header : zipWith
     (\n row -> (marginAttr, n) : row)
     ['0'..'3']
     body
+  in (widget, getLocation state)
 
 hammingAttr :: AttrName
 hammingAttr = attrName "hamming"

test/Hamming/App/UtilSpec.hs

@@ -0,0 +1,53 @@
+{-
+
+hamming
+Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as
+published by the Free Software Foundation, either version 3 of the
+License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public
+License along with this program.  If not, see
+<https://www.gnu.org/licenses/>.
+
+-}
+
+module Hamming.App.UtilSpec (spec) where
+
+import Brick.Types (Location (..))
+import Lens.Micro ((&), (.~))
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Hamming.App.Types
+import Hamming.App.Util
+
+spec :: Spec
+spec = describe "Util"
+  getLocationSpec
+
+getLocationSpec :: Spec
+getLocationSpec = describe "getLocation" $ mapM_
+  ( \(desc, state, expected) -> context desc $ let
+    actual = getLocation state
+    in it ("should be " ++ show expected) $
+      actual `shouldBe` expected
+  )
+  [ ( "display mode", initialState, Nothing )
+  , ( "edit mode",    es,           Just l  )
+  ]
+  where
+    es = initialState & appMode .~ EditMode
+      ( initialEditor
+      & rowNum .~ 2
+      & colNum .~ 3
+      )
+    l = Location (4, 3)
+
+--jl

test/Hamming/App/Widgets/InternalSpec.hs

@@ -37,9 +37,9 @@ hammingW'Spec :: Spec
 hammingW'Spec = describe "hammingW'" $ mapM_
   ( \(desc, state, expRes) -> context desc $ do
     let
-      actRes = hammingW' state
+      (actRes, _) = hammingW' state
-      numActRows = length actRes
+      numActRows  = length actRes
-      numExpRows = length expRes
+      numExpRows  = length expRes
     context "number of rows" $
       it ("should be " ++ show numExpRows) $
         numActRows `shouldBe` numExpRows

test/Hamming/AppSpec.hs

@@ -23,10 +23,12 @@ module Hamming.AppSpec (spec) where
 
 import Test.Hspec (Spec, describe)
 
+import qualified Hamming.App.UtilSpec as Util
 import qualified Hamming.App.WidgetsSpec as Widgets
 
 spec :: Spec
 spec = describe "App" $ do
+  Util.spec
   Widgets.spec
 
 --jl