{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} module Panes.NoteInput ( NoteInputPane , initNoteInput , isNoteInputActive , noteInputResults ) where import Brick hiding ( Location ) import Brick.Focus import Brick.Forms import Brick.Panes import qualified Brick.Widgets.Center as C import Control.Lens import Control.Monad.IO.Class ( MonadIO, liftIO ) import Data.Maybe ( isJust ) import qualified Data.Sequence as Seq import Data.Text ( Text ) import qualified Data.Text as T import Data.Time.Calendar ( Day ) import Data.Time.Clock ( getCurrentTime, utctDay ) import qualified Graphics.Vty as Vty import Defs import Panes.Common.Inputs import Panes.Common.Attrs data NoteInputPane data NewNote = NewNote { _nnText :: Text , _nnDay :: Day } makeLenses ''NewNote blankNewNote :: NewNote blankNewNote = NewNote "" (toEnum 0) type NoteForm = Form NewNote MyWorkEvent WName instance Pane WName MyWorkEvent NoteInputPane where data (PaneState NoteInputPane MyWorkEvent) = NN { nNF :: Maybe NoteForm -- Just == pane active , nNote :: Maybe Note -- reset to Nothing when -- nNF transitions Nothing -- to Just -- KWQ , nProj :: Text , nOrig :: Maybe Note , nErr :: Maybe Text } type (EventType NoteInputPane WName MyWorkEvent) = BrickEvent WName MyWorkEvent initPaneState _ = NN Nothing Nothing Nothing Nothing drawPane ps _gs = C.centerLayer . modalB ((maybe "New" (const "Edit") $ nOrig ps) -- <> " " <> show (nProj ps) <> " Note") . vLimit 25 . hLimitPercent 65 . (\f -> vBox [ renderForm f , padBottom (Pad 1) $ withAttr a'Error $ maybe emptyWidget txt (nErr ps) , emptyWidget , vLimit 1 (fill ' ' <+> str "Ctrl-D = accept" <+> fill ' ' <+> str "ESC = abort" <+> fill ' ') ]) <$> nNF ps focusable _ ps = case nNF ps of Nothing -> mempty Just f -> Seq.fromList $ focusRingToList $ formFocus f handlePaneEvent _ = \case VtyEvent (Vty.EvKey Vty.KEsc []) -> nNFL %%~ const (return Nothing) VtyEvent (Vty.EvKey (Vty.KChar 'd') [Vty.MCtrl]) -> \s -> let pf = s ^. nNFL np form = Note { note = form ^. nnText , notedOn = form ^. nnDay , noteCore = NoteRT { noteSource = MyWorkDB } } in if maybe False allFieldsValid pf then return $ s & nNFL .~ Nothing & newNote .~ (np . formState <$> pf) else let badflds = maybe "none" (foldr (\n a -> if T.null a then T.pack n else T.pack n <> ", " <> a) "" . fmap show . invalidFields) pf errmsg = "Correct invalid entries before accepting: " in return $ s { nErr = Just $ errmsg <> badflds } ev -> \s -> validateForm $ s { nErr = Nothing } & (nNFL . _Just %%~ \w -> nestEventM' w (handleFormEvent ev)) nNFL :: Lens' (PaneState NoteInputPane MyWorkEvent) (Maybe NoteForm) nNFL f s = (\n -> s { nNF = n }) <$> f (nNF s) isNoteInputActive :: PaneState NoteInputPane MyWorkEvent -> Bool isNoteInputActive = isJust . nNF newNote :: Lens' (PaneState NoteInputPane MyWorkEvent) (Maybe Note) newNote f s = (\n -> s { nNote = n }) <$> f (nNote s) -- | Returns the original note name (if any) and the new Note -- specification. noteInputResults :: PaneState NoteInputPane MyWorkEvent -> (Maybe NoteTitle, Maybe Note) noteInputResults ps = (noteTitle <$> nOrig ps, nNote ps) -- KWQ: remove!? validateForm :: EventM WName es (PaneState NoteInputPane MyWorkEvent) -> EventM WName es (PaneState NoteInputPane MyWorkEvent) validateForm inner = do s <- inner case s ^. nNFL of Nothing -> return s Just _f -> return s initNoteInput :: MonadIO m => [Note] -> Maybe Note -> PaneState NoteInputPane MyWorkEvent -> m (PaneState NoteInputPane MyWorkEvent) initNoteInput curNotes mbNote ps = do now <- utctDay <$> liftIO getCurrentTime case nNF ps of Just _ -> return ps Nothing -> let label s = padBottom (Pad 1) . label' s label' s w = (vLimit 1 $ hLimit labelWidth $ fill ' ' <+> str s <+> str ": ") <+> w labelWidth = 15 nlForm = newForm [ label "Note" @@= let validate = \case [] -> Nothing [""] -> Nothing o -> let nt = noteTitle' $ T.unlines o in if (nt `elem` (noteTitle <$> curNotes) && (maybe True ((nt /=) . noteTitle) mbNote)) then Nothing -- invalid else Just $ T.intercalate "\n" o in editField nnText (WName "New Note") Nothing -- (Just 20) id validate (txt . T.intercalate "\n") id , label "Date" @@= let validate = \case ("":_) -> Nothing (l:_) -> textToDay l _ -> Nothing dayInit = T.pack . show dayRender = txt . headText in editField nnDay (WName "Note Date (Y-M-D)") (Just 1) dayInit validate dayRender id ] (case mbNote of Nothing -> blankNewNote { _nnDay = now } Just l -> NewNote { _nnText = l ^. noteL , _nnDay = l ^. notedOnL } ) in return $ NN { nNF = Just nlForm -- , nProj = projName , nNote = Nothing , nOrig = mbNote , nErr = Nothing }