wrapping up first draft of Menu.menu1 and groupMenu1

parser-typechecker/src/Unison/Codebase/CommandLine.hs

@@ -250,7 +250,8 @@ main dir currentBranchName initialFile startRuntime codebase = do
               putStrLn $ "There's more than one thing called " ++ from ++ "."
               putStrLn $ "Use `> <command to resolve conflicts> unname " ++ from ++ "` to resolve conflicts, then try again."
               go' branch
-        _ -> error $ "todo" ++ "help:"
+        [] -> go branch name
+        x -> putStrLn ("I don't know how to " ++ unwords x ++ ".") *> go branch name
 
 -- should never block
 peekIncompleteLine :: TQueue Char -> STM String
@@ -321,9 +322,6 @@ selectBranch codebase name takeLine = do
             "The branch " ++ show name ++ " doesn't exist. " ++
              "Do you want to create it, or pick a different one?"
       branches <- Codebase.branches codebase
-      -- choice <- singleChoice (((unpack <$> branches) `zip` (Right <$> branches)) ++
-      --               [("create it", Left True)
-      --               ,("cancel", Left False)]) (Just $ "create it") takeLine
       choice <- branchMenu caption branches
       case choice of
         Just (Left Cancel) -> pure Nothing

parser-typechecker/src/Unison/Util/AnnotatedText.hs

@@ -1,22 +1,23 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies      #-}
-{-# LANGUAGE DeriveFunctor     #-}
+{-# LANGUAGE DeriveFoldable             #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TypeFamilies               #-}
 
 module Unison.Util.AnnotatedText where
 
-import           Data.Foldable (asum, foldl')
-import           Data.Sequence (Seq ((:|>)))
-import qualified Data.Sequence as Seq
-import           Data.Map (Map)
-import qualified Data.Map as Map
-import           Data.String (IsString (..))
-import           Data.Void (Void)
-import           Safe (lastMay)
-import           Unison.Lexer (Line, Pos (..))
+import           Data.Foldable      (asum, foldl')
+import           Data.Map           (Map)
+import qualified Data.Map           as Map
+import           Data.Sequence      (Seq ((:|>)))
+import qualified Data.Sequence      as Seq
+import           Data.String        (IsString (..))
+import           Data.Void          (Void)
+import           Safe               (lastMay)
+import           Unison.Lexer       (Line, Pos (..))
 import           Unison.Util.Monoid (intercalateMap)
-import           Unison.Util.Range (Range (..))
+import           Unison.Util.Range  (Range (..))
 
 newtype AnnotatedDocument a = AnnotatedDocument (Seq (Section a))
   deriving (Functor, Semigroup, Monoid)
@@ -39,7 +40,7 @@ data Section a
   deriving (Functor)
 
 newtype AnnotatedText a = AnnotatedText (Seq (String, a))
-  deriving (Functor, Semigroup, Monoid)
+  deriving (Functor, Foldable, Semigroup, Monoid)
 
 data AnnotatedExcerpt a = AnnotatedExcerpt
   { lineOffset  :: Line
@@ -83,6 +84,12 @@ renderTextUnstyled :: AnnotatedText a -> Rendered Void
 renderTextUnstyled (AnnotatedText chunks) = foldl' go mempty chunks
   where go r (text, _) = r <> fromString text
 
+textLength :: AnnotatedText a -> Int
+textLength = length . show . renderTextUnstyled
+
+textEmpty :: AnnotatedText a -> Bool
+textEmpty = (==0) . textLength
+
 splitAndRender :: Int
                -> (AnnotatedExcerpt a -> Rendered b)
                -> AnnotatedExcerpt a -> Rendered b

parser-typechecker/src/Unison/Util/Menu.hs

@@ -1,16 +1,19 @@
 {-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE OverloadedLists     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 
-module Unison.Util.Menu (menu1, menuN) where
+module Unison.Util.Menu (menu1, menuN, groupMenu1) where
 
+import           Control.Monad         (when)
 import           Data.List             (find, isPrefixOf)
 import           Data.String           (IsString, fromString)
 import           Data.Strings          (strPadLeft)
 import           Safe                  (atMay)
 import qualified Text.Read             as Read
 import           Unison.Util.ColorText (StyledText, renderText)
+import           Unison.Util.AnnotatedText (textEmpty)
 import           Unison.Util.Monoid    (intercalateMap)
 -- utility - command line menus
 
@@ -27,9 +30,11 @@ renderChoices :: forall a mc
               -> (Keyword -> Bool)
               -> Stylized
 renderChoices render renderMeta groups metas isSelected =
-  intercalateMap "\n" format numberedGroups <> "\n\n" <>
-  intercalateMap " " (("["<>) . (<>"]") . renderMeta . snd) metas
+  showGroups <> showMetas
   where
+    showGroups = intercalateMap "\n" format numberedGroups <>
+      if (not.null) groups && (not.null) metas then "\n\n" else ""
+    showMetas = intercalateMap "\n" (("["<>) . (<>"]") . renderMeta . snd) metas
     numberedGroups :: [(([Keyword], [a]), Int)]
     numberedGroups = zip groups [1..]
     numberWidth = ceiling @Double . logBase 10 . fromIntegral $ length groups
@@ -38,7 +43,7 @@ renderChoices render renderMeta groups metas isSelected =
       intercalateMap
         "\n"
         (format1 number (length as) (any isSelected keywords))
-        (zip as [1..])
+        (zip as [0..])
     format1 :: Int -> Int -> Bool -> (a, Int) -> Stylized
     format1 groupNumber groupSize isSelected (a, index) =
       header <> bracket <> render a
@@ -48,15 +53,20 @@ renderChoices render renderMeta groups metas isSelected =
           (if representativeRow
             then (if isSelected then "*" else " ")
                   <> fromString (strPadLeft ' ' numberWidth (show groupNumber))
-            else fromString $ replicate (numberWidth + 1) ' ') <> ". "
+                  <> ". "
+            else fromString $ replicate (numberWidth + 3) ' ')
         representativeRow :: Bool
         representativeRow = index == 0 -- alternatively: index == groupSize - 1 `div` 2
         bracket :: IsString s => s
         bracket =
-          if groupSize == 1         then "·"
-          else if index == 1        then "┌"
-          else if index < groupSize then "│"
-          else                           "└"
+          if maxGroupSize > 1 then
+            if groupSize == 1             then "╶"
+            else if index == 0            then "┌"
+            else if index < groupSize - 1 then "│"
+            else                               "└"
+          else ""
+        maxGroupSize = maximum (length . snd <$> groups)
+
 
 {-
    <caption>
@@ -120,8 +130,7 @@ groupMenu1 console caption render renderMeta groups metas initial = do
       restart' caption groups metas initial =
                   groupMenu1 console caption render renderMeta groups metas initial
       resume = do
-        putStr $ if null initial then "Choose by number or prefix: "
-          else "Choose by number or prefix, or press Enter to use the current selection (*): "
+        putStr "\n>> "
         input <- console
         case words input of
           [] -> useExistingSelections groups initial
@@ -144,8 +153,10 @@ groupMenu1 console caption render renderMeta groups metas initial = do
             ([(_, as)],[]) -> pure (Just (Right as))
             ([], [(_, mc)]) -> pure (Just (Left mc))
             (groups, metas) ->
-              restart' "Please clarify your selection:" groups metas Nothing >>= \case
-                Nothing -> resume
+              restart'
+                "Please clarify your selection, or press Enter to back up:"
+                groups metas Nothing >>= \case
+                Nothing -> restart
                 x -> pure x
           matchingItems ::
             forall a mc. [([Keyword], [a])] -> [([Keyword], mc)] -> String
@@ -166,8 +177,9 @@ groupMenu1 console caption render renderMeta groups metas initial = do
           findMatchingGroup :: forall a. [Keyword] -> [([Keyword], [a])] -> Maybe [a]
           findMatchingGroup initials groups =
             snd <$> find (\(keywords, _as) -> any (`elem` keywords) initials) groups
-  print . renderText $ caption
-  putStrLn ""
+  when ((not . textEmpty) caption) $ do
+    print . renderText $ caption
+    putStrLn ""
   print . renderText $ renderChoices render renderMeta groups metas (`elem` initial)
   resume