{-# LANGUAGE OverloadedStrings, RankNTypes #-}
module Settings where
import Brick
import Brick.Forms
import UI.BrickHelpers
import Data.Char (isDigit)
import States
import Data.Maybe
import System.FilePath ((</>))
import System.Environment (lookupEnv)
import Text.Read (readMaybe)
import Lens.Micro.Platform
import qualified Data.Text as T
import qualified Graphics.Vty as V
import qualified System.Directory as D
getShowHints :: IO Bool
getShowHints = do
settings <- getSettings
return $ settings ^. hints
getShowControls :: IO Bool
getShowControls = do
settings <- getSettings
return $ settings ^. controls
getUseEscapeCode :: IO Bool
getUseEscapeCode = do
settings <- getSettings
return $ settings ^. escapeCode
getMaxRecents :: IO Int
getMaxRecents = do
settings <- getSettings
return $ settings ^. maxRecents
getSettings :: IO Settings
getSettings = do
sf <- getSettingsFile
exists <- D.doesFileExist sf
if exists
then do
maybeSettings <- parseSettings <$> readFile sf
maybe (return defaultSettings) return maybeSettings
else return defaultSettings
parseSettings :: String -> Maybe Settings
parseSettings = readMaybe
getSettingsFile :: IO FilePath
getSettingsFile = do
maybeSnap <- lookupEnv "SNAP_USER_DATA"
xdg <- D.getXdgDirectory D.XdgConfig "hascard"
let dir = case maybeSnap of
Just path | not (null path) -> path
| otherwise -> xdg
Nothing -> xdg
D.createDirectoryIfMissing True dir
return (dir </> "settings")
defaultSettings :: Settings
defaultSettings = FormState { _hints=False, _controls=True, _escapeCode=False, _maxRecents=5}
setSettings :: Settings -> IO ()
setSettings settings = do
sf <- getSettingsFile
writeFile sf (show settings)
settingsState :: IO State
settingsState = SettingsState . mkForm <$> getSettings
mkForm :: Settings -> Form Settings e Name
mkForm =
let label s w = padBottom (Pad 1) $ padRight (Pad 2) (strWrap s) <+> w
in newForm
[ label "Draw hints using underscores for definition cards" @@= yesnoField hints HintsField ""
, label "Show controls at the bottom of screen" @@= yesnoField controls ControlsField ""
, label "Use the '-n \\e[5 q' escape code to change the cursor to a blinking line on start" @@= yesnoField escapeCode EscapeCodeField ""
, label "Maximum number of recently selected files stored" @@= hLimit 3 @@= naturalNumberField maxRecents MaxRecentsField "" ]
yesnoField :: (Ord n, Show n) => Lens' s Bool -> n -> T.Text -> s -> FormFieldState s e n
yesnoField stLens name label initialState =
let initVal = initialState ^. stLens
handleEvent (MouseDown n _ _ _) s | n == name = return $ not s
handleEvent (VtyEvent (V.EvKey (V.KChar ' ') [])) s = return $ not s
handleEvent (VtyEvent (V.EvKey V.KEnter [])) s = return $ not s
handleEvent _ s = return s
in FormFieldState { formFieldState = initVal
, formFields = [ FormField name Just True
(renderYesno label name)
handleEvent ]
, formFieldLens = stLens
, formFieldRenderHelper = id
, formFieldConcat = vBox }
renderYesno :: T.Text -> n -> Bool -> Bool -> Widget n
renderYesno label n foc val =
let addAttr = if foc then withDefAttr focusedFormInputAttr else id
in clickable n $ (if val then addAttr (txt "Yes") else addAttr (txt "No") <+> txt " ") <+> txt label
naturalNumberField :: (Ord n, Show n) => Lens' s Int -> n -> T.Text -> s -> FormFieldState s e n
naturalNumberField stLens name label initialState =
let initVal = initialState ^. stLens
handleEvent (VtyEvent (V.EvKey (V.KChar c) [])) s | isDigit c = return $ if s < 100 then read (show s ++ [c]) else s
handleEvent (VtyEvent (V.EvKey V.KBS [])) s = return $ case show s of
"" -> 0
xs -> fromMaybe 0 (readMaybe (init xs))
handleEvent _ s = return s
in FormFieldState { formFieldState = initVal
, formFields = [ FormField name Just True
(renderNaturalNumber label name)
handleEvent ]
, formFieldLens = stLens
, formFieldRenderHelper = id
, formFieldConcat = vBox }
renderNaturalNumber :: T.Text -> n -> Bool -> Int -> Widget n
renderNaturalNumber label n foc val =
let addAttr = if foc then withDefAttr focusedFormInputAttr else id
val' = show val
csr = if foc then showCursor n (Location (length val',0)) else id
in csr (addAttr (str val')) <+> txt label <+> hFill ' '