From 0c74a4ba61eeefedb9757435f9b7eff92db3a38d Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Thu, 1 Aug 2024 16:04:37 -0400 Subject: [PATCH] add cursor location widget --- hamming.cabal | 2 + src/Hamming/App/Util.hs | 43 +++++++++++++++++++ src/Hamming/App/Widgets.hs | 14 ++++--- src/Hamming/App/Widgets/Internal.hs | 7 +++- test/Hamming/App/UtilSpec.hs | 53 ++++++++++++++++++++++++ test/Hamming/App/Widgets/InternalSpec.hs | 6 +-- test/Hamming/AppSpec.hs | 2 + 7 files changed, 117 insertions(+), 10 deletions(-) create mode 100644 src/Hamming/App/Util.hs create mode 100644 test/Hamming/App/UtilSpec.hs diff --git a/hamming.cabal b/hamming.cabal index c3bfecc..a29def2 100644 --- a/hamming.cabal +++ b/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 diff --git a/src/Hamming/App/Util.hs b/src/Hamming/App/Util.hs new file mode 100644 index 0000000..66f94fc --- /dev/null +++ b/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 +. + +**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 diff --git a/src/Hamming/App/Widgets.hs b/src/Hamming/App/Widgets.hs index 8666291..a50cd5b 100644 --- a/src/Hamming/App/Widgets.hs +++ b/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 - . vBox - . map (hBox . map (\(a, w) -> withAttr a $ str [w])) - . hammingW' +hammingW s = let + (wData, mLoc) = hammingW' s + widget = vBox $ map + (hBox . map (\(a, w) -> withAttr a $ str [w])) + wData + in case mLoc of + Just loc -> showCursor () loc widget + Nothing -> widget --jl diff --git a/src/Hamming/App/Widgets/Internal.hs b/src/Hamming/App/Widgets/Internal.hs index 98e3753..42516d1 100644 --- a/src/Hamming/App/Widgets/Internal.hs +++ b/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" diff --git a/test/Hamming/App/UtilSpec.hs b/test/Hamming/App/UtilSpec.hs new file mode 100644 index 0000000..b6d17c4 --- /dev/null +++ b/test/Hamming/App/UtilSpec.hs @@ -0,0 +1,53 @@ +{- + +hamming +Copyright (C) Jonathan Lamothe + +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 +. + +-} + +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 diff --git a/test/Hamming/App/Widgets/InternalSpec.hs b/test/Hamming/App/Widgets/InternalSpec.hs index 815c0d8..bd7c0d6 100644 --- a/test/Hamming/App/Widgets/InternalSpec.hs +++ b/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 - numActRows = length actRes - numExpRows = length expRes + (actRes, _) = hammingW' state + numActRows = length actRes + numExpRows = length expRes context "number of rows" $ it ("should be " ++ show numExpRows) $ numActRows `shouldBe` numExpRows diff --git a/test/Hamming/AppSpec.hs b/test/Hamming/AppSpec.hs index 07543a6..f9b56d0 100644 --- a/test/Hamming/AppSpec.hs +++ b/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