{-# 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 forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ Settings settings forall s a. s -> Getting a s a -> a ^. Lens' Settings Bool hints getShowControls :: IO Bool getShowControls :: IO Bool getShowControls = do Settings settings <- IO Settings getSettings forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ Settings settings forall s a. s -> Getting a s a -> a ^. Lens' Settings Bool controls getCaseSensitive :: IO Bool getCaseSensitive :: IO Bool getCaseSensitive = do Settings settings <- IO Settings getSettings forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ Settings settings forall s a. s -> Getting a s a -> a ^. Lens' Settings Bool caseSensitive getShuffleAnswers :: IO Bool getShuffleAnswers :: IO Bool getShuffleAnswers = do Settings settings <- IO Settings getSettings forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ Settings settings forall s a. s -> Getting a s a -> a ^. Lens' Settings Bool shuffleAnswers getUseEscapeCode :: IO Bool getUseEscapeCode :: IO Bool getUseEscapeCode = do Settings settings <- IO Settings getSettings forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ Settings settings forall s a. s -> Getting a s a -> a ^. Lens' Settings Bool escapeCode getMaxRecents :: IO Int getMaxRecents :: IO Int getMaxRecents = do Settings settings <- IO Settings getSettings forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ Settings settings forall s a. s -> Getting a s a -> a ^. 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> FilePath -> IO FilePath readFile FilePath sf forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall (m :: * -> *) a. Monad m => a -> m a return Settings defaultSettings) forall (m :: * -> *) a. Monad m => a -> m a return Maybe Settings maybeSettings else forall (m :: * -> *) a. Monad m => a -> m a return Settings defaultSettings parseSettings :: String -> Maybe Settings parseSettings :: FilePath -> Maybe Settings parseSettings = 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 (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 forall (m :: * -> *) a. Monad m => a -> m a return (FilePath dir FilePath -> FilePath -> FilePath </> FilePath "settings") defaultSettings :: Settings defaultSettings :: Settings defaultSettings = FormState { _hints :: Bool _hints=Bool False, _controls :: Bool _controls=Bool True, _caseSensitive :: Bool _caseSensitive=Bool True, _shuffleAnswers :: Bool _shuffleAnswers=Bool False, _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 (forall a. Show a => a -> FilePath show Settings settings) settingsState :: IO State settingsState :: IO State settingsState = SS -> State SettingsState forall b c a. (b -> c) -> (a -> b) -> a -> c . forall e. Settings -> Form Settings e Name mkForm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO Settings getSettings mkForm :: Settings -> Form Settings e Name mkForm :: forall e. Settings -> Form Settings e Name mkForm = let label :: FilePath -> Widget n -> Widget n label FilePath s Widget n w = forall n. Padding -> Widget n -> Widget n padBottom (Int -> Padding Pad Int 1) forall a b. (a -> b) -> a -> b $ forall n. Padding -> Widget n -> Widget n padRight (Int -> Padding Pad Int 2) (forall n. FilePath -> Widget n strWrap FilePath s) forall n. Widget n -> Widget n -> Widget n <+> Widget n w in forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n newForm [ forall {n}. FilePath -> Widget n -> Widget n label FilePath "Draw hints using underscores for definition cards" forall n s e. (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n @@= 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 "" , forall {n}. FilePath -> Widget n -> Widget n label FilePath "Show controls at the bottom of screen" forall n s e. (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n @@= 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 "" , forall {n}. FilePath -> Widget n -> Widget n label FilePath "Open questions are case sensitive" forall n s e. (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n @@= 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 "" , forall {n}. FilePath -> Widget n -> Widget n label FilePath "Shuffle answers to multiple choice questions" forall n s e. (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n @@= 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 shuffleAnswers Name ShuffleAnswersField FilePath "" , 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" forall n s e. (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n @@= 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 "" , forall {n}. FilePath -> Widget n -> Widget n label FilePath "Maximum number of recently selected files stored" forall n s e. (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n @@= 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 "" ]