{-# 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 :: IO Bool getShowHints = do Settings settings <- IO Settings getSettings Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return (Bool -> IO Bool) -> Bool -> IO Bool forall a b. (a -> b) -> a -> b $ Settings settings Settings -> Getting Bool Settings Bool -> Bool forall s a. s -> Getting a s a -> a ^. Getting Bool Settings Bool Lens' Settings Bool hints getShowControls :: IO Bool getShowControls :: IO Bool getShowControls = do Settings settings <- IO Settings getSettings Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return (Bool -> IO Bool) -> Bool -> IO Bool forall a b. (a -> b) -> a -> b $ Settings settings Settings -> Getting Bool Settings Bool -> Bool forall s a. s -> Getting a s a -> a ^. Getting Bool Settings Bool Lens' Settings Bool controls getCaseSensitive :: IO Bool getCaseSensitive :: IO Bool getCaseSensitive = do Settings settings <- IO Settings getSettings Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return (Bool -> IO Bool) -> Bool -> IO Bool forall a b. (a -> b) -> a -> b $ Settings settings Settings -> Getting Bool Settings Bool -> Bool forall s a. s -> Getting a s a -> a ^. Getting Bool Settings Bool Lens' Settings Bool caseSensitive getUseEscapeCode :: IO Bool getUseEscapeCode :: IO Bool getUseEscapeCode = do Settings settings <- IO Settings getSettings Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return (Bool -> IO Bool) -> Bool -> IO Bool forall a b. (a -> b) -> a -> b $ Settings settings Settings -> Getting Bool Settings Bool -> Bool forall s a. s -> Getting a s a -> a ^. Getting Bool Settings Bool Lens' Settings Bool escapeCode getMaxRecents :: IO Int getMaxRecents :: IO Int getMaxRecents = do Settings settings <- IO Settings getSettings Int -> IO Int forall (m :: * -> *) a. Monad m => a -> m a return (Int -> IO Int) -> Int -> IO Int forall a b. (a -> b) -> a -> b $ Settings settings Settings -> Getting Int Settings Int -> Int forall s a. s -> Getting a s a -> a ^. Getting Int Settings Int Lens' Settings Int maxRecents getSettings :: IO Settings getSettings :: IO Settings getSettings = do FilePath sf <- IO FilePath getSettingsFile Bool exists <- FilePath -> IO Bool D.doesFileExist FilePath sf if Bool exists then do Maybe Settings maybeSettings <- FilePath -> Maybe Settings parseSettings (FilePath -> Maybe Settings) -> IO FilePath -> IO (Maybe Settings) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> FilePath -> IO FilePath readFile FilePath sf IO Settings -> (Settings -> IO Settings) -> Maybe Settings -> IO Settings forall b a. b -> (a -> b) -> Maybe a -> b maybe (Settings -> IO Settings forall (m :: * -> *) a. Monad m => a -> m a return Settings defaultSettings) Settings -> IO Settings forall (m :: * -> *) a. Monad m => a -> m a return Maybe Settings maybeSettings else Settings -> IO Settings forall (m :: * -> *) a. Monad m => a -> m a return Settings defaultSettings parseSettings :: String -> Maybe Settings parseSettings :: FilePath -> Maybe Settings parseSettings = FilePath -> Maybe Settings forall a. Read a => FilePath -> Maybe a readMaybe getSettingsFile :: IO FilePath getSettingsFile :: IO FilePath getSettingsFile = do Maybe FilePath maybeSnap <- FilePath -> IO (Maybe FilePath) lookupEnv FilePath "SNAP_USER_DATA" FilePath xdg <- XdgDirectory -> FilePath -> IO FilePath D.getXdgDirectory XdgDirectory D.XdgConfig FilePath "hascard" let dir :: FilePath dir = case Maybe FilePath maybeSnap of Just FilePath path | Bool -> Bool not (FilePath -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null FilePath path) -> FilePath path | Bool otherwise -> FilePath xdg Maybe FilePath Nothing -> FilePath xdg Bool -> FilePath -> IO () D.createDirectoryIfMissing Bool True FilePath dir FilePath -> IO FilePath forall (m :: * -> *) a. Monad m => a -> m a return (FilePath dir FilePath -> FilePath -> FilePath </> FilePath "settings") defaultSettings :: Settings defaultSettings :: Settings defaultSettings = FormState :: Bool -> Bool -> Bool -> Bool -> Int -> Settings FormState { _hints :: Bool _hints=Bool False, _controls :: Bool _controls=Bool True, _caseSensitive :: Bool _caseSensitive=Bool True, _escapeCode :: Bool _escapeCode=Bool False, _maxRecents :: Int _maxRecents=Int 5} setSettings :: Settings -> IO () setSettings :: Settings -> IO () setSettings Settings settings = do FilePath sf <- IO FilePath getSettingsFile FilePath -> FilePath -> IO () writeFile FilePath sf (Settings -> FilePath forall a. Show a => a -> FilePath show Settings settings) settingsState :: IO State settingsState :: IO State settingsState = SS -> State SettingsState (SS -> State) -> (Settings -> SS) -> Settings -> State forall b c a. (b -> c) -> (a -> b) -> a -> c . Settings -> SS forall e. Settings -> Form Settings e Name mkForm (Settings -> State) -> IO Settings -> IO State forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO Settings getSettings mkForm :: Settings -> Form Settings e Name mkForm :: Settings -> Form Settings e Name mkForm = let label :: FilePath -> Widget n -> Widget n label FilePath s Widget n w = Padding -> Widget n -> Widget n forall n. Padding -> Widget n -> Widget n padBottom (Int -> Padding Pad Int 1) (Widget n -> Widget n) -> Widget n -> Widget n forall a b. (a -> b) -> a -> b $ Padding -> Widget n -> Widget n forall n. Padding -> Widget n -> Widget n padRight (Int -> Padding Pad Int 2) (FilePath -> Widget n forall n. FilePath -> Widget n strWrap FilePath s) Widget n -> Widget n -> Widget n forall n. Widget n -> Widget n -> Widget n <+> Widget n w in [Settings -> FormFieldState Settings e Name] -> Settings -> Form Settings e Name forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n newForm [ FilePath -> Widget Name -> Widget Name forall n. FilePath -> Widget n -> Widget n label FilePath "Draw hints using underscores for definition cards" (Widget Name -> Widget Name) -> (Settings -> FormFieldState Settings e Name) -> Settings -> FormFieldState Settings e Name forall n s e. (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n @@= Bool -> Lens' Settings Bool -> Name -> FilePath -> Settings -> FormFieldState Settings e Name forall n s e. (Ord n, Show n) => Bool -> Lens' s Bool -> n -> FilePath -> s -> FormFieldState s e n yesnoField Bool False Lens' Settings Bool hints Name HintsField FilePath "" , FilePath -> Widget Name -> Widget Name forall n. FilePath -> Widget n -> Widget n label FilePath "Show controls at the bottom of screen" (Widget Name -> Widget Name) -> (Settings -> FormFieldState Settings e Name) -> Settings -> FormFieldState Settings e Name forall n s e. (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n @@= Bool -> Lens' Settings Bool -> Name -> FilePath -> Settings -> FormFieldState Settings e Name forall n s e. (Ord n, Show n) => Bool -> Lens' s Bool -> n -> FilePath -> s -> FormFieldState s e n yesnoField Bool False Lens' Settings Bool controls Name ControlsField FilePath "" , FilePath -> Widget Name -> Widget Name forall n. FilePath -> Widget n -> Widget n label FilePath "Open questions are case sensitive" (Widget Name -> Widget Name) -> (Settings -> FormFieldState Settings e Name) -> Settings -> FormFieldState Settings e Name forall n s e. (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n @@= Bool -> Lens' Settings Bool -> Name -> FilePath -> Settings -> FormFieldState Settings e Name forall n s e. (Ord n, Show n) => Bool -> Lens' s Bool -> n -> FilePath -> s -> FormFieldState s e n yesnoField Bool False Lens' Settings Bool caseSensitive Name CaseSensitiveField FilePath "" , FilePath -> Widget Name -> Widget Name forall n. FilePath -> Widget n -> Widget n label FilePath "Use the '-n \\e[5 q' escape code to change the cursor to a blinking line on start" (Widget Name -> Widget Name) -> (Settings -> FormFieldState Settings e Name) -> Settings -> FormFieldState Settings e Name forall n s e. (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n @@= Bool -> Lens' Settings Bool -> Name -> FilePath -> Settings -> FormFieldState Settings e Name forall n s e. (Ord n, Show n) => Bool -> Lens' s Bool -> n -> FilePath -> s -> FormFieldState s e n yesnoField Bool False Lens' Settings Bool escapeCode Name EscapeCodeField FilePath "" , FilePath -> Widget Name -> Widget Name forall n. FilePath -> Widget n -> Widget n label FilePath "Maximum number of recently selected files stored" (Widget Name -> Widget Name) -> (Settings -> FormFieldState Settings e Name) -> Settings -> FormFieldState Settings e Name forall n s e. (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n @@= Int -> Lens' Settings Int -> Name -> FilePath -> Settings -> FormFieldState Settings e Name forall n s e. (Ord n, Show n) => Int -> Lens' s Int -> n -> FilePath -> s -> FormFieldState s e n naturalNumberField Int 999 Lens' Settings Int maxRecents Name MaxRecentsField FilePath "" ]