{-# 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
"" ]