Widgets.hs

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}

module Ready.Habits.UI.Widgets
  (
    validationButtonsField
  ) where

import Data.Monoid
import Graphics.Vty -- EvKey, KChar
import Lens.Micro (Lens', (^.))
import Lens.Micro.TH
import qualified Data.Text as T
import Brick
import Brick.Focus
import Brick.Forms ( Form, FormFieldState(..), FormField(..), focusedFormInputAttr)
import qualified Brick.Widgets.Border as B

-- | A form field for selecting a single choice from a set of possible
-- choices. Each choice has an associated value and text label.
--
-- This field responds to `Enter` keypresses to select a button
-- choice and to mouse clicks.
validationButtonsField :: (Ord n, Show n, Eq a)
           => Lens' s a
           -- ^ The state lens for this value.
           -> [(a, n, T.Text, AttrName)]
           -- ^ The available choices, in order. Each choice has a value
           -- of type @a@, a resource name, a text label, and a style.
           -> s
           -- ^ The initial form state.
           -> FormFieldState s e n
validationButtonsField stLens choices initialState =
    let initVal = initialState ^. stLens

        lookupChoiceValue n =
            let results = filter (\(_, n', _, _) -> n' == n) choices
            in case results of
               [(val, _, _, _)] -> Just val
               _                -> Nothing

        handleEvent _ (MouseDown n _ _ _) s =
            case lookupChoiceValue n of
                Nothing -> return s
                Just v  -> return v
        handleEvent val (VtyEvent (EvKey KEnter [])) _ = return val
        handleEvent _ _ s = return s

        buttonFields = mkButtonField <$> choices
        mkButtonField (val, bname, label, style) =
          FormField { formFieldName = bname
                    , formFieldValidate = Just
                    , formFieldExternallyValid = True
                    , formFieldRender = renderValidationButton val bname label style
                    , formFieldHandleEvent = handleEvent val
                    }
    in FormFieldState { formFieldState        = initVal
                      , formFields            = buttonFields
                      , formFieldLens         = stLens
                      , formFieldRenderHelper = id
                      }

renderValidationButton :: (Eq a) => a -> n -> T.Text -> AttrName -> Bool -> a -> Widget n
renderValidationButton val name label style foc _ =
    let addFocusAttr = if foc
                       then withDefAttr focusedFormInputAttr
                       else id
    in clickable name $
       withDefAttr style $
       addFocusAttr $
       B.border $
       txt $ " " <> label <> " "