diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,28 @@ +# Revision history for brick-panes + +## 1.0.0.0 -- 2022-10-01 + +* Public release. + +## 0.3.0.0 -- 2022-09-29 + +* Updated `handleFocusAndPanelEvents` to return a `PanelTransition` indication + along with the new `Panel`. This can be used by applications perform + additional actions if the event just handled caused a transition into or out-of + a modal Pane. +* The `exitedModal` and `enteredModal` functions can be used to determine the + type of transition (if any). +* The `isPanelModal` function can be used to determine the current modal state of + the Panel. + +## 0.2.0.0 -- 2022-09-22 + +* Removed argument from `WhenFocusedModal` and + `WhenFocusedModalHandlingAllEvents` `PaneFocus` constructors. These arguments + should always have been specified as `Nothing` by client code, with deleterious + behavior if this requirement was not followed, so the need for this awkward + constant representation was removed. + +## 0.1.0.0 -- 2022-09-10 + +* Initial version. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ +Copyright (c) 2022 Kevin Quick + +Permission to use, copy, modify, and/or distribute this software for any purpose +with or without fee is hereby granted, provided that the above copyright notice +and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH +REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, +INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER +TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF +THIS SOFTWARE. diff --git a/README.org b/README.org new file mode 100644 --- /dev/null +++ b/README.org @@ -0,0 +1,1324 @@ +* Overview + +The Brick Panes library is an overlay for the Brick TUI (Text User Interface) +library that allows individual TUI screen areas to be independently developed and +then easily composed into the overall application. This library can be used to +develop an application in a modular fashion where the screen is divided into a +number of "panes" that individually handle their display and (optionally) their +events with pane-specific internal state. These discrete panes provide a general +interface that can then easily be composed to provide the wholistic application +functionality. + +* Context + +Brick is oriented around the display of and interaction with ~Widgets~. This a +nice overall design and lends itself well to discrete management of different +types of TUI functionality. The panes library builds on top of Brick Widgets to +address the following higher-level compositional issues encountered when building +a TUI application: + +1. Different Widgets have different interfaces. A Widget must be called via a + widget-specific API. Fundamentally however, there are a number of common + higher-level operations that an application performs for which the details are + a lower-level concern. + +2. Various application functionality can be isolated into different aspects, but + frequently the individual aspects are made up of multiple, cooperating widgets + that share some state. Managing this state and coordinating the activities of + an inter-Widget aspect can be done via application-specific wrapper Widgets, + but often it's desirable to view ~Widgets~ as the /basic/ building blocks + (er.. "bricks") of the application and to then have a higher level of + abstraction for handling the different aspect "areas" of the application. + +This library provides the ~Pane~ as self-contained collector for Widgets that +manage a particular aspect of the application within the global context of the +entire application. It also provides a ~Panel~, which is a composition of +multiple ~Pane~ objects that maintains a simple general API while internally +managing the ~Pane~ objects which compose the ~Panel~. + +The Haddock documentation describes the API, and the remainder of this README is +an evolutionary introduction to developing an application with Panes. + +* Example Program + +To introduce the Panes library in a manner that reveals the motivation and +interaction in a layered approach, the documentation here will demonstrate +building a sample application step-by-step. + +The sample application that will be developed here is called "mywork-example" and +is designed to help the software developer keep track of their work. This is a +simple little application that reads an input JSON file that provides information +about different projects the developer is working on and then allows the +developer to browse and manage the information about those projects. + +#+begin_quote +Note: there is a more complete implementation of this example at +https://github.com/kquick/mywork, which has many more features, but which is no +longer suitable for simple demonstration purposes. The ~mywork-example~ is +incomplete and not fully functional, and users who would like to see or use the +more featureful implementation should use the one at the above link. +#+end_quote + +The underlying data for the mywork-example application consists of a list of Projects, +where each Project has a top-level description. For each project, there are a +number of Locations, which represents various locations the project can be found +at; the Locations can include local directories, code repositories (e.g. github), +and publication sites (e.g. Hackage). Each Location can have a date associated +with it (statically or dynamically) as well as user-specified Notes. In +addition, the files in a project can be viewed in a simple scrollable region. + +Let's start by defining the underlying data structures that will be used to +represent those projects in memory, and which can be serialized to a JSON storage +file: + +#+begin_src haskell +import Data.Text ( Text ) +import Data.Time.Calendar + + +newtype Projects = Projects { projects :: [Project] } + deriving Generic + +data Project = Project { name :: Text + , role :: Role + , description :: Text + , language :: Either Text Language + , locations :: [Location] + } + deriving Generic + +data Role = Author | Maintainer | Contributor | User + deriving (Show, Enum, Bounded, Eq, Generic) + +data Language = Haskell | Rust | C | CPlusPlus | Python | JavaScript + deriving (Eq, Generic) + +data Location = Location { location :: Text + , locatedOn :: Maybe Day + , notes :: [Note] + } + deriving Generic + +data Note = Note { note :: Text + , notedOn :: Day + } + deriving Generic +#+end_src + +Each of these definitions will have an ~aeson~ ~ToJSON~ derivation so that our +projects can be read from and written to a local JSON-format file. + + #+begin_quote + Note that the ~ToJSON~ instances along with other administrative definitions + are not shown here: this is a simple README and not intended to be a literate + Haskell program, and the actual implementation of this mywork-example example + can be found in the ~samples/mywork~ directory of this repository). + #+end_quote + +Since this is a TUI application, we will now design the overall appearance of the +application: + +#+begin_example + +---------------------------- mywork-example v0.1 --------------------------+ + | Projects: 30 (Author=8, Contributor=19, User=2), 2017-08-28 to 2022-09-10 | + |---------------------------------------------------------------------------| + | Project | Location (for currently selected project in list) Date | + | List | Location Date | + | | : : | + | | | + | | | + | | | + | |--------------------------------------------------------------| + | | Date - Note for currently selected location | + | | : : | + | | | + | | [this is only visible if a Location is selected] | + | search: XX | | + |---------------------------------------------------------------------------| + | F1 - Load/Save F2 - Add Project F3 - Add Location F4 - Add Note | + +---------------------------------------------------------------------------+ +#+end_example + + +There will be a summary line across the top and a list of projects on the left +side. Location information for the currently selected project in the list will +be shown on the right side, and notes for a location will be shown if the +location is highlighted. The bottom will show function keys that can be used to +perform activities. Each of these areas will be a Pane. + +Activities: + + * It should be possible to move the cursor between the Project List Pane and the + Location Pane via the Tab/Shift-Tab key; none of the other areas are + focusable. + + * Typing when the Project List Pane is focused will modify the "search" + selection and the visible entries in the list. + + * The function keys are global (they do not depend on which Pane is focused), + although they may be disabled (and visually marked differently) if not + applicable in the current mode. + + * The Load/Save operation will bring up a modal dialog window, as will the Add + Project operation. Being modal, both of these hold focus until dismissed. + + * And finally, Ctrl-Q will quit the application in any state, and ESC will exit + from any current dialog, or if there is no dialog, ESC will exit the + application. + +Given the above core data structures, visual depiction, and general +functionality, we can start to use the brick-panes library to build up this +application in stages. + +** Startup and Configuration + +Our application will need to perform some general initialization at startup time +to declare the Brick environment. This includes initializing global state. +Since the Panes will each internalize their own state management, the global +state only needs to maintain elements that are globally necessary. For our +application, this will be the name of the project JSON file, the current Project +data, and the Brick focus ring. This could be passed on the command line or read +from various configuration sources, but for this simple introduction, it will +just start out with a hard-coded name (although this might change later due to +the Load operation). + + #+begin_src haskell + data MyWorkCore = MyWorkCore { projFile :: FilePath + , myProjects :: Projects + , myWorkFocus :: FocusRing WName + } + + initMyWorkCore = MyWorkCore { projFile = "projects.json" + , myProjects = Projects mempty + , myWorkFocus = focusRing [ WProjList, WLocation ] + } + #+end_src + + +The ~name~ parameter for the Brick ~Widget~ instances will be handled by a simple +declaration: + + #+begin_src haskell + data WName = WSummary | WProjList | WLocation | WNotes | WOps | WLoader + #+end_src + +For this simple application, there is no application-specific event type. This +could be specified as ~()~ directly, but we will use a convenient type synonym to +differentiate supplying this type for Brick Event types v.s. other types: + + #+begin_src haskell + type MyWorkEvent = () -- No app-specific event for this simple app + #+end_src + +Each Pane will be identified by its own identifying datatype which will provide +an instance of the ~Pane~ class. The ~Pane~ class is defined in brick-panes: + + #+begin_src haskell + class Pane n appEv pane | pane -> n where + ... + #+end_src + +where the ~n~ parameter is the same type that the application will provide to +Brick's ~Widget~ types. + +Note each Pane will need a distinguishing ~Type~. If there is already a ~Type~ +that is a reasonable representation of the data in the Pane, that type can be +used, otherwise a plain data type can be created, as is the instance here for the +summary and operations panes. We'll start by creating a couple of the primary +panes, and then come back later to add the additional panes. + + #+begin_src haskell + {-# LANGUAGE MultiParamTypeClasses #-} + + data SummaryPane + data OperationsPane + + instance Pane WName MyWorkEvent SummaryPane where ... + instance Pane WName MyWorkEvent Projects where ... + instance Pane WName MyWorkEvent OperationsPane where ... + #+end_src + +The other types for the instance and the actual instance details will be defined +later. It's also worth noting that it can be convenient to define each Pane in +its own module file; when done in this manner, the Pane's data type is the only +thing that needs to be exported from the module (if defined in that module). + +This core state will be wrapped by the brick-pane ~Panel~ object, which collects +the various ~Pane~ instances, and the result is provided to Brick to initialize +the application. Here's a summary of the brick-panes definitions for a ~Panel~. + + #+begin_src haskell + data Panel n appEv state (panes :: [Type]) where ... + + basePanel :: state -> Panel n appev state '[] + basePanel = ... + + addToPanel :: Pane n appev pane u + ... + => PaneFocus n + -> Panel n appev state panes + -> Panel n appev state (pane ': panes) + addToPanel n pnl = ... + + data PaneFocus n = Always | Never | WhenFocused | WhenFocusedModal + #+end_src + +To initialize our Brick application with the core state and the Panes defined +above: + + #+begin_src haskell + {-# LANGUAGE DataKinds #-} + + type MyWorkState = Panel Wname MyWorkEvent MyWorkCore + '[ SummaryPane + , Projects + , OperationsPane + ] + + initialState :: MyWorkState + initialState = addToPanel Never + $ addToPanel WhenFocused + $ addToPanel Never + $ basePanel initMyWorkCore + + myworkApp :: App MyWorkState MyWorkEvent WName + myworkApp = App { appDraw = drawMyWork + , appChooseCursor = showFirstCursor + , appHandleEvent = handleMyWorkEvent + , appStartEvent = return () + , appAttrMap = const myattrs + } + + myattrs = attrMap defAttr + [ + (editAttr, white `on` black) + , (editFocusedAttr, yellow `on` black) + , (listAttr, defAttr `withStyle` defaultStyleMask) + , (listSelectedAttr, defAttr `withStyle` bold) + , (listSelectedFocusedAttr, defAttr `withStyle` reverseVideo) + ] + + main = defaultMain myworkApp initialState + #+end_src + +In this initialization, we've defined the full type for the application, which +consists of the base (global) type of ~MyWorkCore~, followed by a type-level list +of the panes in the application. The initialization function does not need to +explicitly reference the type of each Pane, but it should add them in the reverse +order they are specified in the type list (the ~$~ composition is right-to-left, +so the order of the two lists is the same). When adding each Pane, the parameter +specifies what the focus policy for delivering events to that Pane should be. In +our application, the ~SummaryPane~ will never receive events, the Projects list +pane will receive events when focused, and the ~OperationsPane~ events will be +handled globally rather than by the ~Pane~ since they should apply in any state, +regardless of the focus. + +All that's left is to define the ~drawMyWork~ and ~handleMyWorkEvent~ functions, +as well as filling in the ~instance~ declarations introduced above. + +** Drawing + +When drawing the application, the normal Brick drawing activities are performed, +but drawing Panes in the Panel can be done very generically: + + #+begin_src haskell + drawMyWork :: MyWorkState -> [Widget WName] + drawMyWork mws = + [ + joinBorders + $ withBorderStyle unicode + $ borderWithLabel (str $ " mywork-example " <> showVersion version <> " ") + $ vBox $ catMaybes + [ + panelDraw @SummaryPane mws + , Just hBorder + , panelDraw @Projects mws + , Just hBorder + , panelDraw @OperationsPane mws + ] + ] + #+end_src + +This is a very simple function that defers the drawing of each Pane to that Pane +via the ~panelDraw~ function. The ~panelDraw~ return values are a ~Maybe~ value +where ~Nothing~ indicates that the Pane should not currently be drawn; this will +be used later when we add the modal FileLoader and AddProject panes. + +** Event Handling + +The event handler is also fairly normal to Brick, except that here again, the +Panel provides a common function to call that will dispatch the event to the +various Panes depending on the current focus target and the individual Pane's +event receptivity that was specified as the argument to the ~addToPanel~ +initialization call. + + #+begin_src haskell + handleMyWorkEvent :: BrickEvent WName MyWorkEvent -> EventM WName MyWorkState () + handleMyWorkEvent = \case + AppEvent _ -> return () -- this app does not use these + -- Application global actions + -- * CTRL-q quits + -- * CTRL-l refreshes vty + -- * ESC dismisses any modal window + VtyEvent (Vty.EvKey (Vty.KChar 'q') [Vty.MCtrl]) -> halt + VtyEvent (Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl]) -> do + vty <- getVtyHandle + liftIO $ Vty.refresh vty + -- Otherwise, allow the Panes in the Panel to handle the event + ev -> do state0 <- get + (_,state) <- handleFocusAndPanelEvents myWorkFocusL state0 ev + put state + #+end_src + +The Panel will need to be able to access the focus ring in the base global state +to determine the current focus. It will need a Lens to do this, so we will +create a simple lens definition here to accomodate that; the lens accessor for +the field itself can be created through a number of different processes aside +from the manual method used below, and brick-panes supplies the ~onBaseState~ +lens to translate from the outer state (defined below) to the base global state. + + #+begin_src haskell + coreWorkFocusL :: Lens' MyWorkCore (FocusRing WName) + coreWorkFocusL f c = (\f' -> c { myWorkFocus = f' }) <$> f (myWorkFocus c) + + myWorkFocusL :: Lens' MyWorkState (FocusRing WName) + myWorkFocusL = onBaseState . coreWorkFocusL + #+end_src + +It is useful to observe that the ~handleMyWorkEvent~ handler did not need to +define handlers for ~Tab~/~Shift-Tab~ to switch between panes: the Pane's +~handleFocusAndPanelEvents~ handles these events automatically. + + +** Initial Panes + +At this point, all the general application code is ready to go. More will be +added later, but now it's time to turn our attention to the individual Panes. + +*** Summary Pane + +Previously we introduced the need for an ~instance Pane~ for each Pane, including +this ~SummaryPane~, but no instance details were provided. Here, the brick-panes +~Pane~ class will be developed in more detail in parallel with the +~SummaryPane~'s instance. + +**** Initialization + +To begin with, it will be necessary to allow the Pane to have internal state, and +to initialize that internal state. The ~Pane~ class supports this via a data +family declaration and an ~initPaneState~ method as defined in brick-panes: + + #+begin_src haskell + class Pane n appEv pane | pane -> n where + data (PaneState pane appEv) -- State information associated with this Pane + type (InitConstraints pane initctxt) :: Constraint + initPaneState (InitConstraints pane i) => i -> PaneState pane appEv + + type (InitConstraints pane initctxt) = () + #+end_src + +An `InitConstraints~ constraint is attached to the ~initPaneState~ method, and +that constraint is defined as part of the Pane instance. This allows the ~Pane~ +instance to specify any constraints that are needed to accomodate actions that +will be performed in the ~initPaneState~ method. By default, there are no +~InitConstraints~. + +At this point, you might recall that the initialization of the Panel was +performed by calls to ~addPanel~, which only passed information about whether +events should be delivered to the state, but there was nothing providing the ~i~ +argument that is defined here for the ~initPaneState~ method. That's because the +~Pane~ class is defined in a very general fashion, but when the ~Pane~ is used as +part of a ~Panel~, the ~i~ parameter defaults to the sub-type of the Panel that +has already been initialized. This means that for the ~SummaryPane~ +initialization call, the ~i~ parameter will be: + + #+begin_src haskell + Panel Wname MyWorkEvent MyWorkCore '[ Projects, OperationsPane ] + #+end_src + +Recall that this is the same as MyWorkState except it is missing the SummaryPanel +entry in the type list. When initializing the ~Projects~ pane, then the type +will contain only the ~OperationsPane~, and the ~OperationsPane~ initialization +will have access only to the base ~MyWorkCore~ type information. This heirarchy +of availability may affect the order in which the Panes should be specified in +the top-level type if some Panes will need access to information from other +Panes. This will be explored in more detail below, but at the present moment, +the ~SummaryPane~ will have no internal state, so it will not need any +~InitConstraints~ defined: + + #+begin_src haskell + {-# LANGUAGE TypeFamilies #-} + {-# LANGUAGE TypeSynonymInstances #-} + + instance Pane WName MyWorkEvent SummaryPane where + data (PaneState SummaryPane MyWorkEvent) = Unused + initPaneState _ = Unused + #+end_src + +**** Drawing + +To draw the pane, the ~Pane~ class provides another method, along with a +corresponding constraint that can be used to encode any necessities for the draw +implementation (which again default to ~()~ representing no constraints). + + #+begin_src haskell + class Pane n appEv pane | pane -> n where + data (PaneState pane appEv) -- State information associated with this Pane + type (InitConstraints pane initctxt) :: Constraint + type (DrawConstraints pane drwctxt n) :: Constraint + initPaneState (InitConstraints pane i) => i -> PaneState pane appEv + drawPane :: (DrawConstraints pane drawcontext n, Eq n) + => PaneState pane appEv -> drawcontext -> Maybe (Widget n) + + type (InitConstraints pane initctxt) = () + type (DrawConstraints pane drwctxt n) = () + #+end_src + +The ~drawPane~ method takes two arguments and returns a ~Maybe~. As discussed +earlier in the general application drawing section, a ~Pane~ can return ~Nothing~ +to indicate it shouldn't be drawn at the present time. The ~SummaryPane~ is +always drawn, so it will always return a ~Just~ value. + +The first argument provided to the ~drawPane~ method is the data family value +defined for this pane and initialized by the ~initPaneState~. + +The second parameter is an abstract context for drawing. As with the +~initPaneState~ method, the ~Pane~ class defines this in a very generic manner, +but when the ~Pane~ is used in a ~Panel~, the ~Panel~ provides the sub-state of +the ~Panel~ that *includes* the current ~Pane~, but not the elements preceeding +it in the type list. Here, the ~SummaryPane~ is the first element in the +~MyWorkState~, so its ~drawPane~ will receive the full ~MyDrawState~ value, but +the panes beneath it will receive subsequently lesser sub-type portions. + +For the ~SummaryPane~, the ~drawPane~ instance will need to display the number of +~Projects~ sub-divided by the ~Project~ ~Role~, as well as the full date range +for all ~Projects~. To obtain this information, it will need access to the +~Projects~ data that is contained in the global base state ~MyWorkCore~. To +obtain this information, it needs to translate the ~drawcontext~ argument to the +~Projects~ list contained in the base global state; it can indicate this need via +the ~DrawContext~ as follows: + + #+begin_src haskell + instance Pane WName MyWorkEvent SummaryPane where + data (PaneState SummaryPane MyWorkEvent) = Unused + type (DrawConstraints SummaryPane s WName) = ( HasProjects s ) + initPaneState _ = Unused + drawPane _ s = Just $ drawSummary (getProjects s) + + drawSummary :: Projects -> Widget WName + drawSummary prjs = ... + #+end_src + +The ~HasProjects~ constraint is a class that our application will defined as +capable of providing the ~getProjects~ method. The instance of that class for +the global base ~MyWorkCore~ object is simple, and the instance of that class +for a ~Panel~ wrapper of that global base state can use the ~onBaseState~ lens +previously discussed: + + #+begin_src haskell + class HasProjects s where + getProjects :: s -> Projects + + instance HasProjects MyWorkCore where + getProjects = myProjects + + instance HasProjects (Panel WName MyWorkEvent MyWorkCore panes) where + getProjects = getProjects . view onBaseState + #+end_src + +Now all that's needed is the body of the ~drawSummary~ function itself: + + #+begin_src haskell + drawSummary :: Projects -> Widget WName + drawSummary prjcts = + let prjs = projects prjcts + prjcnt = str $ "# Projects=" <> show (length prjs) <> subcounts + subcounts = (" (" <>) + $ (<> ")") + $ List.intercalate ", " + [ show r <> "=" <> show (length fp) + | r <- [minBound .. maxBound] + , let fp = filter (isRole r) prjs + , not (null fp) + ] + isRole r p = r == role p + dateRange = str (show (minimum projDates) + <> ".." + <> show (maximum projDates) + ) + locDates prj = catMaybes (locatedOn <$> locations prj) + projDates = concatMap locDates prjs + in vLimit 1 + $ if null prjs + then str "No projects defined" + else prjcnt <+> fill ' ' <+> dateRange + #+end_src + +Note that all of the complexity of this drawing functionality, as well as +determining the arguments to it are internal to the Pane implementation (usually +in its own file) and supporting classes and instances; the top-level draw +operation retains its simplicity. + +**** Summary Pane Notes + +Since the Summary pane does not have internal state to be updated and it does not +handle events, the above is sufficient to fully define the ~SummaryPane~! + + +*** Project List Pane + +Now that the ~SummaryPane~ has been implemented, we turn our attention to the +Project List Pane. This pane will also need access to the list of Projects, but +it can re-use the previously defined ~HasProjects~ class in its constraints where +necessary. + +**** Initialization + +This Pane is slightly more complex: it will contain a ~Brick.Widgets.List~ and +also a ~Brick.Widgets.Edit~ to handle the search filter. There are two choices +here: create the ~Brick.Widgets.List~ widget as part of the long-term ~Pane~ +state, or dynamically create the ~Brick.Widgets.List~ widget each time it is +drawn. The former choice is better, since the ~Brick.Widgets.List~ will then +automatically maintain its own internal state such as the currently selected +item, etc. Thus, the ~Pane~ state will need to contain these two Brick widgets +and the initialization method should prepare them. + + #+begin_src haskell + instance Pane WName MyWorkEvent Projects where + data (PaneState Projects MyWorkEvent) = P { pL :: List WName Text + , pS :: Editor Text WName + } + type (InitConstraints Projects s) = ( HasProjects s ) + initPaneState s = let prjs = projects $ getProjects s + pl = list WPList (Vector.fromList (name <$> prjs)) 1 + ps = editor WPFilter (Just 1) "" + in P pl ps + #+end_src + +Note that both the List and the Editor widgets require a unique ~WName~ value. +These values should also be added to the global ~WName~ definition previously +introduced above. + +This is also a good demonstration of the encapsulation that the brick-panes +library provides: the primary application simply needs the ability to display and +allow selection of a project. The actual details of how the display is performed +and how the selection is performed is not visible or important outside of the +implementation of the ~Pane~. + +**** Drawing + +Drawing this pane is relatively simple and primarily just invokes the draw for +the two Widgets it contains. + + #+begin_src haskell + instance Pane WName MyWorkEvent Projects where + data (PaneState Projects MyWorkEvent) = P { pL :: List WName Text + , pS :: Editor Text WName + } + type (InitConstraints Projects s) = ( HasProjects s ) + type (DrawConstraints Projects s WName) = ( HasFocus s WName ) + initPaneState s = let prjs = projects $ getProjects s + pl = list WPList (Vector.fromList (name <$> prjs)) 1 + ps = editor WPFilter (Just 1) "" + in P pl ps + drawPane ps gs = + let isFcsd = gs^.getFocus.to focused == Just WProjList + lst = renderList (const txt) isFcsd (pL ps) + srch = str "Search: " <+> renderEditor (txt . head) isFcsd (pS ps) + in Just $ vBox [ lst, fill ' ', srch ] + #+end_src + +Unlike the ~SummaryPane~, this pane's draw code does not necessarily access to +the global base state, but it does need access to the FocusRing in order to tell +the List renderer if the list has focus. This can be done by defining another +class ~HasFocus~ that will be similar to the ~HasProjects~ class described above; +since this is a very common need, the brick-panes library already provides this +class (with a ~getFocus~ lens method) and a Panel instance for it, so all that is +needed here is the instance definition to extract the FocusRing from the global +base state. + + #+begin_src haskell + instance HasFocus MyWorkCore WName where + getFocus f s = + let setFocus jn = case focused jn of + Nothing -> s + Just n -> s & coreWorkFocusL %~ focusSetCurrent n + in setFocus <$> (f $ Focused $ focusGetCurrent (s^.coreWorkFocusL)) + #+end_src + +One thing to note about the draw implementation above is that the focused +indication passed to both the list and edit widgets is *not* based on their +individual ~WName~ values but instead on the ~WName~ of the ~Projects Pane~ +itself. This is because the pane will receive focus and will direct events to +both widgets (which conveniently do not overlap in their event handling). There +is no specific additional differentiation or selectability between the list and +edit widgets. + +**** Event Handling + +As with the initialization and the drawing Pane operations, there is an operation +and corresponding constraint defined by brick-panes for allowing the ~Pane~ to +handle events: + + #+begin_src haskell + class Pane n appEv pane | pane -> n where + data (PaneState pane appEv) -- State information associated with this pane + type (InitConstraints pane initctxt) :: Constraint + type (DrawConstraints pane drwctxt n) :: Constraint + type (EventConstraints pane evctxt) :: Constraint + type (EventType pane n appEv) + initPaneState :: (InitConstraints pane i) => i -> PaneState pane appEv + drawPane :: (DrawConstraints pane drawcontext n, Eq n) + => PaneState pane appEv -> drawcontext -> Maybe (Widget n) + focusable :: (EventConstraints pane eventcontext, Eq n) + => eventcontext -> PaneState pane appEv -> Seq.Seq n + handlePaneEvent :: (EventConstraints pane eventcontext, Eq n) + => eventcontext + -> EventType pane n appEv + -> PaneState pane appEv + -> EventM n es (PaneState pane appEv) + updatePane :: UpdateType pane -> PaneState pane appEv -> PaneState pane appEv + + -- A set of defaults that allows a minimal instance specification + type (InitConstraints pane initctxt) = () + type (DrawConstraints pane drwctxt n) = () + type (EventConstraints pane evctxt) = () + type (EventType pane n appev) = Vty.Event -- by default, handle Vty events + focusable _ _ = mempty + handlePaneEvent _ _ = return + type (UpdateType pane) = () + updatePane _ = id + #+end_src + +The additional element involved in handling events is the ~EventType~ type family +declaration above, which can be used to specify which type of Event the Pane will +respond to. Brick Events are arranged in a heirarchy of relationships, where the +higher level event can handle Mouse events and application-level as well as +Keyboard events, and the ~EventType~ can be set to indicate which type of event +this ~Pane~ should be provided with (where the default is Keyboard events). The +~Panel~'s ~handleFocusAndPanelEvents~ will automatically pass the correct +~EventType~ to the ~Pane~ ~handlePaneEvent~ method. + +There is also a new ~focusable~ method in the ~Pane~ class, which is used to +determine if any Widgets that are part of the Pane can be members of the +FocusRing at the current time. This is used by the ~Panel~ after processing each +event to determine the new ~FocusRing~ contents. This is frequently used in +concert with returning ~Nothing~ from the ~drawPane~ method, but it is +independent and allows for potentially multiple Widgets to be focusable. Since +the Projects Pane is always focusable, it will return its own ~WName~ value as +the single response. + +Similar to drawing then, event handling for the ~Projects~ ~Pane~ consists of +simply passing the event to the underlying widgets. As noted above, passing the +same event to multiple widgets could cause confusion, but in this case the only +common events are the arrow events, and since the edit widget height is 1 it +should ignore the vertical arrows that will be used to navigate the list entries. +The ~handleEditorEvent~ called internally expects a ~BrickEvent~, so the +~EventType~ must be specified accordingly. And finally, a couple of helper +lenses are defined: + + #+begin_src haskell + instance Pane WName MyWorkEvent Projects where + data (PaneState Projects MyWorkEvent) = P { pL :: List WName Text + , pS :: Editor Text WName + } + type (InitConstraints Projects s) = ( HasProjects s ) + type (DrawConstraints Projects s WName) = ( HasFocus s WName ) + type (EventType Projects WName MyWorkEvent) = BrickEvent WName MyWorkEvent + initPaneState s = let prjs = projects $ getProjects s + pl = list WPList (Vector.fromList (name <$> prjs)) 1 + ps = editor WPFilter (Just 1) "" + in P pl ps + drawPane ps gs = + let isFcsd = gs^.getFocus.to focused == Just WProjList + lst = renderList (const txt) isFcsd (pL ps) + srch = str "Search: " <+> renderEditor (txt . head) isFcsd (pS ps) + in Just $ vBox [ lst, fill ' ', srch ] + handlePaneEvent _ ev ps = + do ps1 <- case ev of + VtyEvent ev' -> do + r <- nestEventM' (pL ps) (handleListEvent ev') + return $ ps & pList .~ r + _ -> return ps + srch <- nestEventM' (ps ^. pSrch) (handleEditorEvent ev) + return $ ps1 & pSrch .~ srch + focusable _ _ = Seq.singleton WProjList + + + pList :: Lens' (PaneState Projects MyWorkEvent) (List WName Text) + pList f ps = (\n -> ps { pL = n }) <$> f (pL ps) + + pSrch :: Lens' (PaneState Projects MyWorkEvent) (Editor Text WName) + pSrch f ps = (\n -> ps { pS = n }) <$> f (pS ps) + #+end_src + + +**** Project List Pane Notes + +At this point, the Project List pane is now fully defined. In addition, the +~Pane~ class is /almost/ fully described: there will only be one more member that +will be introduced later in this development description. + + +*** Operations Pane + +The Operations Pane specifies the operations that can be performed and the key +sequences that initiate them. This Pane does not itself take focus: the key +bindings are application global. It may be however that certain key bindings are +inactive in the current mode. + +**** Initialization + +This Pane stores no internal data, so no internal storage or initialization is +needed. + + #+begin_src haskell + instance Pane WName MyWorkEvent OperationsPane where + data (PaneState OperationsPane MyWorkEvent) = Unused + initPaneState _ = Unused + #+end_src + +**** Drawing + +This Pane is drawn with the ability to adjust the presented operations to +indicate if they are active or not. It must therefore have a class constraint +that can indicate the active state for those bindings: + + #+begin_src haskell + class HasSelection s where + selectedProject :: s -> Maybe Project + #+end_src + +The main instance for this will be for the Project List pane's state: + + #+begin_src haskell + {-# LANGUAGE FlexibleInstances #-} + + instance HasSelection (PaneState Projects MyWorkEvent) where + selectedProject = fmap snd . listSelectedElement . pL + #+end_src + +That pane state is not generally available outside the implementation for that +pane however, so how will this information be available to the Operations Pane? +The brick-panes library provides an `onPane` lens that can access a particular +Pane's state from anywhere "above" that Pane in the Panel type list, provided +that the `PanelOps` constraint can be satisfied. This can be used to define a +`HasSelection` instance that will work for the Panel. + + #+begin_src haskell + instance ( PanelOps Projects WName MyWorkEvent panes MyWorkCore + , HasSelection (PaneState Projects MyWorkEvent) + ) + => HasSelection (Panel WName MyWorkEvent MyWorkCore panes) where + selectedProject = selectedProject . view (onPane @Projects) + #+end_src + +However, the first attempt to build with this will receive the following error: + + #+begin_example + samples/mywork/Main.hs:67:18: error: + • No Projects in Panel + Add this pane to your Panel (or move it lower) + (Possibly driven by DrawConstraints) + ... + #+end_example + +This indicates that the Projects Pane is /above/ the Operations Pane, so the +latter cannot satisfy the `HasSelection` instance. To fix this, simply re-order +the type list for the main state and the initialization operation: + + #+begin_src haskell + type MyWorkState = Panel WName MyWorkEvent MyWorkCore + '[ SummaryPane + , OperationsPane + , Projects + ] + + initialState :: MyWorkState + initialState = addToPanel Never + $ addToPanel Never + $ addToPanel WhenFocused + $ basePanel initMyWorkCore + #+end_src + +By "stacking" Panes in the right order in the Panel, most cross-pane dependencies +can be satisfied. If there are cases where a total ordering is not possible, +then state maintained by a Pane may need to be moved into the global base state +to break the dependency cycle. + +Now that the `HasSelection` is defined to determine if a Project is currently +selected, the draw functionality for the Operations pane can be made sensitive to +that setting. + + #+begin_src haskell + instance Pane WName MyWorkEvent OperationsPane where + data (PaneState OperationsPane MyWorkEvent) = Unused + type (DrawConstraints OperationsPane s WName) = ( HasSelection s ) + initPaneState _ = Unused + drawPane _ gs = + let projInd = case selectedProject gs of + Nothing -> withAttr (attrName "disabled") + Just _ -> id + ops = List.intersperse (fill ' ') + [ str "F1-Load/Save" + , str "F2-Add Project" + , projInd $ str "F3-Add Location" + , projInd $ str "F4-Add Note" + ] + in Just $ vLimit 1 $ str " " <+> hBox ops <+> str " " + #+end_src + +And the final change is to add the following to the ~myattrs~ map: + + #+begin_src haskell + ... + , (attrName "disabled", defAttr `withStyle` dim) + ... + #+end_src + +**** Event Handling + +The ~OperationsPane~ does not directly handle events: all key bindings it +describes are handled by global event handling, which will be added later. The +`OperationsPane` is now fully defined and no more is needed at the moment. + +*** Adding the Location Pane + +The next step in the design of the application is to add the ~Location~ Pane, +which wasn't previously defined. We'll need to add the Pane to the global Panel +type and initialization: + + #+begin_src haskell + type MyWorkState = Panel WName MyWorkEvent MyWorkCore + '[ SummaryPane + , OperationsPane + , Location + , Projects + ] + + initialState :: MyWorkState + initialState = focusRingUpdate myWorkFocusL + $ addToPanel Never + $ addToPanel Never + $ addToPanel WhenFocused + $ addToPanel WhenFocused + $ basePanel initMyWorkCore + + #+end_src + +The ~Location~ Pane was added "above" the ~Projects~ pane, because it will need +to show the Location for the currently selected Pane, which it will need to +retrieve via the ~HasSelection~ constraint in the same manner as the +~OperationsPane~. + +In addition, there is a new ~focusRingUpdate~ function called to modify the +initial state. This function is provided by brick-panes and its responsibility +is updating the ~FocusRing~ based on the current set of focusable Panes. Here, +this adds the ~Location~ and ~Projects~ panes to the focusable list. The +~focusRingUpdate~ function should also be called whenever something happens that +would modify the focus ring (e.g. a modal...). + +Rather than showing how each aspect of the ~Location~ Pane is defined, the whole +thing is presented here at once: + + #+begin_src haskell + instance Pane WName MyWorkEvent Location where + data (PaneState Location MyWorkEvent) = L { lL :: List WName (Text, Maybe Day) } + type (InitConstraints Location s) = ( HasSelection s, HasProjects s ) + type (DrawConstraints Location s WName) = ( HasFocus s WName, HasSelection s ) + initPaneState gs = + let l = L (list WLList mempty 2) + update x = do p <- selectedProject gs + prj <- DL.find ((== p) . name) (projects $ getProjects gs) + return $ updatePane prj x + in fromMaybe l $ update l + drawPane ps gs = + let isFcsd = gs^.getFocus.to focused == Just WLocation + rndr (l,d) = (txt l + <+> hFill ' ' + <+> (str $ maybe "*" show d) + ) + <=> str " " + in Just $ renderList (const rndr) isFcsd (lL ps) + focusable _ ps = focus1If WLocation $ not $ null $ listElements $ lL ps + handlePaneEvent _ ev ps = do r <- nestEventM' (lL ps) (handleListEvent ev) + return $ ps & lList .~ r + type (UpdateType Location) = Project + updatePane prj ps = + let ents = [ (location l, locatedOn l) | l <- locations prj ] + in L $ listReplace (V.fromList ents) (Just 0) (lL ps) + + lList :: Lens' (PaneState Location MyWorkEvent) (List WName (Text, Maybe Day)) + lList f ps = (\n -> ps { lL = n }) <$> f (lL ps) + #+end_src + +In the above, the final method for the ~Pane~ is introduced: the ~updatePane~ +method, along with the ~UpdateType~ specification (which previously defaulted to +~()~). The ~UpdateType~ specifies the type of the value passed to the +~updatePane~ method's first argument. This method is called externally with the +specified argument whenever the Pane's internal state should be updated. Here, +it is intended to be called with the ~Project~ for which the ~Location~ pane +should show the locations, and it will update the internal ~Brick.Widges.List~ +with those locations. This is also called directly from the ~initPaneState~ when +there is a selection at initialization time. + +Also of interest is the new ~focus1If~ function called by the ~focusable~ method. +This brick-panes function is a convenience helper that returns the first argument +in a single-entry Sequence if the second argument is true. The automatic call of +~focusRingUpdate~ performed internally by the ~Panel~ at the end of handling each +event will use the return values of the ~focusable~ methods to update the +~FocusRing~ appropriately. The ~focus1If~ helper is being used to indicate that +the ~Location~ Pane should not receive focus unless there are actual locations +being displayed. + + +Note that a ~WLList~ value was added to the ~WName~ type as well, and the main +~drawMyWork~ is updated to draw the Location pane: + + #+begin_src haskell + drawMyWork mws = + [ + joinBorders + $ withBorderStyle unicode + $ borderWithLabel (str $ " mywork-example " <> showVersion version <> " ") + $ vBox $ catMaybes + [ + panelDraw @SummaryPane mws + , Just hBorder + , Just $ hBox $ catMaybes + [ hLimitPercent 20 <$> panelDraw @Projects mws + , Just vBorder + , panelDraw @Location mws + ] + , Just hBorder + , panelDraw @OperationsPane mws + ] + ] + #+end_src + +The ~Location~ Pane's ~updatePane~ should be called whenever the ~Projects~ Pane +selection is changed, to update the Locations displayed. This is handled by +extending the application's primary event handler to detect these changes and +explicitly call the ~updatePane~ as seen in the modified excerpt here: + + #+begin_src haskell + ... + -- Otherwise, allow the Panes in the Panel to handle the event + ev -> do state0 <- get + let proj0 = selectedProject state0 + (_,state) <- handleFocusAndPanelEvents myWorkFocusL state0 ev + let mprj = do pnm <- selectedProject state + guard (Just pnm /= proj0) + Data.List.find ((== pnm) . name) + (projects $ getProjects state) + let state' = + case mprj of + Just p -> state & onPane @Location %~ updatePane p + _ -> state + put state' + #+end_src + + +**** Location Pane Notes + +At this point, the development of the application is progressing nicely. Each +additional Pane is defined with its own isolated specification, information +exchanged with other Panes is explicit and controlled by the Constraints, and +global application changes needed are just to ensure that the Pane is added to +the initialization operations and type, ensure it is part of the drawing code, +and add any /special/ event handling needed for that Pane. + +Most of the rest of the development of the mywork-example application will follow +this pattern, but it's worth looking at one additional aspect: modal panes. + + +*** File Load/Save Pane + +The File Load/Save (a.k.a. ~FileMgr~) Pane is somewhat different from the +previous panes in that it is a modal pane: it is invisible until activated, and +while activated it holds the focus until de-activated. + +The design and appearance of the ~FileMgr~ Pane will be a centered modal window, +displaying a Brick ~FileBrowser~ Widget at the top, help information below that, +and a ~Save~ button at the bottom. + +The ~Save~ button will be selectable via the +~Tab~/~Shift-Tab~ events, and hitting ~Space~ or ~Return~ while the button is +selected will perform the save action on the to the currently selected file in +the file browser. + +When the ~FileBrowser~ Widget is selected, normal browsing can be performed, and +~Return~ will load the currently selected file and dismiss the ~FileMgr~ modal +pane, whereas ~ESC~ at any point will dismiss the ~FileMgr~ modal pane without +making any changes. + +# Support for a modal Pane such as this mainly requires a flag in the global base state indicating whether the pane is active or not. + +**** Pane Implementation + +The FileMgr Pane itself is implemented in the manner we have come to expect, +although there are a couple of adjustments: + + #+begin_src haskell + data FileMgrPane + + instance Pane WName MyWorkEvent FileMgrPane where + data (PaneState FileMgrPane MyWorkEvent) = + FB { fB :: Maybe (FileBrowser WName) + -- ^ A Nothing value indicates the modal is not currently active + , myProjects :: Projects + -- ^ Current loaded set of projects + , newProjects :: Bool + -- ^ True when myProjects has been updated; clear this via updatePane + } + type (InitConstraints FileMgrPane s) = () + type (DrawConstraints FileMgrPane s WName) = ( HasFocus s WName ) + type (EventConstraints FileMgrPane e) = ( HasFocus e WName ) + initPaneState gs = FB Nothing (Projects mempty) False + drawPane ps gs = drawFB gs <$> fB ps + focusable _ ps = case fB ps of + Nothing -> mempty + Just _ -> Seq.fromList [ WFBrowser, WFSaveBtn ] + handlePaneEvent bs ev ts = + let isSearching = maybe False fileBrowserIsSearching (ts^.fBrowser) + in case ev of + Vty.EvKey Vty.KEsc [] | not isSearching -> return $ ts & fBrowser .~ Nothing + _ -> case bs^.getFocus of + Focused (Just WFBrowser) -> handleFileLoadEvent ev ts + Focused (Just WFSaveBtn) -> handleFileSaveEvent ev ts + _ -> return ts + type (UpdateType FileMgrPane) = Bool + updatePane newFlag ps = ps { newProjects = newFlag } + + fBrowser :: Lens' (PaneState FileMgrPane MyWorkEvent) (Maybe (FileBrowser WName)) + fBrowser f ps = (\n -> ps { fB = n }) <$> f (fB ps) + + myProjectsL :: Lens' (PaneState FileMgrPane MyWorkEvent) Projects + myProjectsL f wc = (\n -> wc { myProjects = n }) <$> f (myProjects wc) + #+end_src + + The first observation is that the actual ~Projects~ list is moved here from the + global base state. This is to allow the ~FileMgr~ to easily access and replace + the ~Projects~ data when a file is loaded or saved. + + There is also a flag that indicates when the ~Projects~ has been changed. This + will be needed to inform the ~Projects~ Pane that it needs to update its list + values. The flag is set internally when a new set of Projects is loaded, and + the ~updatePane~ can be called to clear the flag once the ~Projects~ Pane has + been updated. + + The ~focusable~ is also modified to return a list of the two sub-widgets. This + is to support the automatic selection of active widget via the + ~Tab~/~Shift-Tab~ event handling provided by the ~Panel~ implementation. (The + ~WName~ datatype is extended in the obvious manner with these new + constructors.) + + To support the export of the new ~newProjects~ flag, the ~HasProjects~ class is + slighly updated, and provide an instance for this Pane and any super-Pane + types, but not for the base global state. + + #+begin_src haskell + class HasProjects s where + getProjects :: s -> (Bool, Projects) + + instance ( PanelOps FileMgrPane WName MyWorkEvent panes MyWorkCore + , HasProjects (PaneState FileMgrPane MyWorkEvent) + ) + => HasProjects (Panel WName MyWorkEvent MyWorkCore panes) where + getProjects = getProjects . view (onPane @FileMgrPane) + + instance HasProjects (PaneState FileMgrPane MyWorkEvent) where + getProjects ps = (newProjects ps, myProjects ps) + #+end_src + + Various miscellaneous and obvious adjustments will need to be made to + accomodate the change in return value; these are not shown here. + + The application type and initialization are updated to include the new Pane, + with the indication that the pane should receive ~Events~ only when + modally-active: + + #+begin_src haskell + type MyWorkState = Panel WName MyWorkEvent MyWorkCore + '[ SummaryPane + , OperationsPane + , Location + , Projects + , FileMgrPane + ] + + initialState :: MyWorkState + initialState = focusRingUpdate myWorkFocusL + $ addToPanel Never + $ addToPanel Never + $ addToPanel WhenFocused + $ addToPanel WhenFocused + $ addToPanel WhenFocusedModal + $ basePanel initMyWorkCore + #+end_src + + The drawing and handling functions are also not shown here; their + implementation is relatively straightforward and doesn't reveal any new + brick-pane concepts. When a file is actually loaded, the handler will update + the ~myProjects~ field with the loaded data and set the ~newProjects~ to + ~True~. + + Of note is the initialization: the Brick ~FileBrowser~ initialization must be + performed in the ~IO~ monad. Conveniently, this ~Pane~ is modal and not + displayed by default, so there is an ~Event~ which causes it to be displayed + and which can provide the monadic context for the initialization in the global + event handler: + + #+begin_src haskell + ... + VtyEvent (Vty.EvKey (Vty.KFun 1) []) -> do + fmgr <- liftIO initFileMgr + modify ((focusRingUpdate myWorkFocusL) . (onPane @FileMgrPane .~ fmgr)) + -- Otherwise, allow the Panes in the Panel to handle the event + ev -> do state0 <- get + ... + #+end_src + + Note here the call to ~focusRingUpdate~: the ~Panel~ event handler + automatically calls this, but that handler is not used in this situation, so + the ~FocusRing~ should be explicitly updated with this function. If this + update is omitted, the modal will not visibly show the focused state until the + /next/ event (that calls the ~Panel~'s event handler) is processed. + + In the ~FileMgr~ Pane implementation, the ~initFileMgr~ function is defined: + + #+begin_src haskell + initFileMgr :: IO (PaneState FileMgrPane MyWorkEvent) + initFileMgr = do + fb <- newFileBrowser selectNonDirectories WFBrowser Nothing + return $ initPaneState fb & fBrowser .~ Just fb + #+end_src + + Also in the global event handler, the new projects flag is checked, and if it + is ~True~, it is reset to ~False~ and the ~Projects~ Pane is notified of the + new ~Projects~ data: + + #+begin_src haskell + ev -> do proj0 <- gets selectedProject + s <- get + (_,s') <- handleFocusAndPanelEvents myWorkFocusL s ev + put s' + (new,prjs) <- gets getProjects + when new $ + modify $ \s -> s + & focusRingUpdate myWorkFocusL + & onPane @Projects %~ updatePane prjs + & onPane @FileMgrPane %~ updatePane False + ... + #+end_src + + This invokes the ~Projects~ Pane ~updatePane~ method which is added to support + updating the displayed projects based on the new data: + + #+begin_src haskell + instance Pane WName MyWorkEvent Projects where + ... + type (UpdateType Projects) = Projects + updatePane newprjs = + (pList %~ listReplace (Vector.fromList (name <$> projects newprjs)) (Just 0)) + . + (pSrch . editContentsL %~ Text.Zipper.clearZipper) + #+end_src + + There's also an alternative to saving and returning the ~new~ indication from + ~handleFocusAndPanelEvents~: the transition detection within brick-panes. In + the above example, the first element of the tuple returned by + ~handleFocusAndPanelEvents~ is discarded, but it is a ~PanelTransition~ object. + There are two brick-panes functions that take a ~PanelTransition~ as an + argument: ~enteredModal~ and ~exitedModal~. These can be used to detect if the + current event handling caused a modal to be newly displayed or dismissed, and + this can be used to perform various actions. The following shows the global + event handler code that might use this method: + + #+begin_src haskell + ev -> do proj0 <- gets selectedProject + s <- get + (trns,s') <- handleFocusAndPanelEvents myWorkFocusL s ev + put s' + when (exitedModal @FileMgr trns s') $ + modify $ \s -> s + & focusRingUpdate myWorkFocusL + & onPane @Projects %~ updatePane (snd $ getProjects s) + & onPane @FileMgrPane %~ updatePane False + ... + #+end_src + + This implementation is slightly less efficient since it will perform the + updates on every exit from the FileMgr modal even if there were no changes to + the Projects it manages, but it demonstrates the usefulness of the + ~PanelTransition~ indication. There is also a ~isPanelModal~ function that + returns True if the Panel is currently showing a Modal pane. + + Finally, the draw function is modified to draw the modal (if drawable) before + the other Panes, drawing those Panes with the ~"disabled"~ attribute if the + modal is active. + + #+begin_src +drawMyWork mws = + let mainPanes = + [ + borderWithLabel (str $ " mywork-example " <> showVersion version <> " ") + $ vBox $ catMaybes + [ + panelDraw @SummaryPane mws + ... + ] + ] + allPanes = catMaybes [ panelDraw @FileMgrPane mws ] <> mainPanes + disableLower = \case + (m:ls) -> m : (withDefAttr (attrName "disabled") <$> ls) + o -> o + in joinBorders . withBorderStyle unicode <$> disableLower allPanes + #+end_src + +**** FileMgr Pane Notes + + Not all of the details of the ~FileMgr~ modal Pane implementation are shown + above, but the remainder is relatively mechanical. The ~samples/mywork-example~ + directory can be consulted for the more complete implementation details. + +** Closing Notes + + At this point, all of the functionality provided by the brick-panes library + has been introduced, along with examples of code utilizing that functionality. + We have seen how to add a new Pane, including modal panes, and how to + coordinate both information sharing and isolation between the various Panes. + + Rather than pedantically walk through the remainder of the creation of the + ~mywork-example~ application implementation, the completion and extensions of + this sample application are left as exercises for the reader: + + * Implement the Notes Pane, displaying the Notes associated with the selected + Location. + + * Implement the Add Project operation + + * Implement the Add Location operation + + * Implement the Add Notes operation + + * Add handling for the Projects Search box, modifying the display of the listed + Projects based on the entry in the Search box. + + * Add error handling and display (e.g. loading invalid files) + + * Add display of additional Project information (description, language, role, + etc.). + + + If this sample application is intriguing as a potentially useful application + for daily use, a much more sophisticated and complete version is available from + Hackage or https://github.com/kquick/mywork. + +* FAQ + + * Why not just use Brick Widgets? + + Brick Widgets are a great abstraction, but they are a fairly low-level + abstraction that don't inherently support multiple, focusable sub-components + and a generic abstraction interface. diff --git a/brick-panes.cabal b/brick-panes.cabal new file mode 100644 --- /dev/null +++ b/brick-panes.cabal @@ -0,0 +1,96 @@ +cabal-version: 3.0 +name: brick-panes +version: 1.0.0.0 +synopsis: + Panes library for Brick providing composition and isolation for TUI apps. + +description: + The Panes library is an overlay for Brick that allows individual TUI + screen areas to be independently developed and then easily composed + into the overall application. + +homepage: https://github.com/kquick/brick-panes +license: ISC +license-file: LICENSE +author: Kevin Quick +maintainer: kquick@galois.com +copyright: (c) Kevin Quick, 2022 +category: Graphics +build-type: Simple +tested-with: GHC == 8.8.4, GHC == 8.10.7, GHC == 9.2.4, GHC == 9.4.2 + +extra-doc-files: CHANGELOG.md + , README.org + +source-repository head + type: git + location: https://github.com/kquick/brick-panes + +flag examples + description: Build example programs + default: True + manual: False + +common settings + ghc-options: -Wall + -Wcompat + -Wincomplete-uni-patterns + -Wsimplifiable-class-constraints + -Wpartial-fields + -fprint-potential-instances + -fhide-source-paths + +library + import: settings + hs-source-dirs: src + default-language: Haskell2010 + exposed-modules: Brick.Panes + build-depends: base >= 4.13 && < 4.18 + , brick >= 1.0 && < 1.4 + , containers + , microlens >= 0.4.11.2 && < 0.5 + , vty >= 5.35 && < 5.38 + +executable mywork-example + import: settings + default-language: Haskell2010 + hs-source-dirs: samples/mywork + main-is: Main.hs + ghc-options: -threaded + other-modules: Defs + InitialData + Panes.FileMgr + Panes.Location + Panes.Operations + Panes.Projects + Panes.Summary + Paths_brick_panes + autogen-modules: Paths_brick_panes + build-depends: base >= 4.13 && < 4.18 + , brick >= 1.0 && < 1.4 + , brick-panes + , aeson >= 2.0 && < 2.2 + , bytestring >= 0.10 && < 0.13 + , containers + , directory >= 1.3 && < 1.4 + , microlens >= 0.4.11.2 && < 0.5 + , text + , text-zipper >= 0.12 && < 0.13 + , time + , vector >= 0.12 && < 0.14 + , vty >= 5.35 && < 5.38 + if !flag(examples) + buildable: False + +test-suite brick-panes-test + import: settings + default-language: Haskell2010 + -- other-modules: + -- other-extensions: + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: base >= 4.13 && < 4.18 + , brick-panes + + diff --git a/samples/mywork/Defs.hs b/samples/mywork/Defs.hs new file mode 100644 --- /dev/null +++ b/samples/mywork/Defs.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} + +module Defs where + +import Brick hiding (Location) +import Brick.Focus +import Brick.Panes +import Brick.Widgets.Border +import Data.Text ( Text ) +import Data.Time.Calendar +import GHC.Generics ( Generic ) +import Lens.Micro +import Lens.Micro.Extras ( view ) + + +newtype Projects = Projects { projects :: [Project] } + deriving Generic + +data Project = Project { name :: Text + , role :: Role + , description :: Text + , language :: Either Text Language + , locations :: [Location] + } + deriving Generic + +data Role = Author | Maintainer | Contributor | User + deriving (Show, Enum, Bounded, Eq, Generic) + +data Language = Haskell | Rust | C | CPlusPlus | Python | JavaScript + deriving (Eq, Generic) + +data Location = Location { location :: Text + , locatedOn :: Maybe Day + , notes :: [Note] + } + deriving Generic + +data Note = Note { note :: Text + , notedOn :: Day + } + deriving Generic + + +numProjects :: Projects -> Int +numProjects = length . projects + + +---------------------------------------------------------------------- + +data MyWorkCore = MyWorkCore { projFile :: FilePath + , myWorkFocus :: FocusRing WName + } + +initMyWorkCore :: MyWorkCore +initMyWorkCore = MyWorkCore { projFile = "projects.json" + , myWorkFocus = focusRing [ WProjList, WLocation ] + } + +coreWorkFocusL :: Lens' MyWorkCore (FocusRing WName) +coreWorkFocusL f c = (\f' -> c { myWorkFocus = f' }) <$> f (myWorkFocus c) + + +data WName = WSummary | WProjList | WLocation | WNotes | WOps + | WFileMgr | WFBrowser | WFSaveBtn + | WPList | WPFilter | WLList + deriving (Eq, Ord, Show) + + + +-- | Adds a border with a title to the current widget. First argument is True if +-- the current widget has focus. +titledB :: Bool -> Text -> Widget WName -> Widget WName +titledB fcsd text = + let ttlAttr = if fcsd then withAttr (attrName "Selected") else id + in borderWithLabel (ttlAttr $ txt text) + + +type MyWorkEvent = () -- No app-specific event for this simple app + + +class HasProjects s where + getProjects :: s -> (Bool, Projects) + + +instance HasFocus MyWorkCore WName where + getFocus f s = + let setFocus jn = case focused jn of + Nothing -> s + Just n -> s & coreWorkFocusL %~ focusSetCurrent n + in setFocus <$> (f $ Focused $ focusGetCurrent (s^.coreWorkFocusL)) + + +class HasSelection s where + selectedProject :: s -> Maybe Text + +instance ( PanelOps Projects WName MyWorkEvent panes MyWorkCore + , HasSelection (PaneState Projects MyWorkEvent) + ) + => HasSelection (Panel WName MyWorkEvent MyWorkCore panes) where + selectedProject = selectedProject . view (onPane @Projects) diff --git a/samples/mywork/InitialData.hs b/samples/mywork/InitialData.hs new file mode 100644 --- /dev/null +++ b/samples/mywork/InitialData.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE OverloadedStrings #-} + +module InitialData + ( + initial_projects + ) +where + +import Data.Time.Calendar + +import Defs + + +initial_projects :: Projects +initial_projects = Projects + [ + Project + { name = "brick-panes" + , description = "Compositional aspect isolation library for Brick-based TUI apps." + , role = Author + , language = Right Haskell + , locations = + [ + Location + { location = "/home/kquick/Projects/panes" + , locatedOn = Nothing + , notes = + [ Note + { note = "Main development location" + , notedOn = fromGregorian 2022 09 08 + } + ] + } + , Location + { location = "https://github.com/kquick/brick-panes" + , locatedOn = Just $ fromGregorian 2022 09 10 + , notes = + [ Note + { note = "Published source code VCS location" + , notedOn = fromGregorian 2022 09 10 + } + ] + } + ] + } + + , Project + { name = "brick" + , description = "A declarative terminal user interface library" + , role = Contributor + , language = Right Haskell + , locations = + [ + Location { location = "/home/kquick/Public/brick" + , locatedOn = Just $ fromGregorian 2022 08 28 + , notes = + [ Note + { note = "local copy of master" + , notedOn = fromGregorian 2022 07 19 + } + , Note + { note = "updated to post-1.0 Brick release" + , notedOn = fromGregorian 2022 08 28 + } + ] + } + , Location { location = "https://github.com/jtdaugherty/brick" + , locatedOn = Just $ fromGregorian 2017 12 27 + , notes = mempty + } + , Location { location = "https://github.com/kquick/brick" + , locatedOn = Nothing + , notes = + [ Note + { note = "Fork for pushing changes to create pull requests \n\ + \ \n\ + \ Remember to put changes on a branch!" + , notedOn = fromGregorian 2020 10 5 + } + , Note + { note = "This repo's master is not always up to date.\n\ + \ Usually only development branches are pushed, \ + \ not master." + , notedOn = fromGregorian 2020 10 20 + } + ] + } + ] + } + ] diff --git a/samples/mywork/Main.hs b/samples/mywork/Main.hs new file mode 100644 --- /dev/null +++ b/samples/mywork/Main.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module Main where + +import Brick hiding ( Location ) +import Brick.Focus +import Brick.Panes +import Brick.Widgets.Border +import Brick.Widgets.Border.Style +import Brick.Widgets.Edit +import Brick.Widgets.List +import Control.Monad ( guard, when ) +import Control.Monad.IO.Class ( liftIO ) +import qualified Data.List as DL +import Data.Maybe ( catMaybes ) +import Data.Version ( showVersion ) +import Graphics.Vty ( defAttr, withStyle, defaultStyleMask + , bold, reverseVideo, dim + , black, white, yellow, red ) +import qualified Graphics.Vty as Vty +import Lens.Micro + +import Defs +import Panes.Location () +import Panes.Operations +import Panes.Projects () +import Panes.Summary +import Panes.FileMgr +import Paths_brick_panes ( version ) + +-- import InitialData +-- import Data.ByteString.Lazy as BS +-- import Data.Aeson ( encode ) + +type MyWorkState = Panel WName MyWorkEvent MyWorkCore + '[ SummaryPane + , OperationsPane + , Location + , Projects + , FileMgrPane + ] + +main :: IO () +main = defaultMain myworkApp initialState >> return () +-- main = BS.writeFile "projects.json" (encode $ initial_projects) + +myworkApp :: App MyWorkState MyWorkEvent WName +myworkApp = App { appDraw = drawMyWork + , appChooseCursor = showFirstCursor + , appHandleEvent = handleMyWorkEvent + , appStartEvent = return () + , appAttrMap = const myattrs + } + +myattrs :: AttrMap +myattrs = attrMap defAttr + [ + (editAttr, white `on` black) + , (editFocusedAttr, yellow `on` black) + + , (listAttr, defAttr `withStyle` defaultStyleMask) + , (listSelectedAttr, defAttr `withStyle` bold) + , (listSelectedFocusedAttr, defAttr `withStyle` reverseVideo) + + , (attrName "disabled", defAttr `withStyle` dim) + , (attrName "Selected", black `on` yellow) + , (attrName "Error", fg red) + ] + +initialState :: MyWorkState +initialState = focusRingUpdate myWorkFocusL + $ addToPanel Never + $ addToPanel Never + $ addToPanel WhenFocused + $ addToPanel WhenFocused + $ addToPanel WhenFocusedModal + $ basePanel initMyWorkCore + +drawMyWork :: MyWorkState -> [Widget WName] +drawMyWork mws = + let mainPanes = + [ + borderWithLabel (str $ " mywork " <> showVersion version <> " ") + $ vBox $ catMaybes + [ + panelDraw @SummaryPane mws + , Just hBorder + , Just $ hBox $ catMaybes + [ hLimitPercent 25 + <$> panelDraw @Projects mws + , Just vBorder + , panelDraw @Location mws + ] + , Just hBorder + , panelDraw @OperationsPane mws + ] + ] + allPanes = catMaybes [ panelDraw @FileMgrPane mws + ] + <> mainPanes + disableLower = \case + (m:ls) -> m : (withDefAttr (attrName "disabled") <$> ls) + o -> o + in joinBorders . withBorderStyle unicode <$> disableLower allPanes + + +handleMyWorkEvent :: BrickEvent WName MyWorkEvent -> EventM WName MyWorkState () +handleMyWorkEvent = \case + AppEvent _ -> return () -- this app does not use these + -- Application global actions + -- * CTRL-q quits + -- * CTRL-l refreshes vty + -- * ESC dismisses any modal window + VtyEvent (Vty.EvKey (Vty.KChar 'q') [Vty.MCtrl]) -> halt + VtyEvent (Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl]) -> do + vty <- getVtyHandle + liftIO $ Vty.refresh vty + VtyEvent (Vty.EvKey (Vty.KFun 1) []) -> do + fmgr <- liftIO initFileMgr + modify ((focusRingUpdate myWorkFocusL) . (onPane @FileMgrPane .~ fmgr)) + -- Otherwise, allow the Panes in the Panel to handle the event + ev -> do proj0 <- gets selectedProject + s <- get + (_,s') <- handleFocusAndPanelEvents myWorkFocusL s ev + put s' + (new,prjs) <- gets getProjects + let mprj st = do pnm <- selectedProject st + guard (Just pnm /= proj0) + DL.find ((== pnm) . name) (projects prjs) + when new $ + modify $ \st -> st + & focusRingUpdate myWorkFocusL + & onPane @Projects %~ updatePane prjs + & onPane @FileMgrPane %~ updatePane False + modify $ \st -> + case mprj st of + Just p -> st & onPane @Location %~ updatePane p + _ -> st + modify $ focusRingUpdate myWorkFocusL + +myWorkFocusL :: Lens' MyWorkState (FocusRing WName) +myWorkFocusL = onBaseState . coreWorkFocusL diff --git a/samples/mywork/Panes/FileMgr.hs b/samples/mywork/Panes/FileMgr.hs new file mode 100644 --- /dev/null +++ b/samples/mywork/Panes/FileMgr.hs @@ -0,0 +1,180 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Panes.FileMgr + ( + FileMgrPane + , initFileMgr + , myProjectsL + ) +where + +import Brick hiding ( Location ) +import Brick.Panes +import Brick.Widgets.Center +import qualified Brick.Widgets.Core as BC +import Brick.Widgets.FileBrowser +import qualified Control.Exception as X +import Control.Monad.IO.Class ( liftIO ) +import Data.Aeson ( ToJSON, FromJSON, decode, encode ) +import qualified Data.ByteString.Lazy as BS +import qualified Data.Sequence as Seq +import qualified Graphics.Vty as Vty +import Lens.Micro +import Lens.Micro.Extras ( view ) +import System.Directory ( doesDirectoryExist ) + +import Defs + + +data FileMgrPane + +instance Pane WName MyWorkEvent FileMgrPane where + data (PaneState FileMgrPane MyWorkEvent) = + FB { fB :: Maybe (FileBrowser WName) + -- ^ A Nothing value indicates the modal is not currently active + , myProjects :: Projects + -- ^ Current loaded set of projects + , newProjects :: Bool + -- ^ True when myProjects has been updated; clear this via updatePane + } + type (InitConstraints FileMgrPane s) = () + type (DrawConstraints FileMgrPane s WName) = ( HasFocus s WName ) + type (EventConstraints FileMgrPane e) = ( HasFocus e WName ) + initPaneState _ = FB Nothing (Projects mempty) False + drawPane ps gs = drawFB gs <$> fB ps + focusable _ ps = case fB ps of + Nothing -> mempty + Just _ -> Seq.fromList [ WFBrowser, WFSaveBtn ] + handlePaneEvent bs ev ts = + let isSearching = maybe False fileBrowserIsSearching (ts^.fBrowser) + in case ev of + Vty.EvKey Vty.KEsc [] | not isSearching -> return $ ts & fBrowser .~ Nothing + _ -> case bs^.getFocus of + Focused (Just WFBrowser) -> handleFileLoadEvent ev ts + Focused (Just WFSaveBtn) -> handleFileSaveEvent ev ts + _ -> return ts + type (UpdateType FileMgrPane) = Bool + updatePane newFlag ps = ps { newProjects = newFlag } + + + +fBrowser :: Lens' (PaneState FileMgrPane MyWorkEvent) (Maybe (FileBrowser WName)) +fBrowser f ps = (\n -> ps { fB = n }) <$> f (fB ps) + +myProjectsL :: Lens' (PaneState FileMgrPane MyWorkEvent) Projects +myProjectsL f wc = (\n -> wc { myProjects = n }) <$> f (myProjects wc) + + +instance ( PanelOps FileMgrPane WName MyWorkEvent panes MyWorkCore + , HasProjects (PaneState FileMgrPane MyWorkEvent) + ) + => HasProjects (Panel WName MyWorkEvent MyWorkCore panes) where + getProjects = getProjects . view (onPane @FileMgrPane) + +instance HasProjects (PaneState FileMgrPane MyWorkEvent) where + getProjects ps = (newProjects ps, myProjects ps) + + +drawFB :: DrawConstraints FileMgrPane drawstate WName + => drawstate -> FileBrowser WName -> Widget WName +drawFB ds b = + let width = 70 + fcsd = ds^.getFocus.to focused + browserPane fb = + let hasFocus = fcsd == Just WFBrowser + in vLimitPercent 55 $ hLimitPercent width + $ titledB hasFocus "Choose a file" + $ renderFileBrowser hasFocus fb + helpPane = + padTop (BC.Pad 1) $ hLimitPercent width $ vBox + [ hCenter $ txt "Up/Down: select" + , hCenter $ txt "/: search, Ctrl-C or Esc: cancel search" + , hCenter $ txt "Enter: change directory or select file" + , hCenter $ txt "Space: change directory" + , hCenter $ txt "TAB: select Save option" + , hCenter $ txt "ESC: quit" + ] + errDisplay fb = case fileBrowserException fb of + Nothing -> emptyWidget + Just e -> hLimitPercent width + $ withDefAttr (attrName "Error") + $ strWrap + $ X.displayException e + savePane = (if fcsd == Just WFSaveBtn + then withAttr (attrName "Selected") + else id) + $ str "[SAVE]" + in centerLayer (browserPane b <=> errDisplay b <=> savePane <=> helpPane) + + +handleFileLoadEvent :: Vty.Event + -> PaneState FileMgrPane MyWorkEvent + -> EventM WName es (PaneState FileMgrPane MyWorkEvent) +handleFileLoadEvent ev ts = + case ts^.fBrowser of + Just fb -> do + b <- nestEventM' fb $ handleFileBrowserEvent ev + let selectFile = + case fileBrowserCursor b of + Nothing -> return $ ts & fBrowser .~ Just b -- navigation + Just f -> + let fp = fileInfoFilePath f + in liftIO $ doesDirectoryExist fp >>= \e -> + if e + then return $ ts & fBrowser .~ Just b + else do newprjs <- decode <$> liftIO (BS.readFile fp) + -- Setting fBrowser to Nothing: exit from modal + case newprjs of + Nothing -> return $ ts & fBrowser .~ Nothing + Just prjs -> return $ (ts { newProjects = True}) + & fBrowser .~ Nothing + & myProjectsL .~ prjs + case ev of + Vty.EvKey Vty.KEnter [] -> selectFile + Vty.EvKey (Vty.KChar ' ') [] -> selectFile + _ -> return $ ts & fBrowser .~ Just b + Nothing -> return ts -- shouldn't happen + + +handleFileSaveEvent :: Vty.Event + -> PaneState FileMgrPane MyWorkEvent + -> EventM WName es (PaneState FileMgrPane MyWorkEvent) +handleFileSaveEvent _ ts = + case fileBrowserCursor =<< ts^.fBrowser of + Nothing -> return ts + Just f -> let fp = fileInfoFilePath f + in liftIO (doesDirectoryExist fp) >>= \case + True -> return ts -- TODO: show error + False -> do liftIO $ BS.writeFile fp (encode $ myProjects ts) + return ts + + +instance ToJSON Projects +instance ToJSON Project +instance ToJSON Role +instance ToJSON Language +instance ToJSON Location +instance ToJSON Note + +instance FromJSON Projects +instance FromJSON Project +instance FromJSON Role +instance FromJSON Language +instance FromJSON Location +instance FromJSON Note +-- deriving via Generically Note instance ToJSON Note + + +initFileMgr :: IO (PaneState FileMgrPane MyWorkEvent) +initFileMgr = do + fb <- newFileBrowser selectNonDirectories WFBrowser Nothing + return $ initPaneState fb & fBrowser .~ Just fb diff --git a/samples/mywork/Panes/Location.hs b/samples/mywork/Panes/Location.hs new file mode 100644 --- /dev/null +++ b/samples/mywork/Panes/Location.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Panes.Location () where + +import Brick hiding ( Location ) +import Brick.Panes +import Brick.Widgets.List +import Lens.Micro +import qualified Data.List as DL +import Data.Maybe ( fromMaybe ) +import Data.Text ( Text ) +import Data.Time.Calendar +import qualified Data.Vector as V + +import Defs + + +instance Pane WName MyWorkEvent Location where + data (PaneState Location MyWorkEvent) = L { lL :: List WName (Text, Maybe Day) } + type (InitConstraints Location s) = ( HasSelection s, HasProjects s ) + type (DrawConstraints Location s WName) = ( HasFocus s WName, HasSelection s ) + initPaneState gs = + let l = L (list WLList mempty 2) + update x = do p <- selectedProject gs + prj <- DL.find ((== p) . name) + (projects $ snd $ getProjects gs) + return $ updatePane prj x + in fromMaybe l $ update l + drawPane ps gs = + let isFcsd = gs^.getFocus.to focused == Just WLocation + rndr (l,d) = (txt l + <+> vLimit 1 (fill ' ') + <+> (str $ maybe "*" show d) + ) + <=> str " " + in Just $ renderList (const rndr) isFcsd (lL ps) + focusable _ ps = focus1If WLocation $ not $ null $ listElements $ lL ps + handlePaneEvent _ ev ps = do r <- nestEventM' (lL ps) (handleListEvent ev) + return $ ps & lList .~ r + type (UpdateType Location) = Project + updatePane prj ps = + let ents = [ (location l, locatedOn l) | l <- locations prj ] + in L $ listReplace (V.fromList ents) (Just 0) (lL ps) + + +lList :: Lens' (PaneState Location MyWorkEvent) (List WName (Text, Maybe Day)) +lList f ps = (\n -> ps { lL = n }) <$> f (lL ps) diff --git a/samples/mywork/Panes/Operations.hs b/samples/mywork/Panes/Operations.hs new file mode 100644 --- /dev/null +++ b/samples/mywork/Panes/Operations.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Panes.Operations + ( + OperationsPane + ) +where + +import Brick +import Brick.Panes +import qualified Data.List as List + +import Defs + + +data OperationsPane + +instance Pane WName MyWorkEvent OperationsPane where + data (PaneState OperationsPane MyWorkEvent) = Unused + type (DrawConstraints OperationsPane s WName) = ( HasSelection s ) + initPaneState _ = Unused + drawPane _ gs = + let projInd = case selectedProject gs of + Nothing -> withAttr (attrName "disabled") + Just _ -> id + ops = List.intersperse (fill ' ') + [ str "F1-Load/Save" + , str "F2-Add Project" + , projInd $ str "F3-Add Location" + , projInd $ str "F4-Add Note" + ] + in Just $ vLimit 1 $ str " " <+> hBox ops <+> str " " diff --git a/samples/mywork/Panes/Projects.hs b/samples/mywork/Panes/Projects.hs new file mode 100644 --- /dev/null +++ b/samples/mywork/Panes/Projects.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Panes.Projects () where + +import Brick +import Brick.Panes +import Brick.Widgets.Edit +import Brick.Widgets.List +import qualified Data.Sequence as Seq +import Data.Text ( Text ) +import qualified Data.Text.Zipper as TZ +import qualified Data.Vector as V +import Lens.Micro + +import Defs + + +instance Pane WName MyWorkEvent Projects where + data (PaneState Projects MyWorkEvent) = P { pL :: List WName Text + , pS :: Editor Text WName + } + type (InitConstraints Projects s) = ( HasProjects s ) + type (DrawConstraints Projects s WName) = ( HasFocus s WName ) + type (EventType Projects WName MyWorkEvent) = BrickEvent WName MyWorkEvent + initPaneState s = let prjs = projects $ snd $ getProjects s + pl = list WPList (V.fromList (name <$> prjs)) 1 + ps = editor WPFilter (Just 1) "" + in P pl ps + drawPane ps gs = + let isFcsd = gs^.getFocus.to focused == Just WProjList + lst = renderList (const txt) isFcsd (pL ps) + srch = str "Search: " <+> renderEditor (txt . head) isFcsd (pS ps) + in Just $ vBox [ lst, fill ' ', srch ] + handlePaneEvent _ ev ps = + do ps1 <- case ev of + VtyEvent ev' -> do + r <- nestEventM' (pL ps) (handleListEvent ev') + return $ ps & pList .~ r + _ -> return ps + srch <- nestEventM' (ps ^. pSrch) (handleEditorEvent ev) + return $ ps1 & pSrch .~ srch + focusable _ _ = Seq.singleton WProjList + type (UpdateType Projects) = Projects + updatePane newprjs = + (pList %~ listReplace (V.fromList (name <$> projects newprjs)) (Just 0)) + . + (pSrch . editContentsL %~ TZ.clearZipper) + + +pList :: Lens' (PaneState Projects MyWorkEvent) (List WName Text) +pList f ps = (\n -> ps { pL = n }) <$> f (pL ps) + +pSrch :: Lens' (PaneState Projects MyWorkEvent) (Editor Text WName) +pSrch f ps = (\n -> ps { pS = n }) <$> f (pS ps) + + +instance HasSelection (PaneState Projects MyWorkEvent) where + selectedProject = fmap snd . listSelectedElement . pL diff --git a/samples/mywork/Panes/Summary.hs b/samples/mywork/Panes/Summary.hs new file mode 100644 --- /dev/null +++ b/samples/mywork/Panes/Summary.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Panes.Summary + ( + SummaryPane + ) +where + +import Brick +import Brick.Panes +import qualified Data.List as List +import Data.Maybe ( catMaybes ) + +import Defs + + +data SummaryPane + +instance Pane WName MyWorkEvent SummaryPane where + data (PaneState SummaryPane MyWorkEvent) = Unused + type (DrawConstraints SummaryPane s WName) = ( HasProjects s ) + initPaneState _ = Unused + drawPane _ s = Just $ drawSummary (snd $ getProjects s) + + +drawSummary :: Projects -> Widget WName +drawSummary prjcts = + let prjs = projects prjcts + prjcnt = str $ "# Projects=" <> show (length prjs) <> subcounts + subcounts = (" (" <>) + $ (<> ")") + $ List.intercalate ", " + [ show r <> "=" <> show (length fp) + | r <- [minBound .. maxBound] + , let fp = filter (isRole r) prjs + , not (null fp) + ] + isRole r p = r == role p + dateRange = str (show (minimum projDates) + <> ".." + <> show (maximum projDates) + ) + locDates prj = catMaybes (locatedOn <$> locations prj) + projDates = concatMap locDates prjs + in vLimit 5 + $ vBox + [ + if null prjs + then str "No projects defined" + else prjcnt <+> fill ' ' <+> dateRange + , str " " + , str "Note: this is an example only and not fully functional." + , strWrap "See https://github.com/kquick/mywork for a fully functional and feature-rich version." + ] diff --git a/src/Brick/Panes.hs b/src/Brick/Panes.hs new file mode 100644 --- /dev/null +++ b/src/Brick/Panes.hs @@ -0,0 +1,728 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +{-| This package provides an overlay library for Brick that allows + individual TUI screen areas to be independently developed and then easily + composed into the overall application. +-} + +module Brick.Panes + ( + -- * Pane Specification + -- ** Definition and Initialization + Pane + , PaneState + , InitConstraints + , initPaneState + -- ** Drawing + , DrawConstraints + , drawPane + -- ** Event Handling + , EventConstraints + , EventType + , DispatchEvent + , focusable + , handlePaneEvent + -- ** Updating the Pane's state + , UpdateType + , updatePane + -- ** Focus management helpers and constraints + , focus1If + , HasFocus + , getFocus + , Focused(Focused) + , focused + -- * Panel Specification + -- ** Definition and Initialization + , Panel + , basePanel + , addToPanel + , PaneFocus( Always, Never, WhenFocused, WhenFocusedModal + , WhenFocusedModalHandlingAllEvents + ) + -- ** Pane and base state access + , onPane + , onBaseState + -- ** Drawing + , panelDraw + -- ** Focus and Event management + , handleFocusAndPanelEvents + , focusRingUpdate + , isPanelModal + , enteredModal + , exitedModal + , PanelMode(Normal, Modal) + , PanelTransition + -- ** Access and operations + , PanelOps(..) + , PaneNumber + ) +where + +import Control.Applicative ( (<|>) ) +import qualified Data.Foldable as F +import Data.Kind ( Constraint, Type ) +import qualified Data.List as L +import Data.Maybe ( fromMaybe ) +import Data.Sequence ( Seq, (><) ) +import qualified Data.Sequence as Seq +import Data.Type.Equality +import Data.Void ( Void, absurd ) +import GHC.TypeLits +import qualified Graphics.Vty as Vty +import Lens.Micro +#if !MIN_VERSION_base(4,16,0) +-- starting in base 4.16.0.0, GHC.TypeLits exports Natural +import Numeric.Natural ( Natural ) +#endif + +import Brick +import Brick.Focus + + +-- | Class to manage each pane in the Brick TUI. +-- +-- Type parameters: +-- +-- * @pane@ = Pane Type, uniquely identifying this pane +-- * @appEv@ = The application's event type +-- * @n@ = Widget type parameter +-- +-- The 'PaneState' specifies the state that should be stored globally +-- and which provides the primary information for handling this pane +-- (for both draw and event handling operations). +-- +-- The 'initPaneState' method is responsible for returning an initial 'PaneState' +-- value (at startup). +-- +-- The 'drawPane' method is called to render the pane into a 'Widget' (or Nothing +-- if this Pane should not currently be drawn). It is passed the 'PaneState' and +-- also a drawing parameter. The 'DrawConstraints' can be used to specify +-- additional instance requirements for the drawing parameter. The global +-- application state is often passed as this drawing parameter, but the +-- 'drawPane' method should only perform 'DrawConstraints' operations, along with +-- general Brick drawing operations. +-- +-- The 'focusable' method should return the names of the widgets that can be the +-- target of the 'FocusRing' in the current state. This should always return an +-- empty list if the 'drawPane' returns 'Nothing'. +-- +-- The 'handlePaneEvent' method is called to handle an event that has occurred +-- within this Pane. It should return the updated 'PaneState' in the context of +-- an 'EventM' monadic operation. +-- +-- The 'updatePane' method is called with the 'UpdateType' to perform any +-- updating of the 'PaneState' from the update type data. +class Pane n appEv pane | pane -> n where + + -- | State information associated with this pane + data (PaneState pane appEv) + + -- | Type of data provided to updatePane + type (UpdateType pane) + + -- | Constraints on argument passed to 'initPaneState'. If there are no + -- constraints, this may be specified as @()@, or simply omitted because @()@ + -- is the default. + type (InitConstraints pane initctxt) :: Constraint + -- | Function called to initialize the internal 'PaneState' + initPaneState :: (InitConstraints pane i) => i -> PaneState pane appEv + + -- | Constraints on the @drawcontext@ parameter passed to 'drawPane'. + type (DrawConstraints pane drwctxt n) :: Constraint + -- | Function called to draw the 'Pane' as a Brick 'Widget', or 'Nothing' if + -- this 'Pane' should not be drawn at the current time. + drawPane :: (DrawConstraints pane drawcontext n, Eq n) + => PaneState pane appEv -> drawcontext -> Maybe (Widget n) + + -- | The constraints that should exist on the 'eventcontext' argment passed to + -- 'focusable' and 'handlePaneEvent'. + type (EventConstraints pane evctxt) :: Constraint + -- | The type of the event argument delivered to 'handlePaneEvent'. This + -- should either be 'Vty.Event' or 'BrickEvent', depending on what level of + -- granularity the 'handlePaneEvent' operates at. + type (EventType pane n appEv) + -- | The 'focusable' method is called to determine which Widget targets should + -- be part of the Brick 'FocusRing'. + focusable :: (EventConstraints pane eventcontext, Eq n) + => eventcontext -> PaneState pane appEv -> Seq.Seq n + -- | Called to handle an 'EventType' event for the 'Pane'. This is typically + -- only called when (one of the 'focusable' targets of) the 'Pane' is the focus + -- of the 'FocusRing'. It should modify the internal 'PaneState' as + -- appropriate and make any appropriate changes to properly render the 'Pane' + -- on the next 'drawPane' call. + -- + -- Note that this function also receives an eventcontext which it may stipulate + -- constraints on. Those constraints should be *read-only* constraints. This + -- is especially important when the pane is used as part of a panel: the Panel + -- itself is passed as the eventcontext, but the panel may not be modified + -- because the panel event dispatching will discard any changes on completion. + handlePaneEvent :: (EventConstraints pane eventcontext, Eq n) + => eventcontext + -> EventType pane n appEv + -> PaneState pane appEv + -> EventM n es (PaneState pane appEv) + -- | Function called to update the internal 'PaneState', using the passed + -- 'updateType' argument. + updatePane :: UpdateType pane + -> PaneState pane appEv + -> PaneState pane appEv + + -- A set of defaults that allows a minimal instance specification + type (UpdateType pane) = () + type (InitConstraints pane initctxt) = () + type (DrawConstraints pane drwctxt n) = () + type (EventConstraints pane evctxt) = () + type (EventType pane n appev) = Vty.Event -- by default, handle Vty events + focusable _ _ = mempty + handlePaneEvent _ _ = return + updatePane _ = id + + +-- | This is a helper function for a Pane with a single Widget name and a +-- conditional focus. For example, if a widget is always focusable, then it can +-- specify: +-- +-- > instance Pane N E ThisPane () where +-- > ... +-- > focusable _ = const $ focus1If MyWidgetName True +focus1If :: n -> Bool -> Seq.Seq n +focus1If n b = if b then Seq.singleton n else mempty + + +-- | This class allows retrieval of the current focused Widget (if any). This +-- class is frequently specified as one of the constraints for the +-- 'DrawConstraints' or 'EventConstraints' of a 'Pane'. +class HasFocus b n | b -> n where + -- | Provides a lens from the primary type to the 'Focused' type, which + -- specifies the current focused element (if any). + getFocus :: Lens' b (Focused n) + -- By default, nothing has Focus + getFocus f x = const x <$> f (Focused Nothing) + +-- | This is a newtype to wrap the identification of the current focused element +-- (if any). +newtype Focused n = Focused { focused :: Maybe n + -- ^ The current focused element or 'Nothing'. + } + + +-- | The 'DispatchEvent' class is used to determine which type of event to +-- dispatch to a 'Pane' by selecting on the @'EventType' pane n@. This is used +-- internally in the brick-panes implementation and client code does not need to +-- explicitly specify instances of this class. +class DispatchEvent n appev pane evtype where + dispEv :: ( Pane n appev pane + , EventConstraints pane base + , Eq n + ) + => EventType pane n appev :~: evtype + -> base -> BrickEvent n appev -> PaneState pane appev + -> EventM n es (PaneState pane appev) + +instance DispatchEvent n appev pane (BrickEvent n appev) where + dispEv Refl base ev s = handlePaneEvent base ev s + +instance DispatchEvent n appev pane Vty.Event where + dispEv Refl base ev s = case ev of + VtyEvent vev -> handlePaneEvent base vev s + _ -> return s + + +---------------------------------------------------------------------- +-- A Panel is a composite of a number of panes + +-- | A Panel is a recursive data sequence of individual 'Pane' elements +-- with a core state. The core state represents the base state of the +-- Brick application, independent of the various Pane data. Each 'Pane' +-- has an instance that defines its 'PaneState', which is associated +-- here with a potential Widget name (allowing selected actions; see +-- 'handleFocusAndPanelEvents'). +-- +-- The 'Panel' type closes over the 'state' type argument, which is used for all +-- three of the 'Pane' constraints ('DrawConstraints', 'EventConstraints', and +-- indirectly the 'InitConstraints'), which means that the same 'state' type must +-- be passed to all three associated Pane methods; a 'Pane' used outside of the +-- 'Panel' container is not constrained in this manner and each method could have +-- a different argument. For the Panel, the 'state' is typically the Panel +-- "beneath" the current Pane, which is the aggregate of the base state and all +-- Panes added before the current pane. +data Panel n appev state (panes :: [Type]) where + Panel :: state -> Panel n appev state '[] + PanelWith :: ( Pane n appev pane + , DrawConstraints pane (Panel n appev state panes) n + , EventConstraints pane (Panel n appev state panes) + , DispatchEvent n appev pane (EventType pane n appev) + ) + => PaneState pane appev -> PaneFocus n + -> Panel n appev state panes -> Panel n appev state (pane ': panes) + + +-- | This is the base constructor for Panel that is given the core +-- application state. +basePanel :: state -> Panel n appev state '[] +basePanel = Panel + + +-- | Each 'Pane' that is part of the 'Panel' should be added to the 'Panel' via +-- this function, which also specifies when the `Pane` should receive Events. +addToPanel :: Pane n appev pane + => InitConstraints pane (Panel n appev state panes) + => DrawConstraints pane (Panel n appev state panes) n + => EventConstraints pane (Panel n appev state panes) + => DispatchEvent n appev pane (EventType pane n appev) + => PaneFocus n + -> Panel n appev state panes + -> Panel n appev state (pane ': panes) +addToPanel n pnl = PanelWith (initPaneState pnl) n pnl + + +-- | Specifies when a Pane should receive events. +data PaneFocus n = + -- | Indicates that this Pane always receives all events, although it is never + -- part of a focus ring. This should be used for Widgets that have a global + -- event handling. + Always + -- | Indicates that this Pane's handlePaneEvent is never called + | Never + -- | Indicates that the pane should receive events when the current focus is + -- equal to a 'focusable' return from the Pane. + | WhenFocused + -- | Indicates that the pane should receive events when the current focus is + -- equal to a 'focusable' return from the Pane, and that this should block + -- all non-modal focus candidates (it is expected that there is only one + -- modal, but this is not required). + | WhenFocusedModal + | WhenFocusedModal' (FocusRing n) -- previous focus ring to return to + -- | Indicates that the pane should receive events when the current focus is + -- equal to a 'focusable' return from the Pane, and that this should block all + -- non-modal focus candidates, just as with 'WhenFocusedModal'. However, this + -- also sends *all* events to the modal Pane instead of the normal 'Panel' + -- handling of events (e.g. @TAB@/@Shift-TAB@). + | WhenFocusedModalHandlingAllEvents + | WhenFocusedModalHandlingAllEvents' (FocusRing n) -- previous focus ring + + +-- | If the base state provides Focus information, then the Panel can provide +-- focus information. +instance HasFocus appState n => HasFocus (Panel n appEv appState panes) n where + getFocus = onBaseState . getFocus + + +-- | This is a lens providing access to the base application state at +-- the core of the Panel. +onBaseState :: Lens' (Panel n appev state panes) state +onBaseState f (Panel s) = Panel <$> f s +onBaseState f (PanelWith p n i) = PanelWith p n <$> onBaseState f i + +-- | This is a lens providing access to the PaneState for a specific Pane in the +-- Panel. The Pane is typically specified via a type application +-- (e.g. @@MyPane@). +onPane :: forall pane n appev state panes . + PanelOps pane n appev panes state + => Lens' (Panel n appev state panes) (PaneState pane appev) +onPane = lens (panelState @pane) (panelStateUpdate @pane) + + +-- -- | This can be used to get the inner Pane from the current Pane in the state. +-- onNextPane :: Lens' (Panel n appev state (pane ': panes)) (Panel n appev state panes) +-- onNextPane f = \case +-- PanelWith a b r -> (\r' -> PanelWith a b r') <$> f r + + +-- | This class defines the various operations that can be performed +-- on a Panel. Most of these operations specify a particular Pane as +-- the target of the operation; the operation is performed on that +-- pane and the Panel is is updated with the result. +-- +-- The user of this library will not need to develop new instances of this class: +-- the instances defined internally are sufficient. Users may need to specify +-- 'PanelOps' constraints on various functions. +class PanelOps pane n appev panes s | pane -> n where + + -- | This is called to pass the VTY Event to the specified Pane's + -- handler with a Panel. + handlePanelEvent :: (EventConstraints pane s, Eq n) + => s -> pane -> Panel n appev s panes -> BrickEvent n appev + -> EventM n es (Panel n appev s panes) + + -- | This is used to obtain the state of a specific Pane within the Panel. The + -- pane is usually specified by a type application (e.g. @@MyPane@). + panelState :: Panel n appev s panes -> PaneState pane appev + + -- | This is used to update the state of a specific Pane within the Panel. The + -- pane is usually specified by a type application (e.g. @@MyPane@). + panelStateUpdate :: Panel n appev s panes -> PaneState pane appev + -> Panel n appev s panes + + -- | This returns an ordinal index of the pane within the panel. + paneNumber :: Panel n appev s panes -> PaneNumber + + +instance (Pane n appev pane) => PanelOps pane n appev (pane ': panes) s where + handlePanelEvent s _p (PanelWith pd n r) ev = + (\pd' -> PanelWith pd' n r) <$> dispEv Refl s ev pd + panelState (PanelWith pd _ _) = pd + panelStateUpdate (PanelWith _pd n r) = \pd' -> PanelWith pd' n r + paneNumber _ = PaneNo 0 + + +instance {-# OVERLAPPABLE #-} (PanelOps pane n appev panes s) => + PanelOps pane n appev (o ': panes) s where + handlePanelEvent s p (PanelWith pd n r) ev = + PanelWith pd n <$> handlePanelEvent s p r ev + panelState (PanelWith _ _ r) = panelState r + panelStateUpdate (PanelWith pd n r) = + \pd' -> PanelWith pd n $ panelStateUpdate r pd' + paneNumber (PanelWith _ _ r) = succ $ paneNumber @pane r + + +instance ( TypeError + ('Text "No " ':<>: 'ShowType pane ':<>: 'Text " in Panel" + ':$$: 'Text "Add this pane to your Panel (or move it lower)" + ':$$: 'Text "(Possibly driven by DrawConstraints)" + ) + , Pane n appev pane + ) + => PanelOps pane n appev '[] s where + handlePanelEvent = absurd (undefined :: Void) + panelState = absurd (undefined :: Void) + panelStateUpdate = absurd (undefined :: Void) + paneNumber = absurd (undefined :: Void) + + +-- | Called to draw a specific pane in the panel. Typically invoked from the +-- applications' global drawing function. +panelDraw :: forall pane n appev s panes . + ( DrawConstraints pane (Panel n appev s panes) n + , PanelOps pane n appev panes s + , Pane n appev pane + , Eq n + ) + => Panel n appev s panes -> Maybe (Widget n) +panelDraw panel = drawPane (panelState @pane panel) panel + + +-- | Called to dispatch an events to the focused Pane in the Panel as determined +-- by matching the Widget names returned by the Pane's 'focusable' with the +-- current FocusRing focus target. +handlePanelEvents :: Eq n + => Panel n appev s panes + -> BrickEvent n appev + -> Focused n + -> EventM n es (Panel n appev s panes) +handlePanelEvents panel ev (Focused focus) = + -- n.b. no need to check focusable for a pane because an invisible + -- pane should never have focus + case focus of + Nothing -> return panel + Just fcs -> go fcs panel ev + where + go :: Eq n + => n -> Panel n appev s panes -> BrickEvent n appev + -> EventM n es (Panel n appev s panes) + go _ p@(Panel {}) _ = return p + go fcs (PanelWith pd pf r) evnt = + let handleIt = dispEv Refl r evnt pd + skipIt = return pd + in do pd' <- case pf of + Never -> skipIt + Always -> handleIt + WhenFocused -> if fcs `elem` focusable r pd + then handleIt + else skipIt + WhenFocusedModal -> if fcs `elem` focusable r pd + then handleIt + else skipIt + WhenFocusedModal' _ -> if fcs `elem` focusable r pd + then handleIt + else skipIt + WhenFocusedModalHandlingAllEvents -> + if fcs `elem` focusable r pd + then handleIt + else skipIt + WhenFocusedModalHandlingAllEvents' _ -> + if fcs `elem` focusable r pd + then handleIt + else skipIt + PanelWith pd' pf <$> go fcs r evnt + + +-- | Called to handle events for the entire 'Panel', including focus-changing +-- events. The current focused 'Pane' is determined and that Pane's handler is +-- called (based on the 'Widget' names returned as 'focusable' for that Pane). +-- If a Pane has no associated Widget name (the 'PaneFocus' value is specified as +-- 'Nothing' when adding the Pane to the Panel) then its handler is never called. +-- +-- This function returns the updated Panel state, as well as an indication of +-- whether a modal transition occured while handling the event. +-- +-- This function manages updating the focus when @Tab@ or @Shift-Tab@ is +-- selected, except when the currently focused pane was created with the +-- 'WhenFocusedModalHandlingAllEvents', in which case all events are passed +-- through to the Pane. +handleFocusAndPanelEvents :: Eq n => Ord n + => Lens' (Panel n appev s panes) (FocusRing n) + -> Panel n appev s panes + -> BrickEvent n appev + -> EventM n es (PanelTransition, Panel n appev s panes) +handleFocusAndPanelEvents focusL panel = + let fcs = focusGetCurrent (panel ^. focusL) + doPanelEvHandling = case fcs of + Nothing -> True + Just curFcs -> chkEv curFcs panel + in \case + VtyEvent (Vty.EvKey (Vty.KChar '\t') []) | doPanelEvHandling -> + return (Nothing, panel & focusL %~ focusNext) + VtyEvent (Vty.EvKey Vty.KBackTab []) | doPanelEvHandling -> + return (Nothing, panel & focusL %~ focusPrev) + panelEv -> do + u <- focusRingUpdate focusL <$> handlePanelEvents panel panelEv (Focused fcs) + let fcs' = focusGetCurrent (u ^. focusL) + if fcs == fcs' + then return (Nothing, u) + else let m0 = panelMode focusL panel + m1 = panelMode focusL u + in return $ if m0 == m1 + then (Nothing, u) + else (Just (m0, m1), u) + where + chkEv :: Eq n => n -> Panel n appev s panes -> Bool + chkEv curFcs = \case + Panel {} -> True + PanelWith pd WhenFocusedModalHandlingAllEvents r -> + (not $ curFcs `elem` focusable r pd) && chkEv curFcs r + PanelWith pd (WhenFocusedModalHandlingAllEvents' _) r -> + (not $ curFcs `elem` focusable r pd) && chkEv curFcs r + PanelWith _ _ r -> chkEv curFcs r + + +panelMode :: Eq n + => Ord n + => Lens' (Panel n appev s panes) (FocusRing n) + -> Panel n appev s panes -> PanelMode +panelMode focusL panel = + modalTgt (L.sort $ focusRingToList (panel ^. focusL)) panel + -- Note that the focusL-retrieved focus rings (m0, at least) + -- come from the live previous pane set and may not match the + -- order of the widget set. Oddly, it doesn't match a rotation + -- of the original either, ergo the sorting. + where + modalTgt :: Eq n + => Ord n + => [n] -> Panel n appev s panes -> PanelMode + modalTgt fcsRing = \case + Panel {} -> Normal + PanelWith pd WhenFocusedModal r -> + matchOrRecurse fcsRing r $ focusable r pd + PanelWith pd (WhenFocusedModal' _) r -> + matchOrRecurse fcsRing r $ focusable r pd + PanelWith pd WhenFocusedModalHandlingAllEvents r -> + matchOrRecurse fcsRing r $ focusable r pd + PanelWith pd (WhenFocusedModalHandlingAllEvents' _) r -> + matchOrRecurse fcsRing r $ focusable r pd + PanelWith _ _ r -> case modalTgt fcsRing r of + Normal -> Normal + Modal p -> Modal $ succ p + matchOrRecurse :: Eq n => Ord n + => [n] -> Panel n appev s pnlpanes -> Seq.Seq n -> PanelMode + matchOrRecurse fcsRing r f = + -- if fcsRing `elem` rotations (F.toList f) + if fcsRing == L.sort (F.toList f) + then Modal (PaneNo 0) + else case modalTgt fcsRing r of + Normal -> Normal + Modal p -> Modal $ succ p + + +-- | This function can be called at any time to determine if the Panel is +-- currently displaying a Modal Pane. This needs the Panel object and a lens +-- that can be used to extract the FocusRing from the Panel. +isPanelModal :: Eq n + => Ord n + => Lens' (Panel n appev s panes) (FocusRing n) + -> Panel n appev s panes + -> Bool +isPanelModal focusL panel = Normal /= panelMode focusL panel + + +-- | Indicates the current mode of the Panel. If Modal, the currently active +-- modal Panel is identified by the PaneNumber, which matches the return value of +-- the 'paneNumber' of PanelOps; in general, the use of 'isPaneModal' is +-- recommended over attempting to determine _which_ actual modal pane is active. +data PanelMode = Normal | Modal PaneNumber deriving (Eq) + +-- | Internal bookkeeping to identify a particular Pane within a Panel by number. +newtype PaneNumber = PaneNo Natural deriving (Eq, Enum) + + +-- | This is returned from the 'handleFocusAndPanelEvents' function to indicate +-- whether a modal transition occured during the panel's (and associated Pane's) +-- handling of this event. This can be used by the outer-level application code +-- to determine if a modal Pane was entered or exited due to the Event. +type PanelTransition = Maybe (PanelMode, PanelMode) + + +-- | Indicates if the specified Pane (via Type Application) is the one that was +-- modally entered as a result of processing an event (as indicated by +-- PanelTransition). +enteredModal :: forall pane n appev state panes + . PanelOps pane n appev panes state + => PanelTransition -> Panel n appev state panes -> Bool + -- n.b. assumes the Panel passed here is the same panel passed to + -- handleFocusAndPanelEvents for which the PanelTransition was + -- obtained +enteredModal = \case + Just (_, Modal pnum) -> (pnum ==) . paneNumber @pane + _ -> const False + + +-- | Indicates if the specified Pane (via Type Application) is the one that was +-- modally exited (dismissed) as a result of processing an event (as indicated by +-- PanelTransition). +exitedModal :: forall pane n appev state panes + . PanelOps pane n appev panes state + => PanelTransition -> Panel n appev state panes -> Bool + -- n.b. assumes the Panel passed here is the same panel passed to + -- handleFocusAndPanelEvents for which the PanelTransition was + -- obtained +exitedModal = \case + Just (Modal pnum, _) -> (pnum ==) . paneNumber @pane + _ -> const False + + +-- | When the Panel is managing focus events (e.g. when using +-- 'handleFocusAndPanelEvents'), this function can be called if there +-- has been a situation where the members of the focus ring might need +-- to be updated. This is automatically called at the end of the +-- 'handleFocusAndPanelEvents', but it should be explicitly called +-- once when the Panel is initialized, and it can additionally be +-- called whenever needed in a situation where the +-- 'handleFocusAndPanelEvents' invocation is insufficient (e.g. a +-- separate global action enables a modal pane). +focusRingUpdate :: (Eq n, Ord n) + => Lens' (Panel n appev s panes) (FocusRing n) + -> Panel n appev s panes -> Panel n appev s panes +focusRingUpdate focusL panel = let (p', r) = focusableNames focusL panel + in p' & focusL %~ updRing r + where + updRing :: Eq n => [n] -> FocusRing n -> FocusRing n + updRing nl fcs = + case nl of + [] -> focusRing [] + (n : _) -> + case focusGetCurrent fcs of + Nothing -> + -- no current focus, just use new list + focusSetCurrent n $ focusRing nl + Just e -> + case L.find ((e ==) . head) $ rotations nl of + Just r -> + focusRing r -- new ring with current element still focused + Nothing -> + -- new focus ring doesn't include current focused + -- element, so just use the new list. + focusSetCurrent n $ focusRing nl + + +-- | This returns the focusable Widget names for the focus ring, in the 'Ord' +-- order. It also returns an updated panel, which internally records the input +-- focus ring if a modal is selected). If the previous focus was a modal and the +-- new focus is not modal, this will return that previous focus ring rather than +-- the computed focus ring. +focusableNames :: (Eq n, Ord n) + => Lens' (Panel n appev s panes) (FocusRing n) + -> Panel n appev s panes -> (Panel n appev s panes, [n]) +focusableNames focusL panel = finish $ subFocusable focusL panel panel + where + finish ((prvFcs, pnl), (mdlFcs, regFcs)) = + let reorder = F.toList . Seq.sort + fr = if null mdlFcs + then fromMaybe (reorder regFcs) prvFcs + else reorder mdlFcs + in (pnl, fr) + +subFocusable :: Eq n + => Lens' (Panel n appev s panes) (FocusRing n) + -> Panel n appev s panes -> Panel n appev s rempanes + -> ((Maybe [n], Panel n appev s rempanes), (Seq n, Seq n)) +subFocusable focusL base = \case + i@(Panel {}) -> ((Nothing, i), (mempty, mempty)) + PanelWith pd WhenFocused r -> + let (i', ns) = subFocusable focusL base r + ns' = let pf = focusable r pd + in (fst ns, pf >< snd ns) + in (PanelWith pd WhenFocused <$> i', ns') + PanelWith pd WhenFocusedModal r -> + let (f', pf', i', ns') = goModal focusL base pd Nothing r + pfNew = case pf' of + Nothing -> WhenFocusedModal + Just x -> WhenFocusedModal' x + in ((f', PanelWith pd pfNew i'), ns') + PanelWith pd (WhenFocusedModal' pf) r -> + let (f', pf', i', ns') = goModal focusL base pd (Just pf) r + pfNew = case pf' of + Nothing -> WhenFocusedModal + Just x -> WhenFocusedModal' x + in ((f', PanelWith pd pfNew i'), ns') + PanelWith pd WhenFocusedModalHandlingAllEvents r -> + let (f', pf', i', ns') = goModal focusL base pd Nothing r + pfNew = case pf' of + Nothing -> WhenFocusedModalHandlingAllEvents + Just x -> WhenFocusedModalHandlingAllEvents' x + in ((f', PanelWith pd pfNew i'), ns') + PanelWith pd (WhenFocusedModalHandlingAllEvents' pf) r -> + let (f', pf', i', ns') = goModal focusL base pd (Just pf) r + pfNew = case pf' of + Nothing -> WhenFocusedModalHandlingAllEvents + Just x -> WhenFocusedModalHandlingAllEvents' x + in ((f', PanelWith pd pfNew i'), ns') + PanelWith x y r -> let (i', ns) = subFocusable focusL base r + in (PanelWith x y <$> i', ns) + +goModal :: fullpanel ~ Panel n appev s panes + => rempanel ~ Panel n appev s rempanes + => EventConstraints pane rempanel + => Pane n appev pane + => Eq n + => Lens' fullpanel (FocusRing n) + -> fullpanel + -> PaneState pane appev + -> Maybe (FocusRing n) + -> rempanel + -> (Maybe [n], Maybe (FocusRing n), rempanel, (Seq n, Seq n)) +goModal focusL base pd pf r = + let ((f, i'), ns) = subFocusable focusL base r + fnms = focusable r pd + fpred = not $ Seq.null fnms + ns' = (fnms >< fst ns, snd ns) + f' = if fpred then Nothing else f <|> (focusRingToList <$> pf) + pf' = if fpred then pf <|> Just (base^.focusL) else Nothing + in (f', pf', i', ns') + + + +-- | This returns all shrl instances of the input list. +-- +-- rotations [1,2,3] == [ [1,2,3], [2,3,1], [3,1,2] ] +-- rotations [1,2,3,4] == [ [1,2,3,4], [2,3,4,1], [3,4,1,2], [4,1,2,3] ] +-- rotations [1] == [ [1] ] +-- rotations [] == [] +rotations :: [a] -> [ [a] ] +rotations l = map rotateBy $ [0..length l - 1] + where rotateBy n = uncurry (flip (<>)) $ L.splitAt n l diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,4 @@ +module Main (main) where + +main :: IO () +main = putStrLn "Test suite not yet implemented."