diff --git a/README.md b/README.md index 2184474..cc0fdfe 100644 --- a/README.md +++ b/README.md @@ -22,4 +22,7 @@ You can see an example by running `cliffs` in this directory. Running the execut ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛ ``` -You can press the up / down arrow to select different scripts. \ No newline at end of file +You can press the up / down arrow to select different scripts. + +[`brick`]: https://github.com/jtdaugherty/brick +[scripts to rule them all]: https://github.com/github/scripts-to-rule-them-all \ No newline at end of file diff --git a/app/Main.hs b/app/Main.hs index e8d8a96..fc1c7d5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -13,8 +13,8 @@ import Control.Monad (void) import Data.Text (pack) import qualified Graphics.Vty as V import Lib - ( Script (Script), - Scripts (Scripts), + ( AppState (..), + Script (Script), appEvent, drawUi, emphAttr, @@ -22,12 +22,14 @@ import Lib import System.Directory (listDirectory) import System.FilePath (takeFileName) -app :: M.App Scripts e () +app :: M.App AppState (IO ()) () app = M.App { M.appDraw = drawUi, M.appStartEvent = return, M.appHandleEvent = appEvent, + -- A function from an app state to a map from attributes (string classses basically) + -- to modifications to rendering M.appAttrMap = const $ attrMap V.defAttr [(emphAttr, V.white `on` V.blue)], M.appChooseCursor = M.neverShowCursor } @@ -36,7 +38,7 @@ main :: IO () main = do scriptFileNames <- listDirectory "./scripts" let scripts = - Scripts + AppState ((\n -> Script False (pack $ takeFileName n) "description goes here") <$> scriptFileNames) Nothing in void $ M.defaultMain app scripts diff --git a/cliffs.cabal b/cliffs.cabal index cd9c8f8..147ae9e 100644 --- a/cliffs.cabal +++ b/cliffs.cabal @@ -33,6 +33,7 @@ library build-depends: base >=4.7 && <5 , brick + , command , directory , filepath , microlens @@ -52,6 +53,7 @@ executable cliffs-exe base >=4.7 && <5 , brick , cliffs + , command , directory , filepath , microlens @@ -72,6 +74,7 @@ test-suite cliffs-test base >=4.7 && <5 , brick , cliffs + , command , directory , filepath , microlens diff --git a/haskell.nix b/haskell.nix index af37e82..422fd67 100644 --- a/haskell.nix +++ b/haskell.nix @@ -3,6 +3,7 @@ with import { }; pkgs.haskellPackages.ghcWithPackages (ps: with ps; [ # actual project dependencies brick + command directory filepath microlens diff --git a/package.yaml b/package.yaml index 24e274b..b0570b8 100644 --- a/package.yaml +++ b/package.yaml @@ -26,6 +26,7 @@ ghc-options: dependencies: - base >= 4.7 && < 5 - brick + - command - directory - filepath - microlens diff --git a/scripts/bootstrap b/scripts/bootstrap old mode 100644 new mode 100755 index dc1df54..c93bd6e --- a/scripts/bootstrap +++ b/scripts/bootstrap @@ -1,3 +1,18 @@ #!/usr/bin/env bash # description: Pulls/builds necessary containers + +function usage() { + echo -n \ + "Usage: $(basename "$0") +Like Elvis Costello, start it up, in the narrow sense of pulling containers +" +} + +if [ "${BASH_SOURCE[0]}" = "${0}" ]; then + if [ "${1:-}" = "--help" ]; then + usage + else + exit 1 + fi +fi diff --git a/scripts/server b/scripts/server old mode 100644 new mode 100755 index 755a184..1c910bc --- a/scripts/server +++ b/scripts/server @@ -1,3 +1,21 @@ #!/usr/bin/env bash -# description: Starts a development server \ No newline at end of file +# description: Starts a development server + +function usage() { + echo -n \ + "Usage: $(basename "$0") +Start up a server, running on port 8080, with all of those dependencies +for sure, dependencies all day. + +Man, lots of dependencies, and all these lines describing them. +" +} + +if [ "${BASH_SOURCE[0]}" = "${0}" ]; then + if [ "${1:-}" = "--help" ]; then + usage + else + exit 1 + fi +fi diff --git a/scripts/update b/scripts/update old mode 100644 new mode 100755 index 800ed97..8774384 --- a/scripts/update +++ b/scripts/update @@ -1,3 +1,17 @@ #!/usr/bin/env bash -# description: Runs migrations, installs dependencies, etc. \ No newline at end of file +# description: Runs migrations, installs dependencies, etc. +function usage() { + echo -n \ + "Usage: $(basename "$0") +Update project dependencies -- migrations, libraries, etc. +" +} + +if [ "${BASH_SOURCE[0]}" = "${0}" ]; then + if [ "${1:-}" = "--help" ]; then + usage + else + exit 1 + fi +fi diff --git a/src/Lib.hs b/src/Lib.hs index 90d9f0d..a20bbce 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -3,20 +3,41 @@ module Lib where -import Brick (AttrName, BrickEvent (VtyEvent), Widget, padLeftRight, str, txt, withAttr, withBorderStyle) +import Brick (AttrName, BrickEvent (VtyEvent), Widget, hLimit, padLeftRight, str, strWrap, txt, vBox, withAttr, withBorderStyle) import qualified Brick.Main as M import qualified Brick.Types as T import Brick.Widgets.Border (borderWithLabel) import qualified Brick.Widgets.Border.Style import qualified Brick.Widgets.Center as C import Brick.Widgets.Table (Table, renderTable, rowBorders, surroundingBorder, table) +import Control.Monad.IO.Class (liftIO) import Data.List.NonEmpty (NonEmpty ((:|)), toList) -import Data.Text (Text) +import Data.Maybe (fromMaybe) +import Data.Text (Text, unpack) import qualified Graphics.Vty as V +import System.Command (Stdout (Stdout), command) -data Script = Script {selected :: Bool, name :: Text, description :: Text} deriving (Eq, Show) +data Script = Script + { selected :: Bool, + name :: Text, + description :: Text + } + deriving (Eq, Show) -data Scripts = Scripts {availableScripts :: [Script], currentScript :: Maybe Script} deriving (Eq, Show) +data ScriptWithOutput = ScriptWithOutput + { script :: Script, + output :: Maybe String + } + deriving (Eq, Show) + +data AppState = AppState + { availableAppState :: [Script], + currentScript :: Maybe ScriptWithOutput + } + deriving (Eq, Show) + +scriptWithoutOutput :: Script -> ScriptWithOutput +scriptWithoutOutput s = ScriptWithOutput s Nothing selectNext' :: NonEmpty Script -> (Script, NonEmpty Script) selectNext' (h :| []) = @@ -31,21 +52,21 @@ selectNext' (h :| t : ts) = let (selectedScript, scripts) = selectNext' (t :| ts) in (selectedScript, h :| toList scripts) -selectNext :: Scripts -> Scripts -selectNext (Scripts [] _) = Scripts [] Nothing -selectNext (Scripts xs@(h : t) _) = +selectNext :: AppState -> AppState +selectNext (AppState [] _) = AppState [] Nothing +selectNext (AppState xs@(h : t) _) = if not $ any selected xs then let selectedScript = h {selected = True} - in Scripts (selectedScript : t) (Just selectedScript) + in AppState (selectedScript : t) (Just . scriptWithoutOutput $ selectedScript) else let (selectedScript, scripts) = selectNext' (h :| t) - in Scripts (toList scripts) (Just selectedScript) + in AppState (toList scripts) (Just . scriptWithoutOutput $ selectedScript) -selectPrevious :: Scripts -> Scripts -selectPrevious (Scripts xs s) = - let Scripts newElems selected = selectNext (Scripts (reverse xs) s) - in Scripts (reverse newElems) selected +selectPrevious :: AppState -> AppState +selectPrevious (AppState xs s) = + let AppState newElems selected = selectNext (AppState (reverse xs) s) + in AppState (reverse newElems) selected listDrawName :: Bool -> Text -> Widget a listDrawName selected name = @@ -65,27 +86,48 @@ mkRow (Script {selected, name, description}) = listDrawDescription description ] -drawTable :: Scripts -> Table a -drawTable (Scripts {availableScripts}) = - table $ mkRow <$> availableScripts +drawTable :: AppState -> Table a +drawTable (AppState {availableAppState}) = + table $ mkRow <$> availableAppState -drawUi :: Scripts -> [Widget ()] -drawUi scripts = +drawUi :: AppState -> [Widget ()] +drawUi appState = let t = surroundingBorder False $ rowBorders False $ - drawTable scripts + drawTable appState attrs = C.hCenter $ borderWithLabel (str "Scripts") . renderTable $ t + helpBox = + let helpText = fromMaybe "No help text yet" (currentScript appState >>= output) + in C.hCenter . hLimit 90 . borderWithLabel (str "Help output") . strWrap $ helpText ui = - C.vCenter $ - withBorderStyle Brick.Widgets.Border.Style.unicodeBold attrs + vBox + [ C.vCenter $ + withBorderStyle Brick.Widgets.Border.Style.unicodeBold attrs, + C.vCenter helpBox + ] in [ui] -appEvent :: Scripts -> BrickEvent () e -> T.EventM () (T.Next Scripts) +getHelp :: Script -> IO Stdout +getHelp Script {name} = command [] ("./scripts/" ++ unpack name) ["--help"] + +addHelpOutput :: (AppState -> AppState) -> AppState -> T.EventM e (T.Next AppState) +addHelpOutput successorFunc state = + let nextScript = successorFunc state + nextSelected = currentScript nextScript + in ( liftIO $ do + helpOut <- traverse getHelp (script <$> nextSelected) + case helpOut of + Nothing -> pure nextScript + Just (Stdout helpText) -> pure nextScript {currentScript = (\x -> x {output = Just helpText}) <$> nextSelected} + ) + >>= M.continue + +appEvent :: AppState -> BrickEvent () (IO ()) -> T.EventM () (T.Next AppState) appEvent i (VtyEvent (V.EvKey V.KEsc [])) = M.halt i -appEvent i (VtyEvent (V.EvKey V.KDown [])) = M.continue (selectNext i) -appEvent i (VtyEvent (V.EvKey V.KUp [])) = M.continue (selectPrevious i) +appEvent i (VtyEvent (V.EvKey V.KDown [])) = addHelpOutput selectNext i +appEvent i (VtyEvent (V.EvKey V.KUp [])) = addHelpOutput selectPrevious i appEvent i (VtyEvent (V.EvKey V.KEnter [])) = M.continue i appEvent i _ = M.continue i