hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

lol

Browse Source
This commit is contained in:
Julian Ospald 2022-12-06 23:19:05 +08:00
parent fff2599c2c
commit 7fd27cd635
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
1 changed files with 11 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
app/ghcup/AnsiMain.hs
View File

@ -20,29 +20,24 @@ import GHCup.Types.Optics ( getDirs )
import GHCup.Utils import GHCup.Utils
import Data.List (sort, intersperse) import Data.List (sort, intersperse)
import Data.Versions (prettyPVP) import Data.Versions (prettyPVP, prettyVer)
import Data.Maybe (catMaybes)
import Codec.Archive import Codec.Archive
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Trans.Except
-- import System.Console.ANSI -- import System.Console.ANSI
import System.Console.ANSI import System.Console.ANSI
import System.Console.ANSI.Codes
import System.Console.ANSI.Types
import Terminal.Game import Terminal.Game
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad ( join, when, void, forM_ ) import Control.Monad ( when, forM_ )
import Control.Monad.ST import Control.Monad.ST
import Control.Monad.Reader ( ReaderT(runReaderT), MonadReader, ask, lift ) import Control.Monad.Reader ( ReaderT(runReaderT), MonadReader, ask, lift )
import Control.Monad.Trans.Except import Control.Monad.Trans.Except
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Data.Functor import Data.Functor
import Data.Bifunctor
import Data.STRef import Data.STRef
import Data.IORef import Data.IORef
import Data.Maybe ( fromMaybe ) import Data.Maybe ( fromMaybe, catMaybes )
import qualified Data.Text as Tx import qualified Data.Text as Tx
import qualified Data.Tuple as T import qualified Data.Tuple as T
import qualified Data.Vector as V import qualified Data.Vector as V
@ -50,7 +45,6 @@ import GHC.IO ( unsafePerformIO )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import System.Exit import System.Exit
import System.Environment (getExecutablePath) import System.Environment (getExecutablePath)
import Data.Versions (prettyVer)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as B import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy as L import qualified Data.Text.Lazy as L
@ -118,6 +112,7 @@ ansiMain s = do
Nothing Nothing
sizeCheck
void $ startGame g void $ startGame g
cleanAndExit cleanAndExit
Left e -> do Left e -> do
@ -136,7 +131,7 @@ ghcupGame bs = Game 13
bs -- ticks per second bs -- ticks per second
(\ge s e -> logicFun ge s e) -- logic function (\ge s e -> logicFun ge s e) -- logic function
(\r s -> centerFull r $ drawFun s r) -- draw function (\r s -> centerFull r $ drawFun s r) -- draw function
(\bs -> appQuit bs || appRestart bs) -- quit function (\s -> appQuit s || appRestart s) -- quit function
drawFun :: BrickState -> GEnv -> Plane drawFun :: BrickState -> GEnv -> Plane
@ -176,9 +171,9 @@ drawFun (BrickState {..}) GEnv{..} =
. intersperse (stringPlane " ") . intersperse (stringPlane " ")
. fmap stringPlane . fmap stringPlane
$ ["q:Quit", "i:Install", "u:Uninstall", "s:Set", "c:Changelog", "a:all versions", "↑:Up", "↓:Down"] $ ["q:Quit", "i:Install", "u:Uninstall", "s:Set", "c:Changelog", "a:all versions", "↑:Up", "↓:Down"]
header = fmap stringPlane ["Tool", "Version", "Tags", "Notes"] header = fmap stringPlane [" ", "Tool", "Version", "Tags", "Notes"]
(renderItems, mix) = drawListElements renderItem appState (renderItems, mix) = drawListElements renderItem appState
renderItem _ b listResult@ListResult{..} = renderItem _ _ listResult@ListResult{..} =
let marks = if let marks = if
| lSet -> color Green Vivid $ stringPlane "IS" | lSet -> color Green Vivid $ stringPlane "IS"
| lInstalled -> color Green Vivid $ stringPlane "I " | lInstalled -> color Green Vivid $ stringPlane "I "
@ -299,7 +294,7 @@ logicFun _ gs (KeyPress 'a') = pure $ hideShowHandler (not . showAllVersions) sh
let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings } let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
newInternalState = constructList appData newAppSettings (Just appState) newInternalState = constructList appData newAppSettings (Just appState)
in BrickState appData newAppSettings newInternalState appKeys appQuit appRestart appMoreInput in BrickState appData newAppSettings newInternalState appKeys appQuit appRestart appMoreInput
logicFun _ gs (KeyPress c) = pure gs logicFun _ gs (KeyPress c) = pure $ (unsafePerformIO $ writeFile "key" $ show c) `seq` gs
withIOAction :: (BrickState withIOAction :: (BrickState
-> (Int, ListResult) -> (Int, ListResult)