{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ViewPatterns #-}
module Summoner.Tui
( summonTui
) where
import Brick (App (..), AttrMap, BrickEvent (..), Widget, attrMap, continue, 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.Util (fg)
import Brick.Widgets.Border (borderAttr)
import Brick.Widgets.Center (center)
import Brick.Widgets.Core (emptyWidget, fill, hLimit, hLimitPercent, padTopBottom, strWrap, txtWrap,
vLimit, viewport)
import Brick.Widgets.Edit (editAttr, editFocusedAttr)
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,
getFinalConfig, runConfig, runScript, summon)
import Summoner.Config (ConfigP (cFiles))
import Summoner.Decision (Decision (..))
import Summoner.Default (defaultConfigFile)
import Summoner.GhcVer (ghcTable)
import Summoner.License (License (..), LicenseName, parseLicenseName, showLicenseWithDesc)
import Summoner.Mode (isNonInteractive)
import Summoner.Project (generateProjectNonInteractive, initializeProject)
import Summoner.Source (fetchSources)
import Summoner.Tui.Field (disabledAttr)
import Summoner.Tui.Form (KitForm, SummonForm (..), getCurrentFocus, isActive, mkForm, recreateForm)
import Summoner.Tui.Kit
import Summoner.Tui.Validation (ctrlD, formErrorMessages, handleAutofill, projectDescNewLine,
summonFormValidation)
import Summoner.Tui.Widget (borderLabel, listInBorder)
import qualified Brick (on)
import qualified Graphics.Vty as V
import qualified Paths_summoner_tui as Meta (version)
summonTui :: IO ()
summonTui :: IO ()
summonTui = Version -> (Command -> IO ()) -> IO ()
summon Version
Meta.version Command -> IO ()
runTuiCommand
runTuiCommand :: Command -> IO ()
runTuiCommand :: Command -> IO ()
runTuiCommand = \case
New opts :: NewOpts
opts -> NewOpts -> IO ()
summonTuiNew NewOpts
opts
ShowInfo opts :: ShowOpts
opts -> ShowOpts -> IO ()
summonTuiShow ShowOpts
opts
Script opts :: ScriptOpts
opts -> ScriptOpts -> IO ()
runScript ScriptOpts
opts
Config opts :: ConfigOpts
opts -> ConfigOpts -> IO ()
runConfig ConfigOpts
opts
summonTuiNew :: NewOpts -> IO ()
summonTuiNew :: NewOpts -> IO ()
summonTuiNew newOpts :: NewOpts
newOpts@NewOpts{..} = do
Config
finalConfig <- NewOpts -> IO Config
getFinalConfig NewOpts
newOpts
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Interactivity -> Bool
isNonInteractive Interactivity
newOptsInteractivity) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
ConnectMode -> Text -> Config -> IO ()
generateProjectNonInteractive
ConnectMode
newOptsConnectMode
Text
newOptsProjectName
Config
finalConfig
() () -> IO Any -> IO ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO Any
forall (m :: * -> *) a. MonadIO m => m a
exitSuccess
[TreeFs]
files <- ConnectMode -> Map FilePath Source -> IO [TreeFs]
fetchSources ConnectMode
newOptsConnectMode (Config -> Map FilePath Source
forall (p :: Phase). ConfigP p -> Map FilePath Source
cFiles Config
finalConfig)
Maybe FilePath
configFilePath <- IO (Maybe FilePath)
findConfigFile
let initialKit :: SummonKit
initialKit = Text
-> ConnectMode -> Maybe FilePath -> [TreeFs] -> Config -> SummonKit
configToSummonKit
Text
newOptsProjectName
ConnectMode
newOptsConnectMode
Maybe FilePath
configFilePath
[TreeFs]
files
Config
finalConfig
KitForm Any
skForm <- SummonKit -> IO (KitForm Any)
forall e. SummonKit -> IO (KitForm e)
runTuiNew SummonKit
initialKit
let kit :: SummonKit
kit = KitForm Any -> SummonKit
forall s e n. Form s e n -> s
formState KitForm Any
skForm
if KitForm Any -> Bool
forall s e n. Form s e n -> Bool
allFieldsValid KitForm Any
skForm Bool -> Bool -> Bool
&& (SummonKit
kit SummonKit -> Getting Decision SummonKit Decision -> Decision
forall s a. s -> Getting a s a -> a
^. Getting Decision SummonKit Decision
forall s a. HasShouldSummon s a => Lens' s a
shouldSummon Decision -> Decision -> Bool
forall a. Eq a => a -> a -> Bool
== Decision
Yes)
then SummonKit -> IO Settings
finalSettings SummonKit
kit IO Settings -> (Settings -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Settings -> IO ()
initializeProject
else Text -> IO ()
errorMessage "Aborting summoner"
where
findConfigFile :: IO (Maybe FilePath)
findConfigFile :: IO (Maybe FilePath)
findConfigFile = if Bool
newOptsIgnoreFile
then Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
else case Maybe FilePath
newOptsConfigFile of
Nothing -> IO FilePath
defaultConfigFile IO FilePath
-> (FilePath -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \file :: FilePath
file ->
IO Bool
-> IO (Maybe FilePath)
-> IO (Maybe FilePath)
-> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (FilePath -> IO Bool
doesFileExist FilePath
file) (Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
file) (Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing)
justFile :: Maybe FilePath
justFile -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
justFile
runTuiNew :: SummonKit -> IO (KitForm e)
runTuiNew :: SummonKit -> IO (KitForm e)
runTuiNew kit :: SummonKit
kit = do
[FilePath]
filesAndDirs <- FilePath -> IO [FilePath]
listDirectory (FilePath -> IO [FilePath]) -> IO FilePath -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath
getCurrentDirectory
[FilePath]
dirs <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist [FilePath]
filesAndDirs
App (KitForm e) e SummonForm -> KitForm e -> IO (KitForm e)
forall n s e. Ord n => App s e n -> s -> IO s
runApp ([FilePath] -> App (KitForm e) e SummonForm
forall e. [FilePath] -> App (KitForm e) e SummonForm
appNew [FilePath]
dirs) ([FilePath] -> KitForm e -> KitForm e
forall e. [FilePath] -> KitForm e -> KitForm e
summonFormValidation [FilePath]
dirs (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall a b. (a -> b) -> a -> b
$ SummonKit -> KitForm e
forall e. SummonKit -> KitForm e
mkForm SummonKit
kit)
appNew :: [FilePath] -> App (KitForm e) e SummonForm
appNew :: [FilePath] -> App (KitForm e) e SummonForm
appNew dirs :: [FilePath]
dirs = App :: forall s e n.
(s -> [Widget n])
-> (s -> [CursorLocation n] -> Maybe (CursorLocation n))
-> (s -> BrickEvent n e -> EventM n (Next s))
-> (s -> EventM n s)
-> (s -> AttrMap)
-> App s e n
App
{ appDraw :: KitForm e -> [Widget SummonForm]
appDraw = [FilePath] -> KitForm e -> [Widget SummonForm]
forall e. [FilePath] -> KitForm e -> [Widget SummonForm]
drawNew [FilePath]
dirs
, appHandleEvent :: KitForm e
-> BrickEvent SummonForm e -> EventM SummonForm (Next (KitForm e))
appHandleEvent = \s :: KitForm e
s ev :: BrickEvent SummonForm e
ev -> if KitForm e -> SummonKit
forall s e n. Form s e n -> s
formState KitForm e
s SummonKit -> Getting Decision SummonKit Decision -> Decision
forall s a. s -> Getting a s a -> a
^. Getting Decision SummonKit Decision
forall s a. HasShouldSummon s a => Lens' s a
shouldSummon Decision -> Decision -> Bool
forall a. Eq a => a -> a -> Bool
== Decision
Idk
then case BrickEvent SummonForm e
ev of
VtyEvent (V.EvKey V.KEnter []) -> KitForm e -> EventM SummonForm (Next (KitForm e))
forall s n. s -> EventM n (Next s)
halt (KitForm e -> EventM SummonForm (Next (KitForm e)))
-> KitForm e -> EventM SummonForm (Next (KitForm e))
forall a b. (a -> b) -> a -> b
$ Decision -> KitForm e -> KitForm e
forall e. Decision -> KitForm e -> KitForm e
changeShouldSummon Decision
Yes KitForm e
s
VtyEvent (V.EvKey V.KEsc []) -> BrickEvent SummonForm e
-> KitForm e
-> (KitForm e -> KitForm e)
-> EventM SummonForm (Next (KitForm e))
forall n e s s.
Eq n =>
BrickEvent n e
-> Form s e n -> (Form s e n -> s) -> EventM n (Next s)
withForm BrickEvent SummonForm e
ev KitForm e
s (Decision -> KitForm e -> KitForm e
forall e. Decision -> KitForm e -> KitForm e
changeShouldSummon Decision
Nop)
_ -> KitForm e -> EventM SummonForm (Next (KitForm e))
forall s n. s -> EventM n (Next s)
continue KitForm e
s
else case BrickEvent SummonForm e
ev of
VtyEvent V.EvResize {} -> KitForm e -> EventM SummonForm (Next (KitForm e))
forall s n. s -> EventM n (Next s)
continue KitForm e
s
VtyEvent (V.EvKey V.KEnter [V.MMeta]) ->
BrickEvent SummonForm e
-> KitForm e
-> (KitForm e -> KitForm e)
-> EventM SummonForm (Next (KitForm e))
forall n e s s.
Eq n =>
BrickEvent n e
-> Form s e n -> (Form s e n -> s) -> EventM n (Next s)
withForm BrickEvent SummonForm e
ev KitForm e
s (KitForm e -> KitForm e
forall e. KitForm e -> KitForm e
validateForm (KitForm e -> KitForm e)
-> (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KitForm e -> KitForm e
forall e. KitForm e -> KitForm e
projectDescNewLine)
VtyEvent (V.EvKey V.KEnter []) ->
if KitForm e -> Bool
forall s e n. Form s e n -> Bool
allFieldsValid KitForm e
s
then BrickEvent SummonForm e
-> KitForm e
-> (KitForm e -> KitForm e)
-> EventM SummonForm (Next (KitForm e))
forall n e s s.
Eq n =>
BrickEvent n e
-> Form s e n -> (Form s e n -> s) -> EventM n (Next s)
withForm BrickEvent SummonForm e
ev KitForm e
s (Decision -> KitForm e -> KitForm e
forall e. Decision -> KitForm e -> KitForm e
changeShouldSummon Decision
Idk)
else KitForm e -> EventM SummonForm (Next (KitForm e))
forall s n. s -> EventM n (Next s)
continue KitForm e
s
VtyEvent (V.EvKey V.KEsc []) -> KitForm e -> EventM SummonForm (Next (KitForm e))
forall s n. s -> EventM n (Next s)
halt KitForm e
s
VtyEvent (V.EvKey (V.KChar 'd') [V.MCtrl]) ->
BrickEvent SummonForm e
-> KitForm e
-> (KitForm e -> KitForm e)
-> EventM SummonForm (Next (KitForm e))
forall n e s s.
Eq n =>
BrickEvent n e
-> Form s e n -> (Form s e n -> s) -> EventM n (Next s)
withForm BrickEvent SummonForm e
ev KitForm e
s (KitForm e -> KitForm e
forall e. KitForm e -> KitForm e
validateForm (KitForm e -> KitForm e)
-> (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KitForm e -> KitForm e
forall e. KitForm e -> KitForm e
ctrlD)
VtyEvent (V.EvKey (V.KChar ' ') []) -> case KitForm e -> Maybe SummonForm
forall s e n. Form s e n -> Maybe n
getCurrentFocus KitForm e
s of
Nothing -> BrickEvent SummonForm e
-> KitForm e -> EventM SummonForm (Next (KitForm e))
forall e.
BrickEvent SummonForm e
-> Form SummonKit e SummonForm
-> EventM SummonForm (Next (Form SummonKit e SummonForm))
withFormDef BrickEvent SummonForm e
ev KitForm e
s
Just field :: SummonForm
field -> BrickEvent SummonForm e
-> KitForm e -> SummonForm -> EventM SummonForm (Next (KitForm e))
forall e.
BrickEvent SummonForm e
-> KitForm e -> SummonForm -> EventM SummonForm (Next (KitForm e))
handleCheckboxActivation BrickEvent SummonForm e
ev KitForm e
s SummonForm
field
VtyEvent (V.EvKey key :: Key
key [])
| Key -> Bool
keyTriggersAutofill Key
key
-> BrickEvent SummonForm e
-> KitForm e
-> (KitForm e -> KitForm e)
-> EventM SummonForm (Next (KitForm e))
forall n e s s.
Eq n =>
BrickEvent n e
-> Form s e n -> (Form s e n -> s) -> EventM n (Next s)
withForm BrickEvent SummonForm e
ev KitForm e
s (KitForm e -> KitForm e
forall e. KitForm e -> KitForm e
validateForm (KitForm e -> KitForm e)
-> (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KitForm e -> KitForm e
forall e. KitForm e -> KitForm e
handleAutofill)
MouseDown n :: SummonForm
n _ _ _ -> BrickEvent SummonForm e
-> KitForm e -> SummonForm -> EventM SummonForm (Next (KitForm e))
forall e.
BrickEvent SummonForm e
-> KitForm e -> SummonForm -> EventM SummonForm (Next (KitForm e))
handleCheckboxActivation BrickEvent SummonForm e
ev KitForm e
s SummonForm
n
VtyEvent (V.EvKey (V.KChar '\t') []) -> BrickEvent SummonForm e
-> KitForm e -> EventM SummonForm (Next (KitForm e))
forall e.
BrickEvent SummonForm e
-> Form SummonKit e SummonForm
-> EventM SummonForm (Next (Form SummonKit e SummonForm))
loopWhileInactive BrickEvent SummonForm e
ev KitForm e
s
VtyEvent (V.EvKey V.KBackTab []) -> BrickEvent SummonForm e
-> KitForm e -> EventM SummonForm (Next (KitForm e))
forall e.
BrickEvent SummonForm e
-> Form SummonKit e SummonForm
-> EventM SummonForm (Next (Form SummonKit e SummonForm))
loopWhileInactive BrickEvent SummonForm e
ev KitForm e
s
_ -> BrickEvent SummonForm e
-> KitForm e -> EventM SummonForm (Next (KitForm e))
forall e.
BrickEvent SummonForm e
-> Form SummonKit e SummonForm
-> EventM SummonForm (Next (Form SummonKit e SummonForm))
withFormDef BrickEvent SummonForm e
ev KitForm e
s
, appChooseCursor :: KitForm e
-> [CursorLocation SummonForm] -> Maybe (CursorLocation SummonForm)
appChooseCursor = (KitForm e -> FocusRing SummonForm)
-> KitForm e
-> [CursorLocation SummonForm]
-> Maybe (CursorLocation SummonForm)
forall n a.
Eq n =>
(a -> FocusRing n)
-> a -> [CursorLocation n] -> Maybe (CursorLocation n)
focusRingCursor KitForm e -> FocusRing SummonForm
forall s e n. Form s e n -> FocusRing n
formFocus
, appStartEvent :: KitForm e -> EventM SummonForm (KitForm e)
appStartEvent = KitForm e -> EventM SummonForm (KitForm e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, appAttrMap :: KitForm e -> AttrMap
appAttrMap = AttrMap -> KitForm e -> AttrMap
forall a b. a -> b -> a
const AttrMap
theMap
}
where
withForm :: BrickEvent n e
-> Form s e n -> (Form s e n -> s) -> EventM n (Next s)
withForm ev :: BrickEvent n e
ev s :: Form s e n
s f :: Form s e n -> s
f = BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forall n e s.
Eq n =>
BrickEvent n e -> Form s e n -> EventM n (Form s e n)
handleFormEvent BrickEvent n e
ev Form s e n
s EventM n (Form s e n)
-> (Form s e n -> EventM n (Next s)) -> EventM n (Next s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> EventM n (Next s)
forall s n. s -> EventM n (Next s)
continue (s -> EventM n (Next s))
-> (Form s e n -> s) -> Form s e n -> EventM n (Next s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form s e n -> s
f
withFormDef :: BrickEvent SummonForm e
-> Form SummonKit e SummonForm
-> EventM SummonForm (Next (Form SummonKit e SummonForm))
withFormDef ev :: BrickEvent SummonForm e
ev s :: Form SummonKit e SummonForm
s = BrickEvent SummonForm e
-> Form SummonKit e SummonForm
-> (Form SummonKit e SummonForm -> Form SummonKit e SummonForm)
-> EventM SummonForm (Next (Form SummonKit e SummonForm))
forall n e s s.
Eq n =>
BrickEvent n e
-> Form s e n -> (Form s e n -> s) -> EventM n (Next s)
withForm BrickEvent SummonForm e
ev Form SummonKit e SummonForm
s Form SummonKit e SummonForm -> Form SummonKit e SummonForm
forall e. KitForm e -> KitForm e
validateForm
changeShouldSummon :: Decision -> KitForm e -> KitForm e
changeShouldSummon :: Decision -> KitForm e -> KitForm e
changeShouldSummon newShould :: Decision
newShould f :: KitForm e
f = SummonKit -> KitForm e
forall e. SummonKit -> KitForm e
mkForm (SummonKit -> KitForm e) -> SummonKit -> KitForm e
forall a b. (a -> b) -> a -> b
$ KitForm e -> SummonKit
forall s e n. Form s e n -> s
formState KitForm e
f SummonKit -> (SummonKit -> SummonKit) -> SummonKit
forall a b. a -> (a -> b) -> b
& (Decision -> Identity Decision) -> SummonKit -> Identity SummonKit
forall s a. HasShouldSummon s a => Lens' s a
shouldSummon ((Decision -> Identity Decision)
-> SummonKit -> Identity SummonKit)
-> Decision -> SummonKit -> SummonKit
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Decision
newShould
validateForm :: KitForm e -> KitForm e
validateForm :: KitForm e -> KitForm e
validateForm = [FilePath] -> KitForm e -> KitForm e
forall e. [FilePath] -> KitForm e -> KitForm e
summonFormValidation [FilePath]
dirs
mkNewForm :: KitForm e -> KitForm e
mkNewForm :: KitForm e -> KitForm e
mkNewForm = (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall e. (KitForm e -> KitForm e) -> KitForm e -> KitForm e
recreateForm KitForm e -> KitForm e
forall e. KitForm e -> KitForm e
validateForm
handleCheckboxActivation
:: BrickEvent SummonForm e
-> KitForm e
-> SummonForm
-> EventM SummonForm (Next (KitForm e))
handleCheckboxActivation :: BrickEvent SummonForm e
-> KitForm e -> SummonForm -> EventM SummonForm (Next (KitForm e))
handleCheckboxActivation ev :: BrickEvent SummonForm e
ev form :: KitForm e
form = \case
CabalField -> BrickEvent SummonForm e
-> KitForm e
-> (KitForm e -> KitForm e)
-> EventM SummonForm (Next (KitForm e))
forall n e s s.
Eq n =>
BrickEvent n e
-> Form s e n -> (Form s e n -> s) -> EventM n (Next s)
withForm BrickEvent SummonForm e
ev KitForm e
form KitForm e -> KitForm e
forall e. KitForm e -> KitForm e
mkNewForm
StackField -> BrickEvent SummonForm e
-> KitForm e
-> (KitForm e -> KitForm e)
-> EventM SummonForm (Next (KitForm e))
forall n e s s.
Eq n =>
BrickEvent n e
-> Form s e n -> (Form s e n -> s) -> EventM n (Next s)
withForm BrickEvent SummonForm e
ev KitForm e
form KitForm e -> KitForm e
forall e. KitForm e -> KitForm e
mkNewForm
GitHubEnable -> BrickEvent SummonForm e
-> KitForm e
-> (KitForm e -> KitForm e)
-> EventM SummonForm (Next (KitForm e))
forall n e s s.
Eq n =>
BrickEvent n e
-> Form s e n -> (Form s e n -> s) -> EventM n (Next s)
withForm BrickEvent SummonForm e
ev KitForm e
form KitForm e -> KitForm e
forall e. KitForm e -> KitForm e
mkNewForm
GitHubDisable -> BrickEvent SummonForm e
-> KitForm e
-> (KitForm e -> KitForm e)
-> EventM SummonForm (Next (KitForm e))
forall n e s s.
Eq n =>
BrickEvent n e
-> Form s e n -> (Form s e n -> s) -> EventM n (Next s)
withForm BrickEvent SummonForm e
ev KitForm e
form KitForm e -> KitForm e
forall e. KitForm e -> KitForm e
mkNewForm
GitHubNoUpload -> BrickEvent SummonForm e
-> KitForm e
-> (KitForm e -> KitForm e)
-> EventM SummonForm (Next (KitForm e))
forall n e s s.
Eq n =>
BrickEvent n e
-> Form s e n -> (Form s e n -> s) -> EventM n (Next s)
withForm BrickEvent SummonForm e
ev KitForm e
form KitForm e -> KitForm e
forall e. KitForm e -> KitForm e
mkNewForm
_ -> BrickEvent SummonForm e
-> KitForm e -> EventM SummonForm (Next (KitForm e))
forall e.
BrickEvent SummonForm e
-> Form SummonKit e SummonForm
-> EventM SummonForm (Next (Form SummonKit e SummonForm))
withFormDef BrickEvent SummonForm e
ev KitForm e
form
loopWhileInactive
:: BrickEvent SummonForm e
-> KitForm e
-> EventM SummonForm (Next (KitForm e))
loopWhileInactive :: BrickEvent SummonForm e
-> KitForm e -> EventM SummonForm (Next (KitForm e))
loopWhileInactive ev :: BrickEvent SummonForm e
ev form :: KitForm e
form = do
KitForm e
newForm <- BrickEvent SummonForm e
-> KitForm e -> EventM SummonForm (KitForm e)
forall n e s.
Eq n =>
BrickEvent n e -> Form s e n -> EventM n (Form s e n)
handleFormEvent BrickEvent SummonForm e
ev KitForm e
form
case KitForm e -> Maybe SummonForm
forall s e n. Form s e n -> Maybe n
getCurrentFocus KitForm e
newForm of
Nothing -> KitForm e -> EventM SummonForm (Next (KitForm e))
forall s n. s -> EventM n (Next s)
continue KitForm e
newForm
Just field :: SummonForm
field -> if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SummonKit -> SummonForm -> Bool
isActive (KitForm e -> SummonKit
forall s e n. Form s e n -> s
formState KitForm e
newForm) SummonForm
field
then BrickEvent SummonForm e
-> KitForm e -> EventM SummonForm (Next (KitForm e))
forall e.
BrickEvent SummonForm e
-> Form SummonKit e SummonForm
-> EventM SummonForm (Next (Form SummonKit e SummonForm))
loopWhileInactive BrickEvent SummonForm e
ev KitForm e
newForm
else KitForm e -> EventM SummonForm (Next (KitForm e))
forall s n. s -> EventM n (Next s)
continue KitForm e
newForm
keyTriggersAutofill :: V.Key -> Bool
keyTriggersAutofill :: Key -> Bool
keyTriggersAutofill (V.KChar _) = Bool
True
keyTriggersAutofill V.KBS = Bool
True
keyTriggersAutofill _ = Bool
False
drawNew :: [FilePath] -> KitForm e -> [Widget SummonForm]
drawNew :: [FilePath] -> KitForm e -> [Widget SummonForm]
drawNew dirs :: [FilePath]
dirs kitForm :: KitForm e
kitForm = case SummonKit
kit SummonKit -> Getting Decision SummonKit Decision -> Decision
forall s a. s -> Getting a s a -> a
^. Getting Decision SummonKit Decision
forall s a. HasShouldSummon s a => Lens' s a
shouldSummon of
Idk -> [Widget SummonForm
confirmDialog]
_ -> [Widget SummonForm
formWidget]
where
kit :: SummonKit
kit :: SummonKit
kit = KitForm e -> SummonKit
forall s e n. Form s e n -> s
formState KitForm e
kitForm
confirmDialog :: Widget SummonForm
confirmDialog :: Widget SummonForm
confirmDialog = Widget SummonForm -> Widget SummonForm
forall n. Widget n -> Widget n
center (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ Int -> Widget SummonForm -> Widget SummonForm
forall n. Int -> Widget n -> Widget n
hLimit 55 (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ FilePath -> Widget SummonForm -> Widget SummonForm
forall n. FilePath -> Widget n -> Widget n
borderLabel "Confirm" (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ Int -> Widget SummonForm -> Widget SummonForm
forall n. Int -> Widget n -> Widget n
padTopBottom 2 (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ [Widget SummonForm] -> Widget SummonForm
forall n. [Widget n] -> Widget n
vBox
[ FilePath -> Widget SummonForm
forall n. FilePath -> Widget n
str "• Enter – Press Enter to create the project"
, FilePath -> Widget SummonForm
forall n. FilePath -> Widget n
str "• Esc – Or Esc to go back to settings"
]
formWidget :: Widget SummonForm
formWidget :: Widget SummonForm
formWidget = [Widget SummonForm] -> Widget SummonForm
forall n. [Widget n] -> Widget n
vBox
[ Widget SummonForm
form Widget SummonForm -> Widget SummonForm -> Widget SummonForm
forall n. Widget n -> Widget n -> Widget n
<+> Widget SummonForm
tree
, Widget SummonForm
status Widget SummonForm -> Widget SummonForm -> Widget SummonForm
forall n. Widget n -> Widget n -> Widget n
<+> Widget SummonForm
help
]
form :: Widget SummonForm
form :: Widget SummonForm
form = FilePath -> Widget SummonForm -> Widget SummonForm
forall n. FilePath -> Widget n -> Widget n
borderLabel "Summon new project" (KitForm e -> Widget SummonForm
forall n s e. Eq n => Form s e n -> Widget n
renderForm KitForm e
kitForm)
tree :: Widget SummonForm
tree :: Widget SummonForm
tree = Int -> Widget SummonForm -> Widget SummonForm
forall n. Int -> Widget n -> Widget n
hLimitPercent 25 (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ Int -> Widget SummonForm -> Widget SummonForm
forall n. Int -> Widget n -> Widget n
vLimit 22 (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ FilePath -> Widget SummonForm -> Widget SummonForm
forall n. FilePath -> Widget n -> Widget n
borderLabel "Project Structure" (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ [Widget SummonForm] -> Widget SummonForm
forall n. [Widget n] -> Widget n
vBox
[ AttrName -> Widget SummonForm -> Widget SummonForm
forall n. AttrName -> Widget n -> Widget n
withAttr "tree" (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ Text -> Widget SummonForm
forall n. Text -> Widget n
txt (Text -> Widget SummonForm) -> Text -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ SummonKit -> Text
renderWidgetTree SummonKit
kit
, Char -> Widget SummonForm
forall n. Char -> Widget n
fill ' '
]
status :: Widget SummonForm
status :: Widget SummonForm
status = Int -> Widget SummonForm -> Widget SummonForm
forall n. Int -> Widget n -> Widget n
hLimitPercent 45 (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$
FilePath -> Widget SummonForm -> Widget SummonForm
forall n. FilePath -> Widget n -> Widget n
borderLabel "Status" (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ [Widget SummonForm] -> Widget SummonForm
forall n. [Widget n] -> Widget n
vBox
[ Widget SummonForm
informationBlock
, Widget SummonForm
validationBlock
, Widget SummonForm
configBlock
, Char -> Widget SummonForm
forall n. Char -> Widget n
fill ' '
]
where
informationBlock :: Widget SummonForm
informationBlock :: Widget SummonForm
informationBlock = case KitForm e -> Maybe SummonForm
forall s e n. Form s e n -> Maybe n
getCurrentFocus KitForm e
kitForm of
Just UserOwner -> Text -> Widget SummonForm
infoTxt "GitHub username"
Just ProjectCat -> Text -> Widget SummonForm
infoTxt "Comma-separated categories as used at Hackage"
Just Ghcs -> Text -> Widget SummonForm
infoTxt "Space separated GHC versions"
_ -> Widget SummonForm
forall n. Widget n
emptyWidget
infoTxt :: Text -> Widget SummonForm
infoTxt :: Text -> Widget SummonForm
infoTxt = AttrName -> Widget SummonForm -> Widget SummonForm
forall n. AttrName -> Widget n -> Widget n
withAttr "blue-fg" (Widget SummonForm -> Widget SummonForm)
-> (Text -> Widget SummonForm) -> Text -> Widget SummonForm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget SummonForm
forall n. Text -> Widget n
txtWrap (Text -> Widget SummonForm)
-> (Text -> Text) -> Text -> Widget SummonForm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) " ⓘ "
validationBlock :: Widget SummonForm
validationBlock :: Widget SummonForm
validationBlock = [Widget SummonForm] -> Widget SummonForm
forall n. [Widget n] -> Widget n
vBox ([Widget SummonForm] -> Widget SummonForm)
-> [Widget SummonForm] -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ case [FilePath] -> KitForm e -> [FilePath]
forall e. [FilePath] -> KitForm e -> [FilePath]
formErrorMessages [FilePath]
dirs KitForm e
kitForm of
[] -> [AttrName -> Widget SummonForm -> Widget SummonForm
forall n. AttrName -> Widget n -> Widget n
withAttr "green-fg" (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ FilePath -> Widget SummonForm
forall n. FilePath -> Widget n
str " ✔ Project configuration is valid"]
fields :: [FilePath]
fields -> (FilePath -> Widget SummonForm)
-> [FilePath] -> [Widget SummonForm]
forall a b. (a -> b) -> [a] -> [b]
map (\msg :: FilePath
msg -> AttrName -> Widget SummonForm -> Widget SummonForm
forall n. AttrName -> Widget n -> Widget n
withAttr "red-fg" (Widget SummonForm -> Widget SummonForm)
-> Widget SummonForm -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ FilePath -> Widget SummonForm
forall n. FilePath -> Widget n
strWrap (FilePath -> Widget SummonForm) -> FilePath -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ " ☓ " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg) [FilePath]
fields
configBlock :: Widget SummonForm
configBlock :: Widget SummonForm
configBlock = case SummonKit
kit SummonKit
-> Getting (Maybe FilePath) SummonKit (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^. Getting (Maybe FilePath) SummonKit (Maybe FilePath)
forall s a. HasConfigFile s a => Lens' s a
configFile of
Nothing -> Widget SummonForm
forall n. Widget n
emptyWidget
Just file :: FilePath
file -> Text -> Widget SummonForm
infoTxt (Text -> Widget SummonForm) -> Text -> Widget SummonForm
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " file is used"
help, helpBody :: Widget SummonForm
help :: Widget SummonForm
help = FilePath -> Widget SummonForm -> Widget SummonForm
forall n. FilePath -> Widget n -> Widget n
borderLabel "Help" (Widget SummonForm
helpBody Widget SummonForm -> Widget SummonForm -> Widget SummonForm
forall n. Widget n -> Widget n -> Widget n
<+> Char -> Widget SummonForm
forall n. Char -> Widget n
fill ' ')
helpBody :: Widget SummonForm
helpBody = [Widget SummonForm] -> Widget SummonForm
forall n. [Widget n] -> Widget n
vBox
[ FilePath -> Widget SummonForm
forall n. FilePath -> Widget n
str "• Enter : create the project"
, FilePath -> Widget SummonForm
forall n. FilePath -> Widget n
str "• Esc : quit"
, FilePath -> Widget SummonForm
forall n. FilePath -> Widget n
str "• Ctrl+d : remove input of the text field"
, FilePath -> Widget SummonForm
forall n. FilePath -> Widget n
str "• Arrows : up/down arrows to choose license"
, FilePath -> Widget SummonForm
forall n. FilePath -> Widget n
str "• Alt+Enter : switch to new line"
]
summonTuiShow :: ShowOpts -> IO ()
summonTuiShow :: ShowOpts -> IO ()
summonTuiShow = \case
GhcList -> IO ()
runTuiShowGhcVersions
LicenseList Nothing -> IO ()
runTuiShowAllLicenses
LicenseList (Just name :: FilePath
name) -> FilePath -> IO ()
runTuiShowLicense FilePath
name
runTuiShowGhcVersions :: IO ()
runTuiShowGhcVersions :: IO ()
runTuiShowGhcVersions = Widget () -> IO ()
forall n. Ord n => Widget n -> IO ()
runSimpleApp Widget ()
drawGhcVersions
where
drawGhcVersions :: Widget ()
drawGhcVersions :: Widget ()
drawGhcVersions = FilePath -> Int -> Int -> [Text] -> Widget ()
forall n. FilePath -> Int -> Int -> [Text] -> Widget n
listInBorder "Supported GHC versions" 60 0 [Text]
ghcTable
runTuiShowAllLicenses :: IO ()
runTuiShowAllLicenses :: IO ()
runTuiShowAllLicenses = Widget () -> IO ()
forall n. Ord n => Widget n -> IO ()
runSimpleApp Widget ()
drawLicenseNames
where
drawLicenseNames :: Widget ()
drawLicenseNames :: Widget ()
drawLicenseNames = FilePath -> Int -> Int -> [Text] -> Widget ()
forall n. FilePath -> Int -> Int -> [Text] -> Widget n
listInBorder "Supported licenses" 70 4 ((LicenseName -> Text) -> [LicenseName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map LicenseName -> Text
showLicenseWithDesc [LicenseName]
forall a. (Bounded a, Enum a) => [a]
universe)
runTuiShowLicense :: String -> IO ()
runTuiShowLicense :: FilePath -> IO ()
runTuiShowLicense (FilePath -> Text
forall a. ToText a => a -> Text
toText -> Text
name) = case Text -> Maybe LicenseName
parseLicenseName Text
name of
Nothing -> do
Text -> IO ()
errorMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Error parsing license name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
Text -> IO ()
infoMessage "Use 'summon show license' command to see the list of all available licenses"
Just licenseName :: LicenseName
licenseName -> do
License
lc <- LicenseName -> IO License
getCustomLicenseText LicenseName
licenseName
App () Any () -> () -> IO ()
forall n s e. Ord n => App s e n -> s -> IO s
runApp (LicenseName -> License -> App () Any ()
forall e. LicenseName -> License -> App () e ()
licenseApp LicenseName
licenseName License
lc) ()
where
licenseApp :: LicenseName -> License -> App () e ()
licenseApp :: LicenseName -> License -> App () e ()
licenseApp licenseName :: LicenseName
licenseName lc :: License
lc = App :: forall s e n.
(s -> [Widget n])
-> (s -> [CursorLocation n] -> Maybe (CursorLocation n))
-> (s -> BrickEvent n e -> EventM n (Next s))
-> (s -> EventM n s)
-> (s -> AttrMap)
-> App s e n
App
{ appDraw :: () -> [Widget ()]
appDraw = LicenseName -> License -> () -> [Widget ()]
drawScrollableLicense LicenseName
licenseName License
lc
, appStartEvent :: () -> EventM () ()
appStartEvent = () -> EventM () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, appAttrMap :: () -> AttrMap
appAttrMap = AttrMap -> () -> AttrMap
forall a b. a -> b -> a
const AttrMap
theMap
, appChooseCursor :: () -> [CursorLocation ()] -> Maybe (CursorLocation ())
appChooseCursor = () -> [CursorLocation ()] -> Maybe (CursorLocation ())
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
neverShowCursor
, appHandleEvent :: () -> BrickEvent () e -> EventM () (Next ())
appHandleEvent = \() event :: BrickEvent () e
event -> case BrickEvent () e
event of
VtyEvent (V.EvKey V.KDown []) -> ViewportScroll () -> Int -> EventM () ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy ViewportScroll ()
licenseScroll 1 EventM () () -> EventM () (Next ()) -> EventM () (Next ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> EventM () (Next ())
forall s n. s -> EventM n (Next s)
continue ()
VtyEvent (V.EvKey V.KUp []) -> ViewportScroll () -> Int -> EventM () ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy ViewportScroll ()
licenseScroll (-1) EventM () () -> EventM () (Next ()) -> EventM () (Next ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> EventM () (Next ())
forall s n. s -> EventM n (Next s)
continue ()
VtyEvent (V.EvKey V.KEsc []) -> () -> EventM () (Next ())
forall s n. s -> EventM n (Next s)
halt ()
_ -> () -> EventM () (Next ())
forall s n. s -> EventM n (Next s)
continue ()
}
licenseScroll :: ViewportScroll ()
licenseScroll :: ViewportScroll ()
licenseScroll = () -> ViewportScroll ()
forall n. n -> ViewportScroll n
viewportScroll ()
drawScrollableLicense :: LicenseName -> License -> () -> [Widget ()]
drawScrollableLicense :: LicenseName -> License -> () -> [Widget ()]
drawScrollableLicense licenseName :: LicenseName
licenseName (License lc :: Text
lc) = [Widget ()] -> () -> [Widget ()]
forall a b. a -> b -> a
const [Widget ()
ui]
where
ui :: Widget ()
ui :: Widget ()
ui = Widget () -> Widget ()
forall n. Widget n -> Widget n
center
(Widget () -> Widget ()) -> Widget () -> Widget ()
forall a b. (a -> b) -> a -> b
$ Int -> Widget () -> Widget ()
forall n. Int -> Widget n -> Widget n
hLimit 80
(Widget () -> Widget ()) -> Widget () -> Widget ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Widget () -> Widget ()
forall n. FilePath -> Widget n -> Widget n
borderLabel ("License: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ LicenseName -> FilePath
forall b a. (Show a, IsString b) => a -> b
show LicenseName
licenseName)
(Widget () -> Widget ()) -> Widget () -> Widget ()
forall a b. (a -> b) -> a -> b
$ () -> ViewportType -> Widget () -> Widget ()
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport () ViewportType
Vertical
(Widget () -> Widget ()) -> Widget () -> Widget ()
forall a b. (a -> b) -> a -> b
$ [Widget ()] -> Widget ()
forall n. [Widget n] -> Widget n
vBox
([Widget ()] -> Widget ()) -> [Widget ()] -> Widget ()
forall a b. (a -> b) -> a -> b
$ (Text -> Widget ()) -> [Text] -> [Widget ()]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: Text
t -> if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "" then Text -> Widget ()
forall n. Text -> Widget n
txt "\n" else Text -> Widget ()
forall n. Text -> Widget n
txtWrap Text
t)
([Text] -> [Widget ()]) -> [Text] -> [Widget ()]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
forall t. IsText t "lines" => t -> [t]
lines Text
lc
runApp :: Ord n => App s e n -> s -> IO s
runApp :: App s e n -> s -> IO s
runApp app :: App s e n
app s :: s
s = do
Vty
initialVty <- IO Vty
buildVty
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
customMain Vty
initialVty IO Vty
buildVty Maybe (BChan e)
forall a. Maybe a
Nothing App s e n
app s
s
where
buildVty :: IO V.Vty
buildVty :: IO Vty
buildVty = do
Vty
v <- Config -> IO Vty
V.mkVty (Config -> IO Vty) -> IO Config -> IO Vty
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Config
V.standardIOConfig
Output -> Mode -> Bool -> IO ()
V.setMode (Vty -> Output
V.outputIface Vty
v) Mode
V.Mouse Bool
True
Vty -> IO Vty
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vty
v
runSimpleApp :: Ord n => Widget n -> IO ()
runSimpleApp :: Widget n -> IO ()
runSimpleApp w :: Widget n
w = App () Any n -> () -> IO ()
forall n s e. Ord n => App s e n -> s -> IO s
runApp (Widget n -> App () Any n
forall n e. Widget n -> App () e n
mkSimpleApp Widget n
w) ()
mkSimpleApp :: Widget n -> App () e n
mkSimpleApp :: Widget n -> App () e n
mkSimpleApp w :: Widget n
w = (Widget n -> App () e n
forall n s e. Widget n -> App s e n
simpleApp Widget n
w)
{ appAttrMap :: () -> AttrMap
appAttrMap = AttrMap -> () -> AttrMap
forall a b. a -> b -> a
const AttrMap
theMap
}
theMap :: AttrMap
theMap :: AttrMap
theMap = Attr -> [(AttrName, Attr)] -> AttrMap
attrMap Attr
V.defAttr
[ (AttrName
editAttr, Color
V.black Color -> Color -> Attr
`Brick.on` Color
V.cyan)
, (AttrName
editFocusedAttr, Color
V.black Color -> Color -> Attr
`Brick.on` Color
V.white)
, (AttrName
invalidFormInputAttr, Color
V.white Color -> Color -> Attr
`Brick.on` Color
V.red)
, (AttrName
focusedFormInputAttr, Color
V.black Color -> Color -> Attr
`Brick.on` Color
V.yellow)
, (AttrName
listSelectedAttr, Color
V.black Color -> Color -> Attr
`Brick.on` Color
V.cyan)
, (AttrName
listSelectedFocusedAttr, Color
V.black Color -> Color -> Attr
`Brick.on` Color
V.white)
, (AttrName
disabledAttr, Color -> Attr
fg Color
V.brightBlack)
, ("blue-fg", Color -> Attr
fg Color
V.blue)
, ("green-fg", Color -> Attr
fg Color
V.green)
, ("yellow-fg", Color -> Attr
fg Color
V.yellow)
, ("red-fg", Color -> Attr
fg Color
V.brightRed)
, (AttrName
borderAttr, Color -> Attr
fg Color
V.cyan)
, ("tree", Color -> Attr
fg Color
V.cyan)
]