{-# LANGUAGE OverloadedStrings, RankNTypes, TupleSections #-} module Ham.UI.Brick ( emptyAppState , AppMode(..) , AppState(..) , AppResource , app ) where import Ham.Log import Ham.Data import qualified Ham.CAT as CAT import Ham.CAT.ElecraftKX2 import Ham.CAT.YaesuFT891 import qualified Ham.Internal.FixedSequence as FS import Ham.Internal.FixedSequence (FixedSequence) import Control.Concurrent.MVar import Control.Monad import Control.Monad.IO.Class import Data.Monoid ((<>)) import Data.Time.Clock import Data.Time.Calendar import Data.Time.LocalTime import Data.Time.Format (formatTime, defaultTimeLocale) import qualified Data.Text as T import Data.Text (Text) import Data.Foldable import Data.List (foldl') import qualified Data.Text as Text import qualified Data.Sequence as S import qualified Data.Vector as V import Brick import Brick.Forms import Brick.Widgets.List import Brick.Widgets.Border import Brick.Widgets.Dialog import qualified Brick.Widgets.Edit as E import qualified Brick.Focus as F import qualified Brick.Types as T import Brick.Main import qualified Brick.Widgets.Border.Style import Graphics.Vty.Attributes (defAttr, blue) import Graphics.Vty.Input.Events import qualified Graphics.Vty as V import Lens.Micro -- | Application state for the 'Brick' UI. data AppState = AppState { logState :: LogState, -- ^ State for the Hamlog monad. logConfig :: LogConfig, -- ^ Configuration for the Hamlog monad. qsoList :: List AppResource Qso, -- ^ List of contacts to display qsoForm :: Form Qso HamlogEvent AppResource, -- ^ Form to enter new contacts focusRing :: F.FocusRing AppResource, -- ^ Focus ring to use appMode :: AppMode, -- ^ Current mode of the app selectedQsoIndex :: Int, -- ^ Index of the currently selected contact infoText :: FixedSequence Text, -- ^ Text to display in the info window statusText :: [Text], -- ^ Text to display in the status line duplicateQsos :: S.Seq Duplicate -- ^ Any potential duplicates found. } -- | Default AppState. emptyAppState :: AppState emptyAppState = AppState { logState = emptyLogState, logConfig = defaultConfig, qsoList = list LogList V.empty 1, qsoForm = newForm [] emptyQso, focusRing = lappDefaultFocusRing, appMode = AppModeList, selectedQsoIndex = 0, infoText = FS.emptyFS 10, statusText = [], duplicateQsos = S.Empty } data HamlogEvent -- | Resource type to index widgets data AppResource = LogList | LogInfo | LogQso | LogQsoTimeStart | LogQsoTimeEnd | LogQsoFrequency | LogQsoMode | LogQsoCallsign | LogQsoLocation | LogQsoRST | LogQsoExchange | LogQsoMyCallsign | LogQsoMyLocation | LogQsoSentRST | LogQsoSentExchange | LogQsoNotes deriving (Eq, Ord, Show) -- | Run a 'HamLog' action given the AppState, in the EventM monad. hamLog :: AppState -> HamLog a -> EventM AppResource (a, AppState) hamLog s act = do (a, ls, logtext) <- liftIO $ runHamLog (logConfig s) (logState s) $ act let s' = s { logState = ls, infoText = fs, logConfig = (logConfig s) { _configUseCat = _stateUseCat ls } } -- Turn CAT on or off depending on the state delivered by HamLog. It could be there was an initialization error, in that case we want to turn off the configured CAT use flag. fs = foldr FS.addElement (infoText s) logtext return (a, s') -- | Default focus ring. Empty. lappDefaultFocusRing :: F.FocusRing AppResource lappDefaultFocusRing = F.focusRing [] -- | Focus ring for the QSO edit widget. lappQsoFocusRing :: AppState -> F.FocusRing AppResource lappQsoFocusRing s = formFocus $ qsoForm s -- | Add a new QSO at the beginning of the list and go to edit mode immediately. lappNewQso :: AppState -> EventM AppResource AppState lappNewQso s = do (q, s') <- hamLog s newQsoNow s'' <- lupdateQsoList 0 s' >>= lupdateQsoForm -- Edit the new QSO (at index 0) return $ s'' { appMode = AppModeQso, focusRing = lappQsoFocusRing s'', selectedQsoIndex = 0 } -- | Given a QSO, create a form for editing it. mkQsoForm :: Qso -> QsoDefaults -> Form Qso HamlogEvent AppResource mkQsoForm q q_def = newForm fieldStates q where timeStart = f _qsoDefaultTimeStart $ label "Start:" @@= editShowableField qsoTimeStart LogQsoTimeStart timeEnd = f _qsoDefaultTimeEnd $ label "End:" @@= editShowableField qsoTimeEnd LogQsoTimeEnd f d s = case d q_def of FixedValue _ -> [] DefaultValue _ -> [s] fieldStates = concat [ f _qsoDefaultCallsign $ label "Callsign:" @@= editTextField qsoCallsign LogQsoCallsign (Just 1), f _qsoDefaultLocation $ label "Location:" @@= editTextField qsoLocation LogQsoLocation (Just 1), f _qsoDefaultRST $ label "RST received:" @@= editShowableField qsoRST LogQsoRST, f _qsoDefaultExchange $ label "Exchg recvd:" @@= editTextField qsoExchange LogQsoExchange (Just 1), f _qsoDefaultSentRST $ label "RST sent:" @@= editShowableField qsoSentRST LogQsoSentRST, f _qsoDefaultSentExchange $ label "Exchg sent:" @@= editTextField qsoSentExchange LogQsoSentExchange (Just 1), f _qsoDefaultFrequency $ label "Frequency:" @@= editShowableField qsoFrequency LogQsoFrequency, f _qsoDefaultMode $ label "Mode (CW,PH,FM,RY):" @@= editShowableField qsoMode LogQsoMode, f _qsoDefaultSentCallsign $ label "My callsign:" @@= editTextField qsoSentCallsign LogQsoMyCallsign (Just 1), f _qsoDefaultSentLocation $ label "My location:" @@= editTextField qsoSentLocation LogQsoMyLocation (Just 1), timeStart, timeEnd, f _qsoDefaultNotes $ label "Notes:" @@= editTextField qsoNotes LogQsoNotes Nothing] label s w = -- padBottom (Pad 1) $ (vLimit 1 $ hLimit 20 $ str s <+> fill ' ') <+> w -- | Create a form for editing the currently selected QSO. mkSelectedQsoForm :: AppState -> Form Qso HamlogEvent AppResource mkSelectedQsoForm s = qsoForm where q_def = _configQsoDefaults $ logConfig s qsoForm = mkQsoForm selectedQso q_def selectedQso = maybe emptyQso id $ snd <$> listSelectedElement (qsoList s) -- | Selected QSO. If none is selected, the empty QSO is returned. lselectedQso :: AppState -> Qso lselectedQso s = maybe emptyQso id $ snd <$> listSelectedElement (qsoList s) -- | Drawing function. Draws depending on current AppMode. lappDraw :: AppState -> [Widget AppResource] lappDraw s = case (appMode s) of AppModeQuestion _ dlg _ _ -> [ renderDialog dlg $ str "", mainView ] _ -> [ mainView ] where mainView = ((renderListWidget <=> lappStatusTextWidget s) <+> (qsoWidget <=> lappHelp s <=> appInfoWidget s)) <=> statusWidget renderListWidget = border $ hLimit 30 $ renderList lrenderLogListItem True l l = qsoList s qsoWidget = border $ {-padTop (Pad 0) $-} renderForm $ qsoForm s statusWidget = lappStatusWidget s lappStatusTextWidget :: AppState -> Widget AppResource lappStatusTextWidget s = str t where t = unlines $ map T.unpack $ statusText s -- | Information widget. Shows dupes. appInfoWidget :: AppState -> Widget AppResource appInfoWidget s = info where info = padTop (Pad 1) $ borderWithLabel (str "Info") body body = case (appMode s) of -- AppModeList -> str "" _ -> vLimitPercent 30 $ viewport LogInfo Both $ vBox $ fmap txt (FS.toList $ infoText s) <> toList (fmap f dupes) where dupes = duplicateQsos s dupeToText dupe = T.pack $ show dupe f dupe = if (duplicateBand dupe) && (duplicateMode dupe) then withAttr "dupeWarn" $ txt $ dupeToText dupe else txt $ dupeToText dupe -- | Rendering a list item in the log list. lrenderLogListItem :: Bool -> Qso -> Widget AppResource lrenderLogListItem True q = withAttr ("qsoList" <> "selected") $ str $ lrenderLogListItem_str q lrenderLogListItem False q = withAttr ("qsoList" <> "normal") $ str $ lrenderLogListItem_str q lrenderLogListItem_str :: Qso -> String lrenderLogListItem_str q = time_date ++ " " ++ call ++ " " ++ bd ++ " " ++ mode where time_date = formatTime defaultTimeLocale "%F %R" (_qsoTimeStart q) call = Text.unpack (_qsoCallsign q) bd = show $ band $ _qsoFrequency q mode = show $ _qsoMode q -- | Update the UI list widget with the current log list in the state. lupdateQsoList :: Int -> AppState -> EventM AppResource AppState lupdateQsoList qso_index s = return $ s { qsoList = l } where l = listMoveTo qso_index $ list LogList ll 1 ll = V.fromList $ (foldr (:) [] . _logQsos . _stateLog . logState) s -- | Update the QSO widget with the currently selected QSO in the list. lupdateQsoForm :: AppState -> EventM AppResource AppState lupdateQsoForm s = return $ s { qsoForm = mkSelectedQsoForm s } -- | Handler for AppModeQuestion; this is for asking the user a yes/no question. lhandleEvent_question :: AppState -> BrickEvent AppResource HamlogEvent -> EventM AppResource (Next AppState) lhandleEvent_question s ev = case appMode s of AppModeQuestion prev dlg yes no -> case ev of VtyEvent (EvKey KEnter []) -> do let msel = dialogSelection dlg let s' = s { appMode = prev } case msel of Just sel -> continue =<< if sel then (yes s') else (no s') VtyEvent (EvKey (KChar 'y') []) -> do let s' = s { appMode = prev } continue =<< yes s' VtyEvent (EvKey (KChar 'n') []) -> do let s' = s { appMode = prev } continue =<< no s' VtyEvent (EvKey KEsc []) -> do let s' = s { appMode = prev } continue =<< no s' VtyEvent e -> do dlg' <- handleDialogEvent e dlg let s' = s { appMode = AppModeQuestion prev dlg' yes no } continue s' _ -> continue s _ -> continue s -- | List mode. This is the default, main mode of the application. lhandleEvent_list :: AppState -> BrickEvent AppResource HamlogEvent -> EventM AppResource (Next AppState) lhandleEvent_list s ev = case appMode s of AppModeList -> -- This mode is editing the log list. case ev of VtyEvent (EvKey (KChar 'q') []) -> do (_, s') <- hamLog s writeLog halt s' VtyEvent (EvKey (KChar 'n') []) -> do let updated_qso_defaults = qso_defaults { _qsoDefaultFrequency = case _qsoDefaultFrequency qso_defaults of DefaultValue f -> DefaultValue f a -> a, _qsoDefaultMode = case _qsoDefaultMode qso_defaults of DefaultValue m -> DefaultValue m a -> a } --, _qsoDefaultMode = case _qsoDefaultMode qso_defaults of -- DefaultValue _ -> DefaultValue (_qsoMode f) } qso_defaults = _configQsoDefaults $ logConfig s updated_config = (logConfig s) { _configQsoDefaults = updated_qso_defaults } s' = s { logConfig = updated_config } continue =<< lappNewQso s' VtyEvent (EvKey KBS []) -> do let dlg = dialog (Just "Delete entry?") (Just (1, [("Yes", True), ("No", False)])) 25 s' = s { appMode = AppModeQuestion AppModeList dlg yes no } yes ss = maybe (return ss) (\i -> snd <$> hamLog ss (deleteQso i) >>= lupdateQsoList i >>= lupdateQsoForm >>= \ss' -> lcheckDupes (lselectedQso ss') ss') -- Check for dupes again after deleting an element. mi no = return mi = listSelected $ qsoList s' continue s' VtyEvent (EvKey (KChar 's') []) -> continue $ s { appMode = AppModeSort AppModeList } VtyEvent (EvKey (KChar 'w') []) -> snd <$> hamLog s writeLog >>= continue VtyEvent (EvKey (KChar '\t') []) -> do let mi = listSelected $ qsoList s case mi of Just i -> continue $ s { appMode = AppModeQso, focusRing = lappQsoFocusRing s, selectedQsoIndex = i } Nothing -> continue s VtyEvent e -> do s' <- handleListEvent e (qsoList s) >>= \l -> return (s { qsoList = l }) continue =<< lupdateQsoForm s' _ -> continue s _ -> continue s lhandleEvent_qso :: AppState -> BrickEvent AppResource HamlogEvent -> EventM AppResource (Next AppState) lhandleEvent_qso s ev = case (appMode s) of AppModeQso -> -- This mode is editing the current QSO entry. case ev of VtyEvent (EvKey KUp []) -> do let focusring = lappQsoFocusRing s m_current_focus = F.focusGetCurrent focusring case m_current_focus of Just LogQsoNotes -> handleFormEvent ev (qsoForm s) >>= \f -> continue $ s { qsoForm = f, focusRing = lappQsoFocusRing s } Just _ -> lhandleEvent_qso s (VtyEvent (EvKey KBackTab [])) VtyEvent (EvKey KDown []) -> do let focusring = lappQsoFocusRing s m_current_focus = F.focusGetCurrent focusring case m_current_focus of Just LogQsoNotes -> handleFormEvent ev (qsoForm s) >>= \f -> continue $ s { qsoForm = f, focusRing = lappQsoFocusRing s } --return (s { qsoForm = f }) >>= \ss -> --return (ss { focusRing = lappQsoFocusRing ss }) >>= continue Just _ -> lhandleEvent_qso s (VtyEvent (EvKey (KChar '\t') [])) VtyEvent (EvKey (KChar 'l') [MCtrl]) -> do let f = formState $ qsoForm s let s' = s { statusText = ["[Retrieving...]"] } (name, s') <- hamLog s $ lookupFccName (_qsoCallsign f) continue $ s' { statusText = [name] } VtyEvent (EvKey (KChar 't') [MCtrl]) -> do let f = formState $ qsoForm s s' = s { statusText = ["Time updated"] } i = selectedQsoIndex s' (mf', s'') <- hamLog s' $ do currentUtcTime >>= \t -> updateQso i (f { _qsoTimeStart = t, _qsoTimeEnd = t }) a <- getQsoSeq return (a S.!? i) -- FIXME: I need to update the form entries, not the qso directly. lupdateQsoForm s'' >>= continue -- FIXME: The time is not updated in the form, and then set to the old time when the form is left. VtyEvent (EvKey KEsc []) -> do -- Modify the qso currently under edit and go back to list mode. let f = formState $ qsoForm s i = selectedQsoIndex s -- Also modify the a subset of the configured default values to the ones we set last, if it is not a FixedValue. updated_qso_defaults = qso_defaults { _qsoDefaultFrequency = case _qsoDefaultFrequency qso_defaults of DefaultValue _ -> DefaultValue (_qsoFrequency f) a -> a , _qsoDefaultMode = case _qsoDefaultMode qso_defaults of DefaultValue _ -> DefaultValue (_qsoMode f) } qso_defaults = _configQsoDefaults $ logConfig s updated_config = (logConfig s) { _configQsoDefaults = updated_qso_defaults } -- Check for duplicates using a Qso type object. -- FIXME: Add a level of duplicate: Met on another band, on the same band but different mode, -- met on the same band with the same mode. -- (dupes, s') <- hamLog s $ findDuplicateQsos f s' <- (hamLog s $ updateQso i f) >>= lcheckDupes f . snd -- s'' <- lcheckDupes f s' let s'' = s' { appMode = AppModeList, focusRing = lappDefaultFocusRing, logConfig = updated_config, selectedQsoIndex = -1 } -- FIXME: Do this more efficiently than updating the whole list. continue =<< lupdateQsoList i s'' _ -> do s' <- handleFormEvent ev (qsoForm s) >>= \f -> --return s { qsoForm = f, focusRing = lappQsoFocusRing s } return (s { qsoForm = f }) >>= \ss -> return (ss { focusRing = lappQsoFocusRing ss }) -- NOTE: This is apparently necessary to get the text cursor to show. continue s' _ -> continue s lcheckDupes :: Qso -> AppState -> EventM AppResource AppState lcheckDupes qso s = do (dupes, s') <- hamLog s $ findDuplicateQsos qso return $ s' { duplicateQsos = dupes } data QsoSortKey = QsoSortTime | QsoSortCallsign | QsoSortLocation lsetAppMode :: AppMode -> AppState -> EventM AppResource AppState lsetAppMode m s = return $ s { appMode = m } lhandleEvent_sortQsos :: AppState -> BrickEvent AppResource HamlogEvent -> EventM AppResource (Next AppState) lhandleEvent_sortQsos s ev = case appMode s of AppModeSort prev -> do ms' <- case ev of VtyEvent (EvKey (KChar 't') []) -> snd <$> hamLog s (sortLog _qsoTimeStart) >>= lsetAppMode prev >>= return . Just VtyEvent (EvKey (KChar 'c') []) -> snd <$> hamLog s (sortLog _qsoCallsign) >>= lsetAppMode prev >>= return . Just VtyEvent (EvKey (KChar 'l') []) -> snd <$> hamLog s (sortLog _qsoLocation) >>= lsetAppMode prev >>= return . Just _ -> return Nothing maybe (continue s) (\s' -> lupdateQsoList 0 s' >>= lupdateQsoForm >>= continue) ms' _ -> continue s lappStatusWidget :: AppState -> Widget AppResource lappStatusWidget _ = str $ "(C) Copyright KM6THJ, 2018." -- | Help text, depending on mode. lappHelp :: AppState -> Widget AppResource lappHelp s = help where help = padTop (Pad 1) $ borderWithLabel (str "Help") body body = case (appMode s) of AppModeList -> str $ "- n: New qso Del: Delete qso\n" <> "- Tab: Edit s: Sort Log\n" <> "- w: Write to file q: Quit" AppModeQso -> str $ "- Esc: End edit and accept results\n" <> "- Tab: Cycle entries\n" <> "- Ctrl-l: Lookup name for callsign" AppModeSort _ -> str $ "- t: Sort by time\n" <> "- c: Sort by callsign\n" <> "- l: Sort by location" _ -> str "" -- | Modes for the UI. data AppMode = AppModeList -- ^ Editing the log list. | AppModeQso -- ^ Editing the current QSO entry. | AppModeQuestion { appModeQuestionPrev :: AppMode, appModeQuestionDialog :: Dialog Bool, appModeQuestionYes :: (AppState -> EventM AppResource AppState), appModeQuestionNo :: (AppState -> EventM AppResource AppState) } -- ^ Asking a yes/no question from the user. | AppModeSort { appModeSortPrev :: AppMode } -- | Event handler for the hamlog application. lhandleEvent :: AppState -> BrickEvent AppResource HamlogEvent -> EventM AppResource (Next AppState) lhandleEvent s ev = do case (appMode s) of AppModeList -> lhandleEvent_list s ev AppModeQuestion prev dlg yes no -> lhandleEvent_question s ev AppModeQso -> lhandleEvent_qso s ev AppModeSort prev -> lhandleEvent_sortQsos s ev lappCursor :: AppState -> [T.CursorLocation AppResource] -> Maybe (T.CursorLocation AppResource) lappCursor = F.focusRingCursor focusRing lappStartEvent s = (snd <$> hamLog s readLog) >>= lupdateQsoList 0 >>= lupdateQsoForm -- let l = emptyLogState { _stateLog = emptyLog { _logQsos = S.fromList $ take 100000 $ repeat emptyQso } } -- let s' = s { logState = l } -- lupdateQsoList 0 s' >>= lupdateQsoForm -- | 'App' to use for constructing the 'Brick' UI. app = App { appDraw = lappDraw , appHandleEvent = lhandleEvent , appStartEvent = lappStartEvent , appAttrMap = const $ attrMap defAttr [ (E.editAttr, V.white `on` V.black) , (E.editFocusedAttr, V.black `on` V.yellow) , (invalidFormInputAttr, V.white `on` V.red) , (focusedFormInputAttr, V.black `on` V.yellow) , (attrName "qsoList" <> attrName "selected", V.black `on` V.yellow) , (attrName "qsoList" <> attrName "normal", defAttr) , (attrName "dupeWarn", V.white `on` V.red) , (buttonAttr, V.black `on` V.white) , (buttonSelectedAttr, V.black `on` V.green) ] , appChooseCursor = lappCursor }