module Hydra.TUI.Config where

import Hydra.Prelude

import Control.Exception (IOException)
import Data.Text qualified as T
import System.Directory (XdgDirectory (..), createDirectoryIfMissing, getXdgDirectory)
import System.FilePath (takeDirectory, (</>))

data Theme = DarkTheme | LightTheme
  deriving stock (Theme -> Theme -> Bool
(Theme -> Theme -> Bool) -> (Theme -> Theme -> Bool) -> Eq Theme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Theme -> Theme -> Bool
== :: Theme -> Theme -> Bool
$c/= :: Theme -> Theme -> Bool
/= :: Theme -> Theme -> Bool
Eq, Int -> Theme -> ShowS
[Theme] -> ShowS
Theme -> String
(Int -> Theme -> ShowS)
-> (Theme -> String) -> ([Theme] -> ShowS) -> Show Theme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Theme -> ShowS
showsPrec :: Int -> Theme -> ShowS
$cshow :: Theme -> String
show :: Theme -> String
$cshowList :: [Theme] -> ShowS
showList :: [Theme] -> ShowS
Show)

newtype TuiConfig = TuiConfig
  { TuiConfig -> Theme
theme :: Theme
  }
  deriving stock (TuiConfig -> TuiConfig -> Bool
(TuiConfig -> TuiConfig -> Bool)
-> (TuiConfig -> TuiConfig -> Bool) -> Eq TuiConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TuiConfig -> TuiConfig -> Bool
== :: TuiConfig -> TuiConfig -> Bool
$c/= :: TuiConfig -> TuiConfig -> Bool
/= :: TuiConfig -> TuiConfig -> Bool
Eq, Int -> TuiConfig -> ShowS
[TuiConfig] -> ShowS
TuiConfig -> String
(Int -> TuiConfig -> ShowS)
-> (TuiConfig -> String)
-> ([TuiConfig] -> ShowS)
-> Show TuiConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TuiConfig -> ShowS
showsPrec :: Int -> TuiConfig -> ShowS
$cshow :: TuiConfig -> String
show :: TuiConfig -> String
$cshowList :: [TuiConfig] -> ShowS
showList :: [TuiConfig] -> ShowS
Show)

-- | Default config used when no file is present or parsing fails.
defaultConfig :: TuiConfig
defaultConfig :: TuiConfig
defaultConfig = TuiConfig{theme :: Theme
theme = Theme
DarkTheme}

-- | Flip between dark and light themes.
toggleTheme :: Theme -> Theme
toggleTheme :: Theme -> Theme
toggleTheme Theme
DarkTheme = Theme
LightTheme
toggleTheme Theme
LightTheme = Theme
DarkTheme

-- | Path to the persisted config: @$XDG_CONFIG_HOME/hydra/tui-config.yaml@.
configFilePath :: IO FilePath
configFilePath :: IO String
configFilePath = do
  String
xdgConfig <- XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
"hydra"
  String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
xdgConfig String -> ShowS
</> String
"tui-config.yaml"

-- | Load config from disk, falling back to 'defaultConfig' on missing or
-- unreadable files.
readConfig :: IO TuiConfig
readConfig :: IO TuiConfig
readConfig = do
  String
path <- IO String
configFilePath
  Either IOException ByteString
result <- IO ByteString -> IO (Either IOException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
readFileBS String
path)
  TuiConfig -> IO TuiConfig
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TuiConfig -> IO TuiConfig) -> TuiConfig -> IO TuiConfig
forall a b. (a -> b) -> a -> b
$ case Either IOException ByteString
result of
    Left (IOException
_ :: IOException) -> TuiConfig
defaultConfig
    Right ByteString
bytes -> Text -> TuiConfig
parseConfig (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
bytes)

-- | Persist the config to disk, creating the directory if necessary. Silently
-- swallows IO errors so an unwritable config path never crashes the TUI.
writeConfig :: TuiConfig -> IO ()
writeConfig :: TuiConfig -> IO ()
writeConfig TuiConfig
cfg = do
  String
path <- IO String
configFilePath
  Either IOException ()
result <- IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ do
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (ShowS
takeDirectory String
path)
    String -> Text -> IO ()
forall (m :: * -> *). MonadIO m => String -> Text -> m ()
writeFileText String
path (TuiConfig -> Text
encodeConfig TuiConfig
cfg)
  case Either IOException ()
result of
    Left (IOException
_ :: IOException) -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Right () -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- ---------------------------------------------------------------------------
-- Internal YAML helpers
-- ---------------------------------------------------------------------------

-- | Parse the on-disk config text. Unrecognised content falls back to 'defaultConfig'.
parseConfig :: Text -> TuiConfig
parseConfig :: Text -> TuiConfig
parseConfig Text
content =
  TuiConfig{theme :: Theme
theme = Theme -> Maybe Theme -> Theme
forall a. a -> Maybe a -> a
fromMaybe (TuiConfig -> Theme
theme TuiConfig
defaultConfig) Maybe Theme
parsedTheme}
 where
  parsedTheme :: Maybe Theme
parsedTheme =
    [Theme] -> Maybe Theme
forall a. [a] -> Maybe a
listToMaybe
      [ Text -> Theme
themeFromText Text
v
      | Text
line <- Text -> [Text]
T.lines Text
content
      , Just Text
rest <- [Text -> Text -> Maybe Text
T.stripPrefix Text
"theme: " Text
line]
      , let v :: Text
v = Text -> Text
T.strip Text
rest
      ]

  themeFromText :: Text -> Theme
  themeFromText :: Text -> Theme
themeFromText Text
"light" = Theme
LightTheme
  themeFromText Text
_ = Theme
DarkTheme

-- | Serialise the config to its on-disk text form.
encodeConfig :: TuiConfig -> Text
encodeConfig :: TuiConfig -> Text
encodeConfig TuiConfig{Theme
theme :: TuiConfig -> Theme
theme :: Theme
theme} =
  Text
"theme: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Theme -> Text
themeToText Theme
theme Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
 where
  themeToText :: Theme -> Text
  themeToText :: Theme -> Text
themeToText Theme
DarkTheme = Text
"dark"
  themeToText Theme
LightTheme = Text
"light"