Add feature to open a note with Enter key

Author: cblp

ff-brick/Main.hs

@@ -3,20 +3,19 @@
 {-# LANGUAGE OverloadedLabels #-}
 
 import Brick (
-    App (App),
     AttrMap,
     AttrName,
-    BrickEvent (VtyEvent),
-    EventM,
     VScrollBarOrientation (OnRight),
-    Widget,
+    ViewportType (Both),
     attrMap,
     attrName,
     defaultMain,
+    hBox,
     halt,
     neverShowCursor,
     on,
     str,
+    viewport,
     withAttr,
     withVScrollBars,
     zoom,
@@ -30,15 +29,24 @@ import Brick.Widgets.List (
     handleListEvent,
     list,
     listSelectedAttr,
+    listSelectedElementL,
     listSelectedFocusedAttr,
     renderList,
  )
 import Control.Monad (void)
+import Data.Foldable (toList)
 import Data.Function ((&))
 import Data.Generics.Labels ()
 import Data.Vector qualified as Vector
 import GHC.Generics (Generic)
-import Graphics.Vty (Event (EvKey), Key (KEsc), black, defAttr, white)
+import Graphics.Vty (
+    Event (EvKey),
+    Key (KChar, KEnter, KEsc),
+    black,
+    defAttr,
+    white,
+ )
+import Lens.Micro.Mtl (preuse, (.=))
 import RON.Storage.FS (runStorage)
 import RON.Storage.FS qualified as StorageFS
 
@@ -47,17 +55,40 @@ import FF.Config (loadConfig)
 import FF.Types (Entity (Entity), EntityDoc, Note (Note))
 import FF.Types qualified
 
-newtype Model = Model {notes :: List () (EntityDoc Note)} deriving (Generic)
+-- | Brick widget names
+data WN
+    = NoteList
+    | OpenNoteViewport
+    deriving (Eq, Ord, Show)
+
+data Model = Model
+    { notes :: List WN (EntityDoc Note)
+    -- ^ all notes
+    , openNoteM :: Maybe (EntityDoc Note)
+    -- ^ currently opened note
+    }
+    deriving (Generic)
+
+type Widget = Brick.Widget WN
+
+type App = Brick.App Model () WN
+
+type EventM = Brick.EventM WN Model
+
+type BrickEvent = Brick.BrickEvent WN ()
 
 main :: IO ()
 main = do
     cfg <- loadConfig
-    dataDir <- getDataDir cfg
-    handleM <- traverse StorageFS.newHandle dataDir
+    dataDirM <- getDataDir cfg
+    handleM <- traverse StorageFS.newHandle dataDirM
     handle <- handleM `orElse` fail noDataDirectoryMessage
     notes <- runStorage handle loadAllNotes
     let initialModel =
-            Model{notes = list () (Vector.fromList notes) listItemHeight}
+            Model
+                { notes = list NoteList (Vector.fromList notes) listItemHeight
+                , openNoteM = Nothing
+                }
     void $ defaultMain app initialModel
 
 listItemHeight :: Int
@@ -66,9 +97,9 @@ listItemHeight = 1
 orElse :: (Applicative m) => Maybe a -> m a -> m a
 orElse m n = maybe n pure m
 
-app :: App Model () ()
+app :: App
 app =
-    App
+    Brick.App
         { appAttrMap = const appAttrMap
         , appChooseCursor = neverShowCursor
         , appDraw
@@ -85,33 +116,57 @@ appAttrMap =
         , (highlightAttr, black `on` white)
         ]
 
-appDraw :: Model -> [Widget ()]
-appDraw Model{notes} =
-    [ borderWithLabel
-        (str "Agenda")
-        (renderList renderListItem True notes & withVScrollBars OnRight)
-        <=> (withAttr highlightAttr (str "Esc") <+> str " exit")
-    ]
+appDraw :: Model -> [Widget]
+appDraw Model{notes, openNoteM} = [mainWidget <=> keysHelpLine]
+  where
+    mainWidget = hBox $ agenda : toList openNoteWidget
+
+    agenda =
+        borderWithLabel
+            (str "Agenda")
+            (renderList renderListItem True notes & withVScrollBars OnRight)
+
+    openNoteWidget = do
+        Entity{entityVal = note@Note{note_text}} <- openNoteM
+        let title = noteTitle note
+            text = fromRgaM note_text
+        pure $
+            borderWithLabel (str title) $
+                viewport OpenNoteViewport Both $
+                    str text
+
+    keysHelpLine =
+        withAttr highlightAttr (str "Esc")
+            <+> str " "
+            <+> withAttr highlightAttr (str "q")
+            <+> str " exit  "
+            <+> withAttr highlightAttr (str "Enter")
+            <+> str " open"
 
 highlightAttr :: AttrName
 highlightAttr = attrName "highlight"
 
-appHandleEvent :: BrickEvent () () -> EventM () Model ()
+appHandleEvent :: BrickEvent -> EventM ()
 appHandleEvent = \case
-    VtyEvent e -> appHandleVtyEvent e
+    Brick.VtyEvent e -> appHandleVtyEvent e
     _ -> pure ()
 
-appHandleVtyEvent :: Event -> EventM () Model ()
+appHandleVtyEvent :: Event -> EventM ()
 appHandleVtyEvent = \case
-    EvKey KEsc _ -> halt
+    EvKey KEsc [] -> halt
+    EvKey (KChar 'q') [] -> halt
+    EvKey KEnter [] -> do
+        -- open selected note
+        selectedNoteM <- preuse $ #notes . listSelectedElementL
+        #openNoteM .= selectedNoteM
     e -> zoom #notes $ handleListEvent e
 
-renderListItem :: Bool -> EntityDoc Note -> Widget ()
-renderListItem _isSelected Entity{entityVal = Note{note_text}} =
-    str
-        case textLines of
-            [] -> "..."
-            [singleLine] -> singleLine
-            firstLine : _ -> firstLine <> "..."
-  where
-    textLines = filter (not . null) $ lines $ fromRgaM note_text
+renderListItem :: Bool -> EntityDoc Note -> Widget
+renderListItem _isSelected Entity{entityVal} = str $ noteTitle entityVal
+
+noteTitle :: Note -> String
+noteTitle Note{note_text} =
+    case filter (not . null) $ lines $ fromRgaM note_text of
+        [] -> "..."
+        [singleLine] -> singleLine
+        firstLine : _ -> firstLine <> "..."

ff-brick/ff-brick.cabal

@@ -9,6 +9,7 @@ executable ff-brick
     base,
     brick,
     generic-lens,
+    microlens-mtl,
     ron-storage,
     vector,
     vty,