trilby-cli: update terminal-widgets

ners · Feb 21, 2024 · 8808276 · 8808276
1 parent cccc1d1
commit 8808276
Show file tree

Hide file tree

Showing 5 changed files with 52 additions and 32 deletions.
diff --git a/flake.lock b/flake.lock
diff --git a/trilby-cli/flake.lock b/trilby-cli/flake.lock
diff --git a/trilby-cli/src/Internal/Prelude.hs b/trilby-cli/src/Internal/Prelude.hs
@@ -31,6 +31,7 @@ module Internal.Prelude
     , parseChoiceWith
     , parseChoice
     , parseEnum
+    , runWidget
     , askText
     , askPassword
     , askYesNo
@@ -200,12 +201,14 @@ askChoice prompt values defaultValue = do
         runWidget
             Select
                 { prompt
-                , options = [(ishow v, False) | v <- values]
-                , multiselect = False
+                , options = [SelectOption{value, checked = False} | value <- values]
+                , optionText = ishow
+                , minSelect = 1
+                , maxSelect = 1
                 , cursorRow = defaultValue + 1
                 }
     fromMaybeM (askChoice prompt values defaultValue) $ pure do
-        i <- List.findIndex snd select.options
+        i <- List.findIndex (.checked) select.options
         values !? i
 
 askEnum :: (Eq a, Bounded a, Enum a, Show a) => Text -> a -> App a

diff --git a/trilby-cli/src/Trilby/Install.hs b/trilby-cli/src/Trilby/Install.hs
@@ -69,8 +69,8 @@ install (askOpts -> opts) | Just FlakeOpts{..} <- opts.flake = do
     let rootIsMounted = (ExitSuccess ==) . fst <$> cmd' ["mountpoint", "-q", fromString rootMount]
     unlessM rootIsMounted do
         $(logWarn) "Partitions are not mounted"
-        unlessM (askYesNo "Attempt to mount the partitions?" True) $
-            errorExit "Cannot install without mounted partitions"
+        unlessM (askYesNo "Attempt to mount the partitions?" True)
+            $ errorExit "Cannot install without mounted partitions"
         runDisko $ Mount $ Disko.Flake flakeRef
     nixosInstall flakeRef
     whenM copyFlake do
@@ -88,8 +88,8 @@ install (askOpts -> opts) = do
     let rootIsMounted = (ExitSuccess ==) . fst <$> cmd' ["mountpoint", "-q", fromString rootMount]
     unlessM rootIsMounted do
         $(logWarn) "Partitions are not mounted"
-        unlessM (askYesNo "Attempt to mount the partitions?" True) $
-            errorExit "Cannot install without mounted partitions"
+        unlessM (askYesNo "Attempt to mount the partitions?" True)
+            $ errorExit "Cannot install without mounted partitions"
         runDisko $ Mount $ Disko.File diskoFile
     inDir trilbyDir do
         asRoot cmd_ ["chown", "-R", "1000:1000", fromString trilbyDir]
@@ -134,8 +134,8 @@ install (askOpts -> opts) = do
                     , fromString rootMount
                     ]
             writeNixFile "disko.nix" $ clearLuksFiles disko
-        cmd_ $
-            sconcat
+        cmd_
+            $ sconcat
                 [ ["nix", "flake", "lock"]
                 , ["--accept-flake-config"]
                 , ["--override-input", "trilby", "trilby"]
@@ -147,8 +147,8 @@ nixosInstall :: Text -> App ()
 nixosInstall flakeRef = do
     $(logWarn) "Performing installation ... "
     -- TODO(vkleen): this shouldn't work and neither should it be necessary ...
-    (withTrace . asRoot) rawCmd_ $
-        sconcat
+    (withTrace . asRoot) rawCmd_
+        $ sconcat
             [ ["nix", "build"]
             , ["--store", "/mnt"]
             , ["--impure"]

diff --git a/trilby-cli/src/Trilby/Install/Options.hs b/trilby-cli/src/Trilby/Install/Options.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
 {-# OPTIONS_GHC -Wno-partial-fields #-}
 
 module Trilby.Install.Options where
@@ -7,6 +8,7 @@ import Data.Text qualified as Text
 import Internal.Prelude hiding (error)
 import Options.Applicative
 import System.Posix (getFileStatus, isBlockDevice)
+import System.Terminal.Widgets.SearchSelect (SearchSelect (..), SearchSelectOption (..))
 import Trilby.Config.Channel
 import Trilby.Config.Edition
 import Trilby.Config.Host (Keyboard (..))
@@ -137,13 +139,28 @@ askLocale = do
 askTimezone :: App Text
 askTimezone = do
     currentTz <- firstLine <$> shell "timedatectl show --property=Timezone --value" empty
-    tz <- askText "Choose time zone:" currentTz
     allTimezones <- Text.lines <$> shell "timedatectl list-timezones" empty
-    if tz `elem` allTimezones
-        then pure tz
-        else do
-            $(logError) "Unknown timezone"
-            askTimezone
+    ss <-
+        runWidget
+            SearchSelect
+                { prompt = "Choose time zone: "
+                , searchValue = ""
+                , options =
+                    [ SearchSelectOption
+                        { value
+                        , visible = False
+                        }
+                    | value <- allTimezones
+                    ]
+                , selections = [currentTz]
+                , optionText = id
+                , minSelect = 1
+                , maxSelect = 1
+                , maxVisible = 5
+                , minSearchLength = 3
+                , cursorRow = 0
+                }
+    maybe askTimezone pure $ listToMaybe ss.selections
 
 askOpts :: InstallOpts Maybe -> InstallOpts App
 askOpts opts = do