built framework for abacus widget

abacus.cabal

@@ -22,6 +22,8 @@ library
       Abacus
       Abacus.App
       Abacus.App.Types
+      Abacus.App.Widgets
+      Abacus.App.Widgets.Internal
       Abacus.Internal
   other-modules:
       Paths_abacus

src/Abacus/App.hs

@@ -32,13 +32,14 @@ import Brick
   , EventM
   , Widget
   , attrMap
-  , emptyWidget
   , halt
   , neverShowCursor
   , style
   )
+import Brick.Widgets.Center (center)
 
 import Abacus.App.Types
+import Abacus.App.Widgets
 
 -- | Main application
 mainApp :: App AppState () ()
@@ -51,7 +52,7 @@ mainApp = App
   }
 
 drawFunc :: AppState -> [Widget ()]
-drawFunc = const [emptyWidget]
+drawFunc s = [center $ abacusW s]
 
 eventHandler :: BrickEvent () () -> EventM () AppState ()
 eventHandler = const halt

src/Abacus/App/Widgets.hs

@@ -0,0 +1,75 @@
+{-|
+
+Module      : Abacus.App.Widgets
+Description : Widget constructors
+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/>.
+
+-}
+
+module Abacus.App.Widgets (abacusW) where
+
+import Brick
+  ( Widget
+  , freezeBorders
+  , hBox
+  , hLimit
+  , str
+  , vBox
+  , withBorderStyle
+  )
+import Brick.Widgets.Border (hBorder)
+import Brick.Widgets.Border.Style (unicode, unicodeBold)
+import Lens.Micro.Platform ((^.))
+
+import Abacus
+import Abacus.App.Types
+import Abacus.App.Widgets.Internal
+
+-- | Constructs a widget representing an abacus
+abacusW :: AppState -> Widget ()
+abacusW s = hBox
+  [ abacusLeftW s
+  , withBorderStyle unicodeBold $
+    freezeBorders $
+    withBorderStyle unicode $
+    beadsW $ s^.abacus
+  , abacusRightW s
+  ]
+
+abacusLeftW :: AppState -> Widget ()
+abacusLeftW = vBox . map str . abacusLeft
+
+beadsW :: Abacus -> Widget ()
+beadsW a = vBox $ map
+  (rungW $ getNumBeads a)
+  (beads a)
+
+abacusRightW :: AppState -> Widget ()
+abacusRightW = vBox . map str . abacusRight
+
+rungW :: Int -> (String, String) -> Widget ()
+rungW n (l, r) = hBox
+  [ str l
+  , hLimit n hBorder
+  , str r
+  ]
+
+--jl

src/Abacus/App/Widgets/Internal.hs

@@ -0,0 +1,51 @@
+{-|
+
+Module      : Abacus.App.Widgets.Internal
+Description : Internal module intended for testing only
+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 should only be imported directly by the Abacus module and
+the testing suite.  Anything contained herein should be considered
+subject to change without notice.
+
+-}
+
+module Abacus.App.Widgets.Internal (
+  abacusLeft,
+  beads,
+  abacusRight,
+  ) where
+
+import Abacus
+import Abacus.App.Types
+
+abacusLeft :: AppState -> [String]
+abacusLeft = undefined
+
+beads :: Abacus -> [(String, String)]
+beads = undefined
+
+abacusRight :: AppState -> [String]
+abacusRight = undefined
+
+--jl