summoner-tui 2.0.1.1 → 2.1.0.0
raw patch · 10 files changed
+326/−189 lines, 10 filesdep +vty-crossplatformdep −textdep ~basedep ~brickdep ~reludePVP ok
version bump matches the API change (PVP)
Dependencies added: vty-crossplatform
Dependencies removed: text
Dependency ranges changed: base, brick, relude, summoner, validation-selective, vty
API changes (from Hackage documentation)
- Summoner.Tui.Field: activeCheckboxField :: forall n s e. Ord n => Lens' s Bool -> (s -> n -> Bool) -> n -> String -> s -> FormFieldState s e n
+ Summoner.Tui.Field: activeCheckboxField :: Ord n => Lens' s Bool -> (s -> n -> Bool) -> n -> String -> s -> FormFieldState s e n
- Summoner.Tui.Field: strField :: forall s e n. String -> s -> FormFieldState s e n
+ Summoner.Tui.Field: strField :: String -> s -> FormFieldState s e n
- Summoner.Tui.Form: mkForm :: forall e. SummonKit -> KitForm e
+ Summoner.Tui.Form: mkForm :: SummonKit -> KitForm e
- Summoner.Tui.Form: recreateForm :: forall e. (KitForm e -> KitForm e) -> KitForm e -> KitForm e
+ Summoner.Tui.Form: recreateForm :: (KitForm e -> KitForm e) -> KitForm e -> KitForm e
- Summoner.Tui.Validation: summonFormValidation :: forall e. [FilePath] -> KitForm e -> KitForm e
+ Summoner.Tui.Validation: summonFormValidation :: [FilePath] -> KitForm e -> KitForm e
Files
- CHANGELOG.md +70/−0
- README.md +56/−49
- src/Summoner/Tui.hs +70/−64
- src/Summoner/Tui/Field.hs +26/−11
- src/Summoner/Tui/Form.hs +7/−5
- src/Summoner/Tui/GroupBorder.hs +6/−3
- src/Summoner/Tui/Kit.hs +6/−3
- src/Summoner/Tui/Validation.hs +27/−26
- src/Summoner/Tui/Widget.hs +11/−7
- summoner-tui.cabal +47/−21
CHANGELOG.md view
@@ -3,6 +3,76 @@ `summoner` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 2.1.0.0 — Jan 6, 2026++* Support GHC-9.12.3. Use GHC-9.12.3 as the default version for+ generated projects with `nightly-2026-01-04` Stack resolver.+* Support GHC-9.10.3 in generated projects with `lts-24.26`.+* Update GHC-9.8 to GHC-9.8.4 with `lts-23.28`.+* Update GHC-9.6 to GHC-9.6.7 with `lts-22.44`.+* Update `base` upper bound to `< 4.22`.+* Update GitHub Actions in generated projects: replace deprecated+ `haskell/actions/setup` with `haskell-actions/setup`.+* Update `optparse-applicative`, `shellmet`, `time`, `hedgehog`, `brick` upper bounds.+* Add new GHC warnings for GHC >= 9.10:+ `-Wincomplete-record-selectors`, `-Wdeprecated-type-abstractions`,+ `-Wdata-kinds-tc`, `-Wdefaulted-exception-context`.+* Add new GHC warning for GHC >= 9.12: `-Wview-pattern-signatures`.+* Fix encoding issues when reading source files by using `readFileBS`+ with `decodeUtf8` instead of `readFileText`.+* Update Stack resolver to `lts-24.26`. Update Stack version in CI to 3.3.++* [#564](https://github.com/kowainik/summoner/issues/564):+ Upgrade `brick` to version `>=1.0`.+* [#565](https://github.com/kowainik/summoner/issues/565):+ Build Summoner with GHC-9.2.+* [#539](https://github.com/kowainik/summoner/issues/539):+ Use GHC-9.0 as default version for generated projects.+* [#540](https://github.com/kowainik/summoner/issues/540):+ Build Summoner with GHC-9.0.+* [#520](https://github.com/kowainik/summoner/issues/520):+ Output the link to the GitHub project at the end of the process.+* [#476](https://github.com/kowainik/summoner/issues/476):+ Switch from `aeson` to `microaeson`.+* [#466](https://github.com/kowainik/summoner/issues/466):+ Add ` --test-show-details=direct` to `cabal test` on CI.+* [#444](https://github.com/kowainik/summoner/issues/444)+ [#547](https://github.com/kowainik/summoner/issues/547):+ Support GHC-8.10.1 in the generated projects.+ Use GHC-8.10.1 by default in the generated projects.+ Use `nightly-2020-06-29` for stack resolver.+ UPD: Use GHC-8.10.3 and `lts-17.0` instead.+ UPD: Use GHC-8.10.7 and `lts-18.10` instead.+* [#445](https://github.com/kowainik/summoner/issues/445):+ Add `-Wunused-packages` for GHC-8.10.+* [#477](https://github.com/kowainik/summoner/issues/477):+ Remove `neat-interpolation` from dependencies.+ As a result, remove some trailing spaces from the generated files.+* [#442](https://github.com/kowainik/summoner/issues/442):+ Get current year with the respect to the current timezone.+* [#446](https://github.com/kowainik/summoner/issues/446):+ Add README link in the `.cabal` file's description field.+* [#453](https://github.com/kowainik/summoner/issues/453):+ Drop support of `GHC-7.10` in the generated projects.+* [#482](https://github.com/kowainik/summoner/issues/482):+ Include `.hie` related GHC options to the generated files:+ `-fwrite-ide-info` and `-hiedir=.hie` for GHC >= 8.8.+ Also add `.hie` folder in the `.gitignore`.+* [#484](https://github.com/kowainik/summoner/issues/484):+ Improve generated files content.+* [#491](https://github.com/kowainik/summoner/issues/491):+ Support GHC-8.8.4 in the project.+* [#517](https://github.com/kowainik/summoner/issues/517):+ Switch to `main` initial branch when creating project.+* Require `git >= 2.28` for `--initial-branch=main` option.+* [#340](https://github.com/kowainik/summoner/issues/340):+ Use `cabal` version `3.0`.+* [#495](https://github.com/kowainik/summoner/issues/495):+ Generate `dependabot.yml` to update GitHub Actions automatically.+* __#TUI__ Upgrade `brick` allowed version. Bump up lower+ bound to `0.56` due to the new field `formFieldUpdate`+ addition to the `FormFieldState` data type.+ ## 2.0.1.1 — May 29, 2020 * [#467](https://github.com/kowainik/summoner/issues/467):
README.md view
@@ -1,11 +1,13 @@ # 🔮 Summoner + [](https://github.com/kowainik/summoner/actions)-[](http://travis-ci.org/kowainik/summoner)-[](https://ci.appveyor.com/project/kowainik/summoner)+ [](https://hackage.haskell.org/package/summoner)-[](https://github.com/kowainik/summoner/blob/master/LICENSE)+[](http://stackage.org/lts/package/summoner)+[](http://stackage.org/nightly/package/summoner)+[](https://github.com/kowainik/summoner/blob/main/LICENSE) > _So many of our dreams at first seem impossible, then they seem improbable, and > then, when we summon the will, they soon become inevitable._@@ -35,13 +37,13 @@ + [TUI: download binary](#tui-download-binary) + [TUI: Homebrew](#tui-homebrew) + [TUI: Ubuntu](#tui-ubuntu)- + [TUI: from Hackage/Stackage](#tui-from-hackagestackage)+ + [TUI: from Hackage](#tui-from-hackage) + [TUI: from source](#tui-from-source) + [Summon-CLI](#summon-cli) + [CLI: download binary](#cli-download-binary) + [CLI: Homebrew](#cli-homebrew) + [CLI: Ubuntu](#cli-ubuntu)- + [CLI: from Hackage/Stackage](#cli-from-hackagestackage)+ + [CLI: from Hackage](#cli-from-hackage) + [CLI: from source](#cli-from-source) + [Setup](#setup) * [Usage](#usage)@@ -78,18 +80,18 @@ You can also see complete examples in the following folder: -* [`summon-cli/examples/`: Examples of scaffolded projects](https://github.com/kowainik/summoner/tree/master/summoner-cli/examples/)+* [`summon-cli/examples/`: Examples of scaffolded projects](https://github.com/kowainik/summoner/tree/main/summoner-cli/examples/) The directory contains the following examples: -* [`cabal-minimal`](https://github.com/kowainik/summoner/tree/master/summoner-cli/examples/cabal-minimal):+* [`cabal-minimal`](https://github.com/kowainik/summoner/tree/main/summoner-cli/examples/cabal-minimal): Minimal Haskell project with the Cabal-only support, default settings and all of the integrations disabled.-* [`cabal-full`](https://github.com/kowainik/summoner/tree/master/summoner-cli/examples/cabal-full):+* [`cabal-full`](https://github.com/kowainik/summoner/tree/main/summoner-cli/examples/cabal-full): Cabal-only project with all integrations enabled.-* [`stack-full`](https://github.com/kowainik/summoner/tree/master/summoner-cli/examples/stack-full):+* [`stack-full`](https://github.com/kowainik/summoner/tree/main/summoner-cli/examples/stack-full): Stack-only project with all integrations enabled.-* [`full-batteries`](https://github.com/kowainik/summoner/tree/master/summoner-cli/examples/full-batteries):+* [`full-batteries`](https://github.com/kowainik/summoner/tree/main/summoner-cli/examples/full-batteries): All batteries-included project which supports both build tools and shows every Summoner feature. @@ -130,11 +132,20 @@ -Widentities -Wincomplete-uni-patterns -Wincomplete-record-updates- -Wredundant-constraints (GHC ⩾ 8.0)- -fhide-source-paths (GHC ⩾ 8.2)- -Wmissing-export-lists (GHC ⩾ 8.4)- -Wpartial-fields (GHC ⩾ 8.4)- -Wmissing-deriving-strategies (GHC ⩾ 8.8)+ -Wredundant-constraints+ -Wnoncanonical-monad-instances+ -fhide-source-paths (GHC ⩾ 8.2)+ -Wmissing-export-lists (GHC ⩾ 8.4)+ -Wpartial-fields (GHC ⩾ 8.4)+ -Wmissing-deriving-strategies (GHC ⩾ 8.8)+ -fwrite-ide-info (GHC ⩾ 8.8)+ -hiedir=.hie (GHC ⩾ 8.8)+ -Wunused-packages (GHC ⩾ 8.10)+ -Wincomplete-record-selectors (GHC ⩾ 9.10)+ -Wdeprecated-type-abstractions (GHC ⩾ 9.10)+ -Wdata-kinds-tc (GHC ⩾ 9.10)+ -Wdefaulted-exception-context (GHC ⩾ 9.10)+ -Wview-pattern-signatures (GHC ⩾ 9.12) ``` Besides, the following GHC options are added to the executable, tests and benchmark stanzas:@@ -223,13 +234,13 @@ To start using Summoner make sure that you have the following tools installed on your machine: -* [`git`](https://git-scm.com) – to initialize the GitHub repo.+* [`git`](https://git-scm.com) ⩾ 2.28 – to initialize the GitHub repo. * [`hub`](https://github.com/github/hub) – to upload the project to GitHub. * [`curl`](https://curl.haxx.se) – to download licenses. We also have minimal version requirements for build tools: -* [Cabal ⩾ 2.4](https://www.haskell.org/cabal/)+* [Cabal ⩾ 3.0](https://www.haskell.org/cabal/) * [Stack ⩾ 2.1.3](http://haskellstack.org) However, it is always recommended to use the newest versions of build tools.@@ -290,21 +301,15 @@ $ sudo apt install summoner-tui ``` -##### TUI: from Hackage/Stackage+##### TUI: from Hackage [[Back to the Table of Contents] ↑](#structure) Using `cabal`: ```shell-cabal v2-update-cabal v2-install summoner-tui-```--Using `stack`:--```shell-stack install summoner-tui+cabal update+cabal install summoner-tui ``` ##### TUI: from source@@ -332,7 +337,7 @@ Build and install using `cabal`: ```shell-cabal v2-install summoner-tui:exe:summon-tui+cabal install summoner-tui:exe:summon-tui ``` Build and install using `stack`:@@ -384,21 +389,15 @@ $ sudo apt install summoner-cli ``` -##### CLI: from Hackage/Stackage+##### CLI: from Hackage [[Back to the Table of Contents] ↑](#structure) Using `cabal`: ```shell-cabal v2-update-cabal v2-install summoner-```--Using `stack`:--```shell-stack install summoner+cabal update+cabal install summoner ``` ##### CLI: from source@@ -426,7 +425,7 @@ Build and install using `cabal`: ```shell-cabal v2-install summoner-cli:exe:summon+cabal install summoner-cli:exe:summon ``` Build and install using `stack`:@@ -476,7 +475,7 @@ | `fullName` | Text | Full name. | | `email` | Text | E-mail address. | | `license` | License | One of: `MIT`, `BSD2`, `BSD3`, `GPL-2`, `GPL-3`, `LGPL-2.1`, `LGPL-3`, `AGPL-3`, `Apache-2.0`, `MPL-2.0`, `None`. |-| `ghcVersions` | [GHC] | `summoner` uses default `GHC-8.8.3`. However, additionally you can specify other versions. For each version `x.y.z` the `stack-x.y.z.yaml` will be created. |+| `ghcVersions` | [GHC] | `summoner` uses default `GHC-9.12.3`. However, additionally you can specify other versions. For each version `x.y.z` the `stack-x.y.z.yaml` will be created. Use `summon show ghc` to see all supported GHC versions. | | `github` | Bool | Turn on `GitHub` integration by default? | | `gitignore` | [Text] | List of files you want added to the default `.gitignore`. (Ignored if `github = false`) | | `noUpload` | Bool | Do not upload to GitHub, but create all GitHub related files if specified (Ignored if `github = false`) |@@ -498,7 +497,7 @@ You can create default configuration using the `summon config` command. See [the default content here](summoner-cli/test/golden/summoner-default.toml). -For a real-life example of the configuration, see [the configuration for projects of the `Kowainik` organization](https://github.com/kowainik/org/blob/master/.summoner.toml).+For a real-life example of the configuration, see [the configuration for projects of the `Kowainik` organization](https://github.com/kowainik/org/blob/main/.summoner.toml). ### Command line arguments @@ -631,7 +630,7 @@ that can be used to scaffold future Haskell packages. It contains all options supported by Summoner with comments and examples. Though, all options would be turned off by default and to use them one will need-to uncomment the correspoding lines.+to uncomment the corresponding lines. See [the default content here](summoner-cli/test/golden/summoner-default.toml). Possible command usages:@@ -716,7 +715,7 @@ #!/usr/bin/env cabal {- cabal: build-depends:- , base ^>= 4.13.0.0+ , base ^>= 4.21.1.0 -} main :: IO ()@@ -728,7 +727,7 @@ ```haskell #!/usr/bin/env stack {- stack- --resolver lts-15.5+ --resolver nightly-2026-01-04 script --package base -}@@ -793,8 +792,8 @@ * Summoner is a multi-package project which has two packages inside: `summoner-cli` and `summoner-tui`. We are supporting the same functionality in both of them, so, if it's possible, you should add/change the code in both of the packages. * Summoner uses the custom prelude [`relude`](https://github.com/kowainik/relude).-* We are using the [Kowainik style guide](https://github.com/kowainik/org/blob/master/style-guide.md#haskell-style-guide).-* To sum up, [here is the Contributing guide](https://github.com/kowainik/.github/blob/master/CONTRIBUTING.md#contributing-to-the-kowainik-repositories) we use across the repositories.+* We are using the [Kowainik style guide](https://kowainik.github.io/posts/2019-02-06-style-guide).+* To sum up, [here is the Contributing guide](https://github.com/kowainik/.github/blob/main/CONTRIBUTING.md#contributing-to-the-kowainik-repositories) we use across the repositories. * This project is contributor-friendly, so be kind to other people working on the project. ### Dependencies@@ -810,7 +809,7 @@ To build the project you can use the following commands: ```shell=-cabal v2-build all+cabal build all ``` for Cabal and@@ -825,12 +824,12 @@ [[Back to the Table of Contents] ↑](#structure) -Summoner uses the golden tests technique for assuring the correctness of the generated files. For this purpose, we have [the `golden` folder](https://github.com/kowainik/summoner/tree/master/summoner-cli/test/golden) with two sample projects to test against.+Summoner uses the golden tests technique for assuring the correctness of the generated files. For this purpose, we have [the `golden` folder](https://github.com/kowainik/summoner/tree/main/summoner-cli/test/golden) with two sample projects to test against. To actually run tests you need to run: ```shell-cabal v2-test all+cabal test all ``` or, if using Stack@@ -846,8 +845,8 @@ Building Summoner with the recommended method creates two executables: `summon` and `summon-tui`. To run the compiled executable you can use the following commands: ```shell-cabal v2-exec summon -- SOME_COMMAND-cabal v2-exec summon-tui -- SOME_COMMAND+cabal exec summon -- SOME_COMMAND+cabal exec summon-tui -- SOME_COMMAND ``` or, if using Stack@@ -855,6 +854,14 @@ ```shell stack exec summon -- SOME_COMMAND stack exec summon-tui -- SOME_COMMAND+```++### Generate golden tests++To regenerate the content of all projects on disk, use the following command:++```shell+cabal run gg ``` ## Acknowledgments
src/Summoner/Tui.hs view
@@ -2,9 +2,12 @@ {-# LANGUAGE ViewPatterns #-} {- |-Copyright: (c) 2018-2019 Kowainik-SPDX-License-Identifier: MPL-2.0-Maintainer: Kowainik <xrom.xkov@gmail.com>+Module : Summoner.Tui+Copyright : (c) 2018-2026 Kowainik+SPDX-License-Identifier : MPL-2.0+Maintainer : Kowainik <xrom.xkov@gmail.com>+Stability : Stable+Portability : Portable TUI for the Summoner tool. See demo in the README.md file. -}@@ -13,13 +16,13 @@ ( summonTui ) where -import Brick (App (..), AttrMap, BrickEvent (..), Widget, attrMap, continue, customMain, halt,+import Brick (App (..), AttrMap, BrickEvent (..), Widget, attrMap, attrName, customMain, halt, simpleApp, str, txt, vBox, withAttr, (<+>)) import Brick.Focus (focusRingCursor) import Brick.Forms (allFieldsValid, focusedFormInputAttr, formFocus, formState, handleFormEvent, invalidFormInputAttr, renderForm) import Brick.Main (ViewportScroll, neverShowCursor, vScrollBy, viewportScroll)-import Brick.Types (EventM, Next, ViewportType (Vertical))+import Brick.Types (EventM, ViewportType (Vertical)) import Brick.Util (fg) import Brick.Widgets.Border (borderAttr) import Brick.Widgets.Center (center)@@ -29,7 +32,6 @@ import Brick.Widgets.List (listSelectedAttr, listSelectedFocusedAttr) import Colourista (errorMessage, infoMessage) import Lens.Micro ((.~), (^.))-import Relude.Extra.Enum (universe) import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, listDirectory) import Summoner.CLI (Command (..), NewOpts (..), ShowOpts (..), getCustomLicenseText,@@ -51,6 +53,8 @@ import qualified Brick (on) import qualified Graphics.Vty as V+import qualified Graphics.Vty.Config as VConfig+import qualified Graphics.Vty.CrossPlatform as VC import qualified Paths_summoner_tui as Meta (version) @@ -120,49 +124,51 @@ appNew :: [FilePath] -> App (KitForm e) e SummonForm appNew dirs = App { appDraw = drawNew dirs- , appHandleEvent = \s ev -> if formState s ^. shouldSummon == Idk+ , appHandleEvent = \ev -> do+ s <- get+ if formState s ^. shouldSummon == Idk then case ev of- VtyEvent (V.EvKey V.KEnter []) -> halt $ changeShouldSummon Yes s- VtyEvent (V.EvKey V.KEsc []) -> withForm ev s (changeShouldSummon Nop)- _ -> continue s+ VtyEvent (V.EvKey V.KEnter []) -> put (changeShouldSummon Yes s) >> halt+ VtyEvent (V.EvKey V.KEsc []) -> withForm ev (changeShouldSummon Nop)+ _otherKey -> pass else case ev of- VtyEvent V.EvResize {} -> continue s+ VtyEvent V.EvResize {} -> pass VtyEvent (V.EvKey V.KEnter [V.MMeta]) ->- withForm ev s (validateForm . projectDescNewLine)+ withForm ev (validateForm . projectDescNewLine) VtyEvent (V.EvKey V.KEnter []) -> if allFieldsValid s- then withForm ev s (changeShouldSummon Idk)- else continue s- VtyEvent (V.EvKey V.KEsc []) -> halt s+ then withForm ev (changeShouldSummon Idk)+ else pass+ VtyEvent (V.EvKey V.KEsc []) -> halt VtyEvent (V.EvKey (V.KChar 'd') [V.MCtrl]) ->- withForm ev s (validateForm . ctrlD)+ withForm ev (validateForm . ctrlD) -- Handle active/inactive checkboxes VtyEvent (V.EvKey (V.KChar ' ') []) -> case getCurrentFocus s of- Nothing -> withFormDef ev s- Just field -> handleCheckboxActivation ev s field+ Nothing -> withFormDef ev+ Just field -> handleCheckboxActivation ev field -- Run handler for autofill actions VtyEvent (V.EvKey key []) | keyTriggersAutofill key- -> withForm ev s (validateForm . handleAutofill)+ -> withForm ev (validateForm . handleAutofill) - MouseDown n _ _ _ -> handleCheckboxActivation ev s n+ MouseDown n _ _ _ -> handleCheckboxActivation ev n -- Handle skip of deactivated checkboxes- VtyEvent (V.EvKey (V.KChar '\t') []) -> loopWhileInactive ev s- VtyEvent (V.EvKey V.KBackTab []) -> loopWhileInactive ev s+ VtyEvent (V.EvKey (V.KChar '\t') []) -> loopWhileInactive ev+ VtyEvent (V.EvKey V.KBackTab []) -> loopWhileInactive ev -- Default action- _ -> withFormDef ev s+ _otherEvent -> withFormDef ev , appChooseCursor = focusRingCursor formFocus- , appStartEvent = pure+ , appStartEvent = pass , appAttrMap = const theMap } where- withForm ev s f = handleFormEvent ev s >>= continue . f- withFormDef ev s = withForm ev s validateForm+ withForm ev f = handleFormEvent ev >> modify f+ withFormDef ev = withForm ev validateForm changeShouldSummon :: Decision -> KitForm e -> KitForm e changeShouldSummon newShould f = mkForm $ formState f & shouldSummon .~ newShould@@ -176,41 +182,41 @@ -- Activate/Deactivate checkboxes depending on current field change handleCheckboxActivation :: BrickEvent SummonForm e- -> KitForm e -> SummonForm- -> EventM SummonForm (Next (KitForm e))- handleCheckboxActivation ev form = \case- CabalField -> withForm ev form mkNewForm- StackField -> withForm ev form mkNewForm- GitHubEnable -> withForm ev form mkNewForm- GitHubDisable -> withForm ev form mkNewForm- GitHubNoUpload -> withForm ev form mkNewForm- _ -> withFormDef ev form+ -> EventM SummonForm (KitForm e) ()+ handleCheckboxActivation ev = \case+ CabalField -> withForm ev mkNewForm+ StackField -> withForm ev mkNewForm+ GitHubEnable -> withForm ev mkNewForm+ GitHubDisable -> withForm ev mkNewForm+ GitHubNoUpload -> withForm ev mkNewForm+ _nonCheckBox -> withFormDef ev -- Handles form event until current element is active loopWhileInactive :: BrickEvent SummonForm e- -> KitForm e- -> EventM SummonForm (Next (KitForm e))- loopWhileInactive ev form = do- newForm <- handleFormEvent ev form+ -> EventM SummonForm (KitForm e) ()+ loopWhileInactive ev = do+ handleFormEvent ev+ newForm <- get case getCurrentFocus newForm of- Nothing -> continue newForm+ Nothing -> pass Just field -> if not $ isActive (formState newForm) field- then loopWhileInactive ev newForm- else continue newForm+ then loopWhileInactive ev+ else pass -- Autofill is only triggered on characters and backspace keys. keyTriggersAutofill :: V.Key -> Bool keyTriggersAutofill (V.KChar _) = True keyTriggersAutofill V.KBS = True- keyTriggersAutofill _ = False+ keyTriggersAutofill _otherKey = False -- | Draws the form for @new@ command. drawNew :: [FilePath] -> KitForm e -> [Widget SummonForm] drawNew dirs kitForm = case kit ^. shouldSummon of Idk -> [confirmDialog]- _ -> [formWidget]+ Yes -> [formWidget]+ Nop -> [formWidget] where kit :: SummonKit kit = formState kitForm@@ -232,7 +238,7 @@ tree :: Widget SummonForm tree = hLimitPercent 25 $ vLimit 22 $ borderLabel "Project Structure" $ vBox- [ withAttr "tree" $ txt $ renderWidgetTree kit+ [ withAttr (attrName "tree") $ txt $ renderWidgetTree kit -- to fill all the space that widget should take. , fill ' ' ]@@ -248,18 +254,18 @@ where informationBlock :: Widget SummonForm informationBlock = case getCurrentFocus kitForm of- Just UserOwner -> infoTxt "GitHub username"- Just ProjectCat -> infoTxt "Comma-separated categories as used at Hackage"- Just Ghcs -> infoTxt "Space separated GHC versions"- _ -> emptyWidget+ Just UserOwner -> infoTxt "GitHub username"+ Just ProjectCat -> infoTxt "Comma-separated categories as used at Hackage"+ Just Ghcs -> infoTxt "Space separated GHC versions"+ _noInfoAvailable -> emptyWidget infoTxt :: Text -> Widget SummonForm- infoTxt = withAttr "blue-fg" . txtWrap . (<>) " ⓘ "+ infoTxt = withAttr (attrName "blue-fg") . txtWrap . (<>) " ⓘ " validationBlock :: Widget SummonForm validationBlock = vBox $ case formErrorMessages dirs kitForm of- [] -> [withAttr "green-fg" $ str " ✔ Project configuration is valid"]- fields -> map (\msg -> withAttr "red-fg" $ strWrap $ " ☓ " ++ msg) fields+ [] -> [withAttr (attrName "green-fg") $ str " ✔ Project configuration is valid"]+ fields -> map (\msg -> withAttr (attrName "red-fg") $ strWrap $ " ☓ " ++ msg) fields configBlock :: Widget SummonForm configBlock = case kit ^. configFile of@@ -311,14 +317,14 @@ licenseApp :: LicenseName -> License -> App () e () licenseApp licenseName lc = App { appDraw = drawScrollableLicense licenseName lc- , appStartEvent = pure+ , appStartEvent = pass , appAttrMap = const theMap , appChooseCursor = neverShowCursor- , appHandleEvent = \() event -> case event of- VtyEvent (V.EvKey V.KDown []) -> vScrollBy licenseScroll 1 >> continue ()- VtyEvent (V.EvKey V.KUp []) -> vScrollBy licenseScroll (-1) >> continue ()- VtyEvent (V.EvKey V.KEsc []) -> halt ()- _ -> continue ()+ , appHandleEvent = \case+ VtyEvent (V.EvKey V.KDown []) -> vScrollBy licenseScroll 1 >> pass+ VtyEvent (V.EvKey V.KUp []) -> vScrollBy licenseScroll (-1) >> pass+ VtyEvent (V.EvKey V.KEsc []) -> halt+ _otherEvent -> pass } licenseScroll :: ViewportScroll ()@@ -348,7 +354,7 @@ where buildVty :: IO V.Vty buildVty = do- v <- V.mkVty =<< V.standardIOConfig+ v <- VC.mkVty VConfig.defaultConfig V.setMode (V.outputIface v) V.Mouse True pure v @@ -372,10 +378,10 @@ , (listSelectedAttr, V.black `Brick.on` V.cyan) , (listSelectedFocusedAttr, V.black `Brick.on` V.white) , (disabledAttr, fg V.brightBlack)- , ("blue-fg", fg V.blue)- , ("green-fg", fg V.green)- , ("yellow-fg", fg V.yellow)- , ("red-fg", fg V.brightRed)+ , (attrName "blue-fg", fg V.blue)+ , (attrName "green-fg", fg V.green)+ , (attrName "yellow-fg", fg V.yellow)+ , (attrName "red-fg", fg V.brightRed) , (borderAttr, fg V.cyan)- , ("tree", fg V.cyan)+ , (attrName "tree", fg V.cyan) ]
src/Summoner/Tui/Field.hs view
@@ -1,9 +1,13 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {- |-Copyright: (c) 2018-2019 Kowainik-SPDX-License-Identifier: MPL-2.0-Maintainer: Kowainik <xrom.xkov@gmail.com>+Module : Summoner.Tui.Field+Copyright : (c) 2018-2026 Kowainik+SPDX-License-Identifier : MPL-2.0+Maintainer : Kowainik <xrom.xkov@gmail.com>+Stability : Stable+Portability : Portable This modules adds necessary functions for Forms and Form fields that are not covered in @brick@ library.@@ -17,9 +21,12 @@ , disabledAttr ) where -import Brick (BrickEvent (..), EventM, Location (..), Widget, clickable, showCursor, str, vBox,- withAttr, withDefAttr, (<+>))+import Brick (BrickEvent (..), EventM, Location (..), Widget, attrName, clickable, showCursor, str,+ vBox, withAttr, withDefAttr, (<+>)) import Brick.AttrMap (AttrName)+#if MIN_VERSION_brick(2,2,0)+import Brick.Forms (FormFieldVisibilityMode (ShowCompositeField))+#endif import Brick.Forms (FormField (..), FormFieldState (..), checkboxCustomField, focusedFormInputAttr, radioCustomField) import Lens.Micro (Lens', lens, (^.))@@ -36,6 +43,10 @@ , formFields = [] , formFieldRenderHelper = renderString , formFieldConcat = vBox+ , formFieldUpdate = flip const+#if MIN_VERSION_brick(2,2,0)+ , formFieldVisibilityMode = ShowCompositeField+#endif } where -- looool@@ -94,17 +105,21 @@ , formFieldLens = stLens , formFieldRenderHelper = id , formFieldConcat = vBox+ , formFieldUpdate = flip const+#if MIN_VERSION_brick(2,2,0)+ , formFieldVisibilityMode = ShowCompositeField+#endif } where initVal, isEnabled :: Bool initVal = initialState ^. stLens isEnabled = isActive initialState name - handleEvent :: BrickEvent n e -> Bool -> EventM n Bool+ handleEvent :: BrickEvent n e -> EventM n Bool () handleEvent (MouseDown n _ _ _)- | isEnabled && n == name = pure . not- handleEvent (VtyEvent (V.EvKey (V.KChar ' ') [])) = pure . not- handleEvent _ = pure+ | isEnabled && n == name = get >>= put . not+ handleEvent (VtyEvent (V.EvKey (V.KChar ' ') [])) = get >>= put . not+ handleEvent _ = pass checkboxFormField :: FormField Bool Bool e n checkboxFormField = FormField@@ -116,7 +131,7 @@ } -- | Renders checkbox depending on its state.-renderCheckbox :: Bool -> String -> n -> Bool -> Bool -> Widget n+renderCheckbox :: (Ord n) => Bool -> String -> n -> Bool -> Bool -> Widget n renderCheckbox isEnabled label n foc val = let addAttr = if foc then withDefAttr focusedFormInputAttr else id csr = if foc then showCursor n (Location (1,0)) else id@@ -127,4 +142,4 @@ -- | Attribute for disabled checkboxes. disabledAttr :: AttrName-disabledAttr = "disabled"+disabledAttr = attrName "disabled"
src/Summoner/Tui/Form.hs view
@@ -1,7 +1,10 @@ {- |-Copyright: (c) 2018-2019 Kowainik-SPDX-License-Identifier: MPL-2.0-Maintainer: Kowainik <xrom.xkov@gmail.com>+Module : Summoner.Tui.Form+Copyright : (c) 2018-2026 Kowainik+SPDX-License-Identifier : MPL-2.0+Maintainer : Kowainik <xrom.xkov@gmail.com>+Stability : Stable+Portability : Portable Form layout and form fields data types. -}@@ -20,7 +23,6 @@ import Brick.Forms (Form, editField, editTextField, formFocus, formState, listField, newForm, setFieldConcat, setFormConcat, setFormFocus, (@@=)) import Lens.Micro ((^.))-import Relude.Extra.Enum (universe) import Summoner.Default (defaultGHC) import Summoner.GhcVer (parseGhcVer, showGhcVer)@@ -147,7 +149,7 @@ GitHubActions -> isGitHubEnabled && (kit ^. cabal) GitHubTravis -> isGitHubEnabled GitHubAppVeyor -> isGitHubEnabled- _ -> True+ _nonGithub -> True where isGitHubEnabled, isUploadEnabled :: Bool isGitHubEnabled = kit ^. gitHub . enabled
src/Summoner/Tui/GroupBorder.hs view
@@ -1,7 +1,10 @@ {- |-Copyright: (c) 2018-2019 Kowainik-SPDX-License-Identifier: MPL-2.0-Maintainer: Kowainik <xrom.xkov@gmail.com>+Module : Summoner.Tui.GroupBorder+Copyright : (c) 2018-2026 Kowainik+SPDX-License-Identifier : MPL-2.0+Maintainer : Kowainik <xrom.xkov@gmail.com>+Stability : Stable+Portability : Portable @Brick@ library helper functions to group checkbox elements inside the form. This is not going to be the part of the library itself, so we will have it in
src/Summoner/Tui/Kit.hs view
@@ -4,9 +4,12 @@ {-# LANGUAGE TemplateHaskell #-} {- |-Copyright: (c) 2018-2019 Kowainik-SPDX-License-Identifier: MPL-2.0-Maintainer: Kowainik <xrom.xkov@gmail.com>+Module : Summoner.Tui.Kit+Copyright : (c) 2018-2026 Kowainik+SPDX-License-Identifier : MPL-2.0+Maintainer : Kowainik <xrom.xkov@gmail.com>+Stability : Stable+Portability : Portable This module contains data types to work with application form. 'SummonKit' is the data type containing the values manipulated by the fields in the form.
src/Summoner/Tui/Validation.hs view
@@ -1,9 +1,12 @@ {-# LANGUAGE Rank2Types #-} {- |-Copyright: (c) 2018-2019 Kowainik-SPDX-License-Identifier: MPL-2.0-Maintainer: Kowainik <xrom.xkov@gmail.com>+Module : Summoner.Tui.Validation+Copyright : (c) 2018-2026 Kowainik+SPDX-License-Identifier : MPL-2.0+Maintainer : Kowainik <xrom.xkov@gmail.com>+Stability : Stable+Portability : Portable This module contains function to validate Form fields. -}@@ -18,8 +21,7 @@ import Brick.Forms (formState, invalidFields, setFieldValid, setFormFocus) import Lens.Micro (Lens', (%~), (.~), (^.))-import Relude.Extra.Enum (universe)-import Validation (Validation (..))+import Validation (Validation (..), failureIf) import Summoner.Text (moduleNameValid, packageNameValid, packageToModule) import Summoner.Tui.Form (KitForm, SummonForm (..), getCurrentFocus, mkForm)@@ -54,7 +56,7 @@ newState = formState f & projectMeta . preludeModule .~ packageToModule curPreludeName in setFormFocus CustomPreludeName $ mkForm newState- _ -> f+ _anyOtherField -> f -- | Adds a newline for project description. projectDescNewLine :: KitForm e -> KitForm e@@ -82,9 +84,9 @@ -- validation of form input fields. data FormError -- | List of empty fields that shouldn't be empty.- = EmptyFields (NonEmpty SummonForm)+ = EmptyFields !(NonEmpty SummonForm) -- | List of fields that should be exactly one word.- | OneWord (NonEmpty SummonForm)+ | OneWord !(NonEmpty SummonForm) -- | Project with such name already exist. | ProjectExist -- | At least one build tool should be chosen.@@ -100,11 +102,11 @@ -- | Show 'FormError' to display later in TUI. showFormError :: FormError -> String showFormError = \case+ EmptyFields fields -> "These fields must not be empty: " ++ joinFields fields+ OneWord fields -> "These fields should contain exactly one word: " ++ joinFields fields ProjectExist -> "Directory with such name already exists" CabalOrStack -> "Choose at least one: Cabal or Stack" LibOrExe -> "Choose at least one: Library or Executable"- EmptyFields fields -> "These fields must not be empty: " ++ joinFields fields- OneWord fields -> "These fields should contain exactly one word: " ++ joinFields fields PreludePackageError -> "Prelude package should only contain letters, numbers and hyphens" PreludeModuleError -> "Prelude module name could only contain dot-separated capitalized letter/numeral fragments. Ex: This.Is.Valid1" where@@ -121,7 +123,7 @@ ProjectCat -> Just "Category" CustomPreludeName -> Just "Prelude name" CustomPreludeModule -> Just "Module"- _ -> Nothing+ _nonMandatoryFields -> Nothing -- | Returns list of all invalid fields according to the error. errorToInvalidFields :: FormError -> NonEmpty SummonForm@@ -134,10 +136,6 @@ PreludePackageError -> one CustomPreludeName PreludeModuleError -> one CustomPreludeModule --- | Takes boolean value and error and returns error if predicate 'True'.-toError :: Bool -> e -> Validation (NonEmpty e) ()-toError p e = if p then Failure (one e) else Success ()- -- | Validates 'SummonKit' and returns list of all possible errors or success. validateKit :: [FilePath] -> SummonKit -> Validation (NonEmpty FormError) () validateKit dirs kit =@@ -165,10 +163,10 @@ *> checkField (user . email) UserEmail *> checkField (project . repo) ProjectName *> checkField (project . desc) ProjectDesc- *> toError isEmptyPrelude CustomPreludeModule+ *> failureIf isEmptyPrelude CustomPreludeModule checkField :: Lens' SummonKit Text -> SummonForm -> Validation (NonEmpty SummonForm) ()- checkField textL = toError $ isEmpty $ kit ^. textL+ checkField textL = failureIf $ isEmpty $ kit ^. textL isEmpty :: Text -> Bool isEmpty t = T.strip t == ""@@ -190,25 +188,28 @@ *> checkField (projectMeta . preludeModule) CustomPreludeModule checkField :: Lens' SummonKit Text -> SummonForm -> Validation (NonEmpty SummonForm) ()- checkField textL = toError (length (words $ kit ^. textL) > 1)+ checkField textL = failureIf $ case words $ kit ^. textL of+ [] -> False+ [_x] -> False+ _x:_ -> True validateProjectExist :: Validation (NonEmpty FormError) ()- validateProjectExist = toError+ validateProjectExist = failureIf (toString (kit ^. project . repo) `elem` dirs) ProjectExist validateBuildTools :: Validation (NonEmpty FormError) ()- validateBuildTools = toError+ validateBuildTools = failureIf (not $ kit ^. cabal || kit ^. stack) CabalOrStack validateLibOrExe :: Validation (NonEmpty FormError) ()- validateLibOrExe = toError+ validateLibOrExe = failureIf (not $ kit ^. projectMeta . lib || kit ^. projectMeta . exe) LibOrExe validatePreludePackage :: Validation (NonEmpty FormError) ()- validatePreludePackage = toError+ validatePreludePackage = failureIf (not $ T.null packageName || packageNameValid packageName) PreludePackageError where@@ -216,7 +217,7 @@ packageName = kit ^. projectMeta . preludeName validatePreludeModule :: Validation (NonEmpty FormError) ()- validatePreludeModule = toError+ validatePreludeModule = failureIf (not $ T.null moduleName || moduleNameValid moduleName) PreludeModuleError where@@ -228,9 +229,9 @@ formErrorMessages dirs kitForm = validatedErrorMessages ++ ghcErrorMessage where validatedErrorMessages :: [String]- validatedErrorMessages = case validateKit dirs (formState kitForm) of- Success _ -> []- Failure errors -> map showFormError $ toList errors+ validatedErrorMessages = case validateKit dirs $ formState kitForm of+ Success _ -> []+ Failure errs -> map showFormError (toList errs) -- Hack because input field for GHC versions uses custom @editField@ with its own validation ghcErrorMessage :: [String]
src/Summoner/Tui/Widget.hs view
@@ -1,7 +1,10 @@ {- |-Copyright: (c) 2018-2019 Kowainik-SPDX-License-Identifier: MPL-2.0-Maintainer: Kowainik <xrom.xkov@gmail.com>+Module : Summoner.Tui.Widget+Copyright : (c) 2018-2026 Kowainik+SPDX-License-Identifier : MPL-2.0+Maintainer : Kowainik <xrom.xkov@gmail.com>+Stability : Stable+Portability : Portable This module contains useful helpers to work with 'Widget's -}@@ -14,11 +17,12 @@ , listInBorder ) where -import Brick.Types (Padding (Pad), Widget)+import Brick (attrName)+import Brick.Types (Widget) import Brick.Widgets.Border (borderWithLabel) import Brick.Widgets.Center (center)-import Brick.Widgets.Core (hBox, hLimit, padLeftRight, padRight, str, txtWrap, vBox, vLimit,- withAttr, (<+>))+import Brick.Widgets.Core (Padding (Pad), hBox, hLimit, padLeftRight, padRight, str, txtWrap, vBox,+ vLimit, withAttr, (<+>)) -- | Adds label to the Form's field.@@ -88,4 +92,4 @@ $ borderLabel name $ center $ vBox- $ map (withAttr "blue-fg" . txtWrap . ("➤ " <>)) list+ $ map (withAttr (attrName "blue-fg") . txtWrap . ("➤ " <>)) list
summoner-tui.cabal view
@@ -1,6 +1,6 @@-cabal-version: 2.4+cabal-version: 3.4 name: summoner-tui-version: 2.0.1.1+version: 2.1.0.0 synopsis: Tool for scaffolding fully configured batteries-included production-level Haskell projects using TUI. description: Tool for scaffolding fully configured batteries-included production-level Haskell projects using TUI. See [README.md](https://github.com/kowainik/summoner#-summoner) for details.@@ -10,7 +10,7 @@ license-file: LICENSE author: Veronika Romashkina, Dmitrii Kovanikov maintainer: Kowainik <xrom.xkov@gmail.com>-copyright: 2018-2020 Kowainik+copyright: 2018-2026 Kowainik category: TUI, TUI Tool, Development build-type: Simple stability: experimental@@ -18,38 +18,64 @@ CHANGELOG.md tested-with: GHC == 8.4.4 GHC == 8.6.5- GHC == 8.8.3- GHC == 8.10.1+ GHC == 8.8.4+ GHC == 8.10.7+ GHC == 9.0.2+ GHC == 9.2.8+ GHC == 9.4.7+ GHC == 9.6.7+ GHC == 9.8.4+ GHC == 9.10.3+ GHC == 9.12.3 source-repository head type: git location: git@github.com:kowainik/summoner.git common common-options- build-depends: base >= 4.11 && < 4.15- , relude ^>= 0.7.0.0+ build-depends: base >= 4.11 && < 4.22+ , relude >= 1.0.0.0 && < 1.3 mixins: base hiding (Prelude)- , relude (Relude as Prelude- , Relude.Extra.Enum- )+ , relude (Relude as Prelude)+ , relude+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns -Wincomplete-record-updates- if impl(ghc >= 8.0)- ghc-options: -Wredundant-constraints- if impl(ghc >= 8.2)- ghc-options: -fhide-source-paths- if impl(ghc >= 8.4)- ghc-options: -Wmissing-export-lists+ -Wredundant-constraints+ -Wnoncanonical-monad-instances+ -fhide-source-paths+ -Wmissing-export-lists -Wpartial-fields if impl(ghc >= 8.8) ghc-options: -Wmissing-deriving-strategies -Werror=missing-deriving-strategies+ -fwrite-ide-info+ -hiedir=../.hie if impl(ghc >= 8.10) ghc-options: -Wunused-packages+ if impl(ghc >= 9.0)+ ghc-options: -Winvalid-haddock+ if impl(ghc >= 9.2)+ ghc-options: -Wredundant-bang-patterns+ -Woperator-whitespace+ if impl(ghc >= 9.4 && < 9.10)+ ghc-options: -Wforall-identifier+ if impl(ghc >= 9.4)+ ghc-options: -Wredundant-strictness-flags+ if impl(ghc >= 9.8)+ ghc-options: -Wterm-variable-capture+ -Winconsistent-flags+ if impl(ghc >= 9.10)+ ghc-options: -Wincomplete-record-selectors+ -Wdeprecated-type-abstractions+ -Wdata-kinds-tc+ -Wdefaulted-exception-context+ if impl(ghc >= 9.12)+ ghc-options: -Wview-pattern-signatures default-extensions: DeriveGeneric DerivingStrategies@@ -79,15 +105,15 @@ autogen-modules: Paths_summoner_tui other-modules: Paths_summoner_tui - build-depends: brick >= 0.47 && < 0.55+ build-depends: brick >= 1.0 && < 2.11 , colourista ^>= 0.1 , directory ^>= 1.3.0.2 , microlens ^>= 0.4 , microlens-th ^>= 0.4- , summoner ^>= 2.0.0.0- , text ^>= 1.2.3.0- , validation-selective >= 0.0.0.0 && < 0.2- , vty >= 5.25 && < 5.29+ , summoner ^>= 2.1.0.0+ , validation-selective >= 0.0.0.0 && < 0.3+ , vty >= 6.0 && < 6.3+ , vty-crossplatform >= 0.2 && < 0.3 executable summon-tui import: common-options