Embed splash text directly

This commit is contained in:
CrystalSplitter 2024-01-16 22:50:39 -08:00 committed by Jordan R AW
parent f71e79f72f
commit 14ec8abeed
5 changed files with 24 additions and 16 deletions

View File

@ -1,11 +1,14 @@
{-# LANGUAGE OverloadedStrings #-}
module AppConfig (AppConfig (..), defaultConfig, resolveStartupSplashPath) where
module 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 SplashTextEmbed
userConfigDir :: IO FilePath
userConfigDir = fromMaybe (error errorMsg) <$> result
where
@ -21,9 +24,6 @@ userConfigDir = fromMaybe (error errorMsg) <$> result
mempty
[lookupEnv "XDG_CONFIG_HOME", fmap (fmap (<> "/.config")) (lookupEnv "HOME")]
defaultSplashPath :: IO FilePath
defaultSplashPath = fmap (<> "/ghcitui/assets/splash") userConfigDir
data AppConfig = AppConfig
{ getInterpreterPrompt :: !T.Text
-- ^ Prompt to show for the live interpreter.
@ -51,5 +51,6 @@ defaultConfig =
, getStartupCommands = mempty
}
resolveStartupSplashPath :: AppConfig -> IO FilePath
resolveStartupSplashPath config = maybe defaultSplashPath pure $ getStartupSplashPath config
-- | Return the startup screen splash as an IsString.
loadStartupSplash :: (IsString s) => AppConfig -> IO (Maybe s)
loadStartupSplash _ = pure (pure SplashTextEmbed.splashText)

View File

@ -31,7 +31,7 @@ module AppState
import qualified Brick as B
import qualified Brick.Widgets.Edit as BE
import Control.Error (atMay, fromMaybe)
import Control.Exception (IOException, SomeException, catch, try)
import Control.Exception (IOException, try)
import Control.Monad.IO.Class (MonadIO (..))
import qualified Data.Map.Strict as Map
import Data.Text (Text)
@ -41,7 +41,7 @@ import qualified Data.Vector as Vec
import Lens.Micro ((^.))
import qualified Lens.Micro as Lens
import AppConfig (AppConfig (..), resolveStartupSplashPath)
import AppConfig (AppConfig (..), loadStartupSplash)
import qualified AppInterpState as AIS
import AppTopLevel (AppName (..))
@ -303,12 +303,7 @@ makeInitialState appConfig target cwd = do
Daemon.run (Daemon.startup (T.unpack fullCmd) cwd' startupConfig) >>= \case
Right iState -> pure iState
Left er -> error (show er)
splashContents <-
catch
(Just <$> (T.readFile =<< resolveStartupSplashPath appConfig))
-- The splash is never critical.
-- Just put nothing there if we can't find it.
(const (pure Nothing) :: SomeException -> IO (Maybe T.Text))
splashContents <- loadStartupSplash appConfig
let selectedFile' =
case Loc.moduleFileMapAssocs (Daemon.moduleFileMap interpState) of
-- If we just have one file, select that.
@ -333,7 +328,7 @@ makeInitialState appConfig target cwd = do
, sourceMap = mempty
, _currentWidgetSizes =
WidgetSizes
{ _wsInfoWidth = 30
{ _wsInfoWidth = 35
, _wsReplHeight = 11 -- 10 plus 1 for the entry line.
}
, splashContents

View File

@ -1,6 +1,6 @@
{-# LANGUAGE TemplateHaskell #-}
module HelpText where
module HelpText (helpText) where
import Data.String (IsString)

10
app/SplashTextEmbed.hs Normal file
View File

@ -0,0 +1,10 @@
{-# LANGUAGE TemplateHaskell #-}
module SplashTextEmbed (splashText) where
import Data.String (IsString)
import qualified Data.FileEmbed as FileEmbed
splashText :: (IsString a) => a
splashText = $(FileEmbed.makeRelativeToProject "assets/splash.txt" >>= FileEmbed.embedStringFile)

View File

@ -26,6 +26,7 @@ maintainer: crystal@crystalwobsite.gay
copyright: Jordan R AW
category: Debug
extra-source-files: LICENSE
, assets/splash.txt
, gen/MANUAL.txt
extra-doc-files: CHANGELOG.md
, MANUAL.rst
@ -64,6 +65,7 @@ executable ghcitui
, HelpText
-- Cabal autogen module for package version info.
, Paths_ghcitui
, SplashTextEmbed
autogen-modules: Paths_ghcitui
ghc-options: -rtsopts
-threaded