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