1{-# LANGUAGE OverloadedStrings, RankNTypes #-} 2module Settings where 3import Brick 4import Brick.Forms 5import UI.BrickHelpers 6import Data.Char (isDigit) 7import States 8import Data.Maybe 9import System.FilePath ((</>)) 10import System.Environment (lookupEnv) 11import Text.Read (readMaybe) 12import Lens.Micro.Platform 13import qualified Data.Text as T 14import qualified Graphics.Vty as V 15import qualified System.Directory as D 16 17getShowHints :: IO Bool 18getShowHints = do 19 settings <- getSettings 20 return $ settings ^. hints 21 22getShowControls :: IO Bool 23getShowControls = do 24 settings <- getSettings 25 return $ settings ^. controls 26 27getUseEscapeCode :: IO Bool 28getUseEscapeCode = do 29 settings <- getSettings 30 return $ settings ^. escapeCode 31 32getMaxRecents :: IO Int 33getMaxRecents = do 34 settings <- getSettings 35 return $ settings ^. maxRecents 36 37getSettings :: IO Settings 38getSettings = do 39 sf <- getSettingsFile 40 exists <- D.doesFileExist sf 41 if exists 42 then do 43 maybeSettings <- parseSettings <$> readFile sf 44 maybe (return defaultSettings) return maybeSettings 45 else return defaultSettings 46 47parseSettings :: String -> Maybe Settings 48parseSettings = readMaybe 49 50getSettingsFile :: IO FilePath 51getSettingsFile = do 52 maybeSnap <- lookupEnv "SNAP_USER_DATA" 53 xdg <- D.getXdgDirectory D.XdgConfig "hascard" 54 55 let dir = case maybeSnap of 56 Just path | not (null path) -> path 57 | otherwise -> xdg 58 Nothing -> xdg 59 D.createDirectoryIfMissing True dir 60 return (dir </> "settings") 61 62defaultSettings :: Settings 63defaultSettings = FormState { _hints=False, _controls=True, _escapeCode=False, _maxRecents=5} 64 65setSettings :: Settings -> IO () 66setSettings settings = do 67 sf <- getSettingsFile 68 writeFile sf (show settings) 69 70settingsState :: IO State 71settingsState = SettingsState . mkForm <$> getSettings 72 73mkForm :: Settings -> Form Settings e Name 74mkForm = 75 let label s w = padBottom (Pad 1) $ padRight (Pad 2) (strWrap s) <+> w 76 77 in newForm 78 [ label "Draw hints using underscores for definition cards" @@= yesnoField hints HintsField "" 79 , label "Show controls at the bottom of screen" @@= yesnoField controls ControlsField "" 80 , label "Use the '-n \\e[5 q' escape code to change the cursor to a blinking line on start" @@= yesnoField escapeCode EscapeCodeField "" 81 , label "Maximum number of recently selected files stored" @@= hLimit 3 @@= naturalNumberField maxRecents MaxRecentsField "" ] 82 83yesnoField :: (Ord n, Show n) => Lens' s Bool -> n -> T.Text -> s -> FormFieldState s e n 84yesnoField stLens name label initialState = 85 let initVal = initialState ^. stLens 86 87 handleEvent (MouseDown n _ _ _) s | n == name = return $ not s 88 handleEvent (VtyEvent (V.EvKey (V.KChar ' ') [])) s = return $ not s 89 handleEvent (VtyEvent (V.EvKey V.KEnter [])) s = return $ not s 90 handleEvent _ s = return s 91 92 in FormFieldState { formFieldState = initVal 93 , formFields = [ FormField name Just True 94 (renderYesno label name) 95 handleEvent ] 96 , formFieldLens = stLens 97 , formFieldRenderHelper = id 98 , formFieldConcat = vBox } 99 100renderYesno :: T.Text -> n -> Bool -> Bool -> Widget n 101renderYesno label n foc val = 102 let addAttr = if foc then withDefAttr focusedFormInputAttr else id 103 in clickable n $ (if val then addAttr (txt "Yes") else addAttr (txt "No") <+> txt " ") <+> txt label 104 105naturalNumberField :: (Ord n, Show n) => Lens' s Int -> n -> T.Text -> s -> FormFieldState s e n 106naturalNumberField stLens name label initialState = 107 let initVal = initialState ^. stLens 108 -- clamp s = 109 110 handleEvent (VtyEvent (V.EvKey (V.KChar c) [])) s | isDigit c = return $ if s < 100 then read (show s ++ [c]) else s 111 handleEvent (VtyEvent (V.EvKey V.KBS [])) s = return $ case show s of 112 "" -> 0 113 xs -> fromMaybe 0 (readMaybe (init xs)) 114 handleEvent _ s = return s 115 116 in FormFieldState { formFieldState = initVal 117 , formFields = [ FormField name Just True 118 (renderNaturalNumber label name) 119 handleEvent ] 120 , formFieldLens = stLens 121 , formFieldRenderHelper = id 122 , formFieldConcat = vBox } 123 124renderNaturalNumber :: T.Text -> n -> Bool -> Int -> Widget n 125renderNaturalNumber label n foc val = 126 let addAttr = if foc then withDefAttr focusedFormInputAttr else id 127 val' = show val 128 csr = if foc then showCursor n (Location (length val',0)) else id 129 in csr (addAttr (str val')) <+> txt label <+> hFill ' ' 130