mirror of
https://github.com/CrystalSplitter/ghcitui.git
synced 2024-09-11 10:55:29 +03:00
Embed splash text directly
This commit is contained in:
parent
f71e79f72f
commit
14ec8abeed
@ -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)
|
||||
|
@ -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
|
||||
|
@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module HelpText where
|
||||
module HelpText (helpText) where
|
||||
|
||||
import Data.String (IsString)
|
||||
|
||||
|
10
app/SplashTextEmbed.hs
Normal file
10
app/SplashTextEmbed.hs
Normal 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)
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user