{-# LANGUAGE OverloadedStrings #-}

module Ghcitui.Brick.AppConfig
    ( AppConfig (..)
    , defaultConfig
    , loadStartupSplash
    , userConfigDir
    )
where

import Data.Maybe (fromMaybe)
import Data.String (IsString)
import qualified Data.Text as T
import System.Environment (lookupEnv)

import qualified Ghcitui.Brick.SplashTextEmbed as SplashTextEmbed

userConfigDir :: IO FilePath
userConfigDir :: IO FilePath
userConfigDir = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
errorMsg) (Maybe FilePath -> FilePath) -> IO (Maybe FilePath) -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe FilePath)
result
  where
    chooseNonEmpty :: m b -> m b -> m b
chooseNonEmpty m b
accA m b
xA = do
        b
a <- m b
accA
        if b
a b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
forall a. Monoid a => a
mempty
            then m b
xA
            else b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
    errorMsg :: FilePath
errorMsg = FilePath
"Cannot set config location. Neither XDG_CONFIG_HOME nor HOME values were set."
    result :: IO (Maybe FilePath)
result =
        (IO (Maybe FilePath) -> IO (Maybe FilePath) -> IO (Maybe FilePath))
-> IO (Maybe FilePath)
-> [IO (Maybe FilePath)]
-> IO (Maybe FilePath)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            IO (Maybe FilePath) -> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall {m :: * -> *} {b}.
(Monad m, Eq b, Monoid b) =>
m b -> m b -> m b
chooseNonEmpty
            IO (Maybe FilePath)
forall a. Monoid a => a
mempty
            [FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"XDG_CONFIG_HOME", (Maybe FilePath -> Maybe FilePath)
-> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/.config")) (FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"HOME")]

data AppConfig = AppConfig
    { AppConfig -> Text
getInterpreterPrompt :: !T.Text
    -- ^ Prompt to show for the live interpreter.
    , AppConfig -> Bool
getDebugConsoleOnStart :: !Bool
    -- ^ Display the debug console on start up.
    , AppConfig -> FilePath
getDebugLogPath :: !FilePath
    , AppConfig -> Int
getVerbosity :: !Int
    -- ^ Verbosity level.
    , AppConfig -> Maybe FilePath
getStartupSplashPath :: !(Maybe FilePath)
    , AppConfig -> Text
getCmd :: !T.Text
    -- ^ Command to run to initialise the interpreter.
    , AppConfig -> [Text]
getStartupCommands :: ![T.Text]
    -- ^ Commands to run in ghci during start up.
    }
    deriving (Int -> AppConfig -> FilePath -> FilePath
[AppConfig] -> FilePath -> FilePath
AppConfig -> FilePath
(Int -> AppConfig -> FilePath -> FilePath)
-> (AppConfig -> FilePath)
-> ([AppConfig] -> FilePath -> FilePath)
-> Show AppConfig
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> AppConfig -> FilePath -> FilePath
showsPrec :: Int -> AppConfig -> FilePath -> FilePath
$cshow :: AppConfig -> FilePath
show :: AppConfig -> FilePath
$cshowList :: [AppConfig] -> FilePath -> FilePath
showList :: [AppConfig] -> FilePath -> FilePath
Show)

defaultConfig :: AppConfig
defaultConfig :: AppConfig
defaultConfig =
    AppConfig
        { $sel:getInterpreterPrompt:AppConfig :: Text
getInterpreterPrompt = Text
"ghci> "
        , $sel:getDebugConsoleOnStart:AppConfig :: Bool
getDebugConsoleOnStart = Bool
False
        , $sel:getDebugLogPath:AppConfig :: FilePath
getDebugLogPath = FilePath
""
        , $sel:getVerbosity:AppConfig :: Int
getVerbosity = Int
0
        , $sel:getStartupSplashPath:AppConfig :: Maybe FilePath
getStartupSplashPath = Maybe FilePath
forall a. Maybe a
Nothing
        , $sel:getCmd:AppConfig :: Text
getCmd = Text
"cabal v2-repl --repl-options='-fno-it'"
        , $sel:getStartupCommands:AppConfig :: [Text]
getStartupCommands = [Text]
forall a. Monoid a => a
mempty
        }

-- | Return the startup screen splash as an IsString.
loadStartupSplash :: (IsString s) => AppConfig -> IO (Maybe s)
loadStartupSplash :: forall s. IsString s => AppConfig -> IO (Maybe s)
loadStartupSplash AppConfig
_ = Maybe s -> IO (Maybe s)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s -> Maybe s
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
forall a. IsString a => a
SplashTextEmbed.splashText)