stack-run 0.1.1.1 → 0.1.1.2
raw patch · 3 files changed
+271/−2 lines, 3 files
Files
- README.md +11/−1
- src/System/Console/Questioner.hs +258/−0
- stack-run.cabal +2/−1
README.md view
@@ -3,8 +3,10 @@ [](http://hackage.haskell.org/package/stack-run) [](http://packdeps.haskellers.com/feed?needle=stack-run) - - --Like `cabal run` but for `stack`.+**stack-run** is like `cabal run` but for `stack`. +Only **GHC** versions **>= 7.8** are currently supported.+ ## Installing ``` $ stack install stack-run@@ -15,6 +17,11 @@ $ stack run ``` +## Interactive Usage+```+$ stack run -i+```+ ## Help ``` $ stack run help@@ -22,6 +29,9 @@ ## Demo ++## Interactive Demo+ ## License This code is published under the MIT license.
+ src/System/Console/Questioner.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverlappingInstances #-}+module System.Console.Questioner+ (+ Question(..)++ , ChoiceEvent+ , charToChoiceEvent+ , listPrompt+ , checkboxPrompt++ , module System.Console.Questioner.ProgressIndicators+ )+ where++import Control.Applicative ((<$>))+import Control.Concurrent.STM+import Control.Monad (forM_, (>=>))+import Data.List (delete)+import Graphics.Vty (Event (..),+ Key (..),+ Modifier (..))+import qualified Graphics.Vty as Vty+import System.Console.ANSI (Color (..), ColorIntensity (..), ConsoleIntensity (..), ConsoleLayer (..),+ SGR (..),+ clearLine,+ cursorUpLine,+ setSGR)+import System.Console.Questioner.ProgressIndicators+import System.Console.Questioner.Util+import System.Exit+import System.IO (hFlush, stdin,+ stdout)++-- Base `Question` and `Question` instances+-------------------------------------------------------------------------------++class Question q a where+ prompt :: q -> IO a++instance {-# OVERLAPPABLE #-} Read a => Question String a where+ prompt = putStr . (++ " ") >=> const readLn++instance {-# OVERLAPPING #-} Question String String where+ prompt = putStr . (++ " ") >=> const getLine++instance {-# OVERLAPPING #-} Question String (Maybe String) where+ prompt = putStr . (++ " ") >=> const getLine >=> helper+ where+ helper [] = return Nothing+ helper s = return $ Just s++instance {-# OVERLAPPING #-} Question (String, (String, String)) String where+ prompt (s, (o1, o2)) = do+ putStr s+ putStr $ " (" ++ o1 ++ "/" ++ o2 ++ ") "+ getLine++instance {-# OVERLAPPING #-} Question (String, [String]) String where+ prompt = uncurry listPrompt++instance {-# OVERLAPPING #-} Question (String, [String]) [String] where+ prompt = uncurry checkboxPrompt++-- Multiple choice prompts+-------------------------------------------------------------------------------++data ChoiceEvent = MoveUp | MoveDown | MakeChoice | ToggleSelection | Exit+ deriving(Eq, Ord, Show)++charToChoiceEvent :: Char -> Maybe ChoiceEvent+charToChoiceEvent 'j' = Just MoveDown+charToChoiceEvent 'k' = Just MoveUp+charToChoiceEvent '\n' = Just MakeChoice+charToChoiceEvent ' ' = Just ToggleSelection+charToChoiceEvent _ = Nothing++-- simpleListPrompt options choices = setup $ do+-- inp <- Vty.inputForConfig =<< Vty.standardIOConfig+-- selection <- waitForSelection (Vty._eventChannel inp) 0+-- setSGR []+-- clearScreen+-- setCursorPosition 0 0+-- Vty.shutdownInput inp+-- return selection+-- where+-- setup = withNoBuffering stdin NoBuffering . withNoCursor . withNoEcho+-- numChoices = length choices++-- waitForSelection ichan currentIdx = do+-- clearScreen+-- renderListOptions options def choices currentIdx+-- e <- atomically $ readTChan ichan+-- case e of+-- EvKey KEnter _ -> return $ Just (choices !! currentIdx)+-- EvKey (KChar 'n') [MCtrl] -> onDown+-- EvKey (KChar 'j') _ -> onDown+-- EvKey KDown _ -> onDown+-- EvKey (KChar 'p') [MCtrl] -> onUp+-- EvKey (KChar 'k') _ -> onUp+-- EvKey KUp _ -> onUp+-- EvKey (KChar 'q') _ -> return Nothing+-- EvKey KEsc _ -> return Nothing+-- _ -> waitForSelection ichan currentIdx+-- where+-- onDown = waitForSelection ichan ((currentIdx + 1) `rem` numChoices)+-- onUp = let currentIdx' = if currentIdx == 0+-- then length choices - 1+-- else currentIdx - 1+-- in waitForSelection ichan currentIdx'+++listPrompt :: String -> [String] -> IO String+listPrompt question options = setup $ do+ putStrLn question+ -- selection has structure: (selected item's index, indexed options)+ let selection = (0, zip options ([0..] :: [Int]))+ mi <- listenForSelection selection+ case mi of+ Just i -> return (options !! i)+ Nothing -> exitSuccess+ where+ setup = hWithNoBuffering stdin . withNoEcho++ listenForSelection selection = do+ inp <- Vty.inputForConfig =<< Vty.standardIOConfig+ go (Vty._eventChannel inp) selection+ where+ go c os = do+ render os+ hFlush stdout+ e <- atomically (readTChan c)+ case e of+ EvKey KEnter _ -> do+ -- makeChoice+ return (Just (fst os))+ EvKey (KChar 'n') [MCtrl] -> do+ clearFromCursorTo $ length $ snd os+ go c (updateSelection MoveDown os)+ EvKey (KChar 'j') _ -> do+ clearFromCursorTo $ length $ snd os+ go c (updateSelection MoveDown os)+ EvKey KDown _ -> do+ clearFromCursorTo $ length $ snd os+ go c (updateSelection MoveDown os)+ EvKey (KChar 'p') [MCtrl] -> do+ clearFromCursorTo $ length $ snd os+ go c (updateSelection MoveUp os)+ EvKey (KChar 'k') _ -> do+ clearFromCursorTo $ length $ snd os+ go c (updateSelection MoveUp os)+ EvKey KUp _ -> do+ clearFromCursorTo $ length $ snd os+ go c (updateSelection MoveUp os)+ EvKey (KChar 'q') _ ->+ return Nothing+ EvKey (KChar 'c') [MCtrl] ->+ return Nothing+ EvKey KEsc _ ->+ return Nothing+ _ -> go c os++ makeChoice = forM_ (replicate (length (snd selection)) ())+ (const (clearLine >> cursorUpLine 1))++ updateSelection MoveUp (i, os) = ((i - 1) `mod` length os, os)+ updateSelection MoveDown (i, os) = ((i + 1) `mod` length os, os)+ updateSelection _ _ = error "Internal error, key not recognized"++ render (s, optionsI) = forM_ optionsI $ \(o, i) ->+ if i == s+ then do+ setSGR [ SetColor Foreground Vivid White+ , SetConsoleIntensity BoldIntensity+ ]+ putStr "> "+ setSGR [ SetColor Foreground Vivid Cyan+ , SetConsoleIntensity NormalIntensity+ ]+ putStrLn $ o+ setSGR []+ else putStrLn $ " " ++ o++checkboxPrompt :: String -> [String] -> IO [String]+checkboxPrompt question options = setup $ do+ putStrLn question+ let selection = (0, [], zip options ([0..] :: [Int]))+ render selection+ is <- listenForSelection selection+ return $ map (options !!) is+ where+ setup = hWithNoBuffering stdin . withNoEcho++ listenForSelection :: (Int, [Int], [(String, Int)]) -> IO [Int]+ listenForSelection selection@(_, _, s3) = do+ inp <- Vty.inputForConfig =<< Vty.standardIOConfig+ go (Vty._eventChannel inp) selection+ where+ go :: TChan Event -> (Int, [Int], [(String, Int)]) -> IO [Int]+ go c os@(_, os2, os3) = do+ render os+ hFlush stdout+ e <- atomically (readTChan c)+ print e+ case e of+ EvKey KEnter _ -> do+ makeChoice+ return os2+ EvKey (KChar 'n') [MCtrl] -> do+ clearFromCursorTo $ length os3+ go c (updateSelection MoveDown os)+ EvKey (KChar 'j') _ -> do+ clearFromCursorTo $ length os3+ go c (updateSelection MoveDown os)+ EvKey KDown _ -> do+ clearFromCursorTo $ length os3+ go c (updateSelection MoveDown os)+ EvKey (KChar 'p') [MCtrl] -> do+ clearFromCursorTo $ length os3+ go c (updateSelection MoveUp os)+ EvKey (KChar 'k') _ -> do+ clearFromCursorTo $ length os3+ go c (updateSelection MoveUp os)+ EvKey KUp _ -> do+ clearFromCursorTo $ length os3+ go c (updateSelection MoveUp os)+ EvKey (KChar 'q') _ ->+ return []+ EvKey (KChar 'c') [MCtrl] ->+ return []+ EvKey KEsc _ ->+ return []+ _ -> do+ clearFromCursorTo $ length os3+ go c os++ makeChoice = do+ let size = length (s3 :: [(String, Int)])+ mlist = replicate size ()+ forM_ mlist (const (clearLine >> cursorUpLine 1))++ updateSelection MoveUp (i, is, os) = ((i - 1) `mod` length os, is, os)+ updateSelection MoveDown (i, is, os) = ((i + 1) `mod` length os, is, os)+ updateSelection ToggleSelection (i, is, os) = (i, is', os)+ where+ is' = if i `elem` is then delete i is else i:is+ updateSelection _ _ = error "Internal error, key not recognized"++ render (i, is, optionsI) = forM_ optionsI $ \(o, j) -> do+ let checkbox = if j `elem` is then "◉ " else "◯ "+ if i == j+ then do+ setSGR [ SetColor Foreground Vivid Cyan ]+ putStrLn $ ">" ++ checkbox ++ o+ setSGR []+ else putStrLn $ " " ++ checkbox ++ o
stack-run.cabal view
@@ -1,5 +1,5 @@ name: stack-run-version: 0.1.1.1+version: 0.1.1.2 synopsis: An equivalent to cabal run for stack. description: Finds the project root, compiles your code and runs the first or set default executable. It's a shorthand for@@ -20,6 +20,7 @@ executable stack-run main-is: Main.hs+ other-modules: System.Console.Questioner build-depends: Cabal , terminal-size , vty