packages feed

questioner (empty) → 0.1.0.0

raw patch · 10 files changed

+450/−0 lines, 10 filesdep +ansi-terminaldep +basedep +questionersetup-changed

Dependencies added: ansi-terminal, base, questioner, readline, terminal-size

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Pedro Tacla Yamada++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/CheckboxPrompt.hs view
@@ -0,0 +1,8 @@+import System.Console.Questioner++main :: IO ()+main = do+    fs <- prompt ( "What features would you like included?"+                 , [ "Testing" , "Makefile", "guard support" ] )+    putStrLn "Your choices:"+    mapM_ putStrLn fs
+ examples/ListPrompt.hs view
@@ -0,0 +1,8 @@+import System.Console.Questioner++main :: IO ()+main = do+    e <- prompt ("What's your editor?", ["Vim", "Emacs", "Sublime Text"])+    putStrLn $+        e ++ "?! " +++        if e == "vim" then "That's very cool!" else "That's not so cool!"
+ examples/ProgressBar.hs view
@@ -0,0 +1,14 @@+import Control.Concurrent+import System.Console.Questioner++main :: IO ()+main = do+    p <- simpleProgressBar+    loop p 0+  where+    loop p i = do+        threadDelay (1000 * 100) -- 0.1s+        let i' = i + 0.1+        if i >= 1+            then stopIndicator p >> putStrLn "Done!"+            else updateIndicator p i' >> loop p i'
+ examples/Spinner.hs view
@@ -0,0 +1,9 @@+import Control.Concurrent+import System.Console.Questioner++main :: IO ()+main = do+    s <- dots1Spinner (1000 * 200) "Loading..."+    threadDelay (1000 * 10000) -- 10s+    stopIndicator s+    putStrLn "Done!"
+ questioner.cabal view
@@ -0,0 +1,72 @@+name:                questioner+version:             0.1.0.0+synopsis:            A package for prompting values from the command-line.+description:         This is still being developed+homepage:            https://github.com/yamadapc/haskell-questioner.git+license:             MIT+license-file:        LICENSE+author:              Pedro Tacla Yamada+maintainer:          tacla.yamada@gmail.com+copyright:           (c) 2014 Pedro Tacla Yamada+category:            System+build-type:          Simple+cabal-version:       >=1.10++flag examples+  description: Build UI examples+  default: False++library+  exposed-modules:     System.Console.Questioner+                     , System.Console.Questioner.ProgressIndicators+                     , System.Console.Questioner.Util+  build-depends:       base >=4 && <5+                     , ansi-terminal >=0.6 && <0.7+                     , terminal-size >=0.2 && <1+                     , readline >=1 && <1.1+  hs-source-dirs:      src+  default-language:    Haskell2010++executable questioner-list-prompt+  main-is:             ListPrompt.hs+  hs-source-dirs:      examples+  build-depends:       base+                     , questioner+  default-language:    Haskell2010+  if flag(examples)+    buildable: True+  else+    buildable: False++executable questioner-checkbox-prompt+  main-is:             CheckboxPrompt.hs+  hs-source-dirs:      examples+  build-depends:       base+                     , questioner+  default-language:    Haskell2010+  if flag(examples)+    buildable: True+  else+    buildable: False++executable questioner-spinner+  main-is:             Spinner.hs+  hs-source-dirs:      examples+  build-depends:       base+                     , questioner+  default-language:    Haskell2010+  if flag(examples)+    buildable: True+  else+    buildable: False++executable questioner-progressbar+  main-is:             ProgressBar.hs+  hs-source-dirs:      examples+  build-depends:       base+                     , questioner+  default-language:    Haskell2010+  if flag(examples)+    buildable: True+  else+    buildable: False
+ src/System/Console/Questioner.hs view
@@ -0,0 +1,136 @@+{-# 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.Monad ((>=>), forM_)+import Data.List (delete)+import System.Console.ANSI (clearLine, cursorUpLine)+import System.IO (stdin)++import System.Console.Questioner.ProgressIndicators+import System.Console.Questioner.Util++-- Base `Question` and `Question` instances+-------------------------------------------------------------------------------++class Question q a where+    prompt :: q -> IO a++instance Read a => Question String a where+    prompt = putStr . (++ " ") >=> const readLn++instance Question String String where+    prompt = putStr . (++ " ") >=> const getLine++instance Question (String, (String, String)) String where+    prompt (s, (o1, o2)) = do+        putStr s+        putStr $ " (" ++ o1 ++ "/" ++ o2 ++ ") "+        getLine++instance Question (String, [String]) String where+    prompt = uncurry listPrompt++instance Question (String, [String]) [String] where+    prompt = uncurry checkboxPrompt++-- Multiple choice prompts+-------------------------------------------------------------------------------++data ChoiceEvent = MoveUp | MoveDown | MakeChoice | ToggleSelection+  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++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]))+    render selection+    i <- listenForSelection selection+    return $ options !! i+  where+    setup = hWithNoBuffering stdin . withNoEcho++    listenForSelection os = charToChoiceEvent <$> getChar >>= \case+        Nothing -> listenForSelection os+        Just ToggleSelection -> listenForSelection os++        Just MakeChoice -> do+            forM_ (replicate (length (snd os) + 1) ())+                  (const (clearLine >> cursorUpLine 1))+            clearLine+            return $ fst os++        Just d -> do+            let os' = updateSelection d os+            clearFromCursorTo $ length $ snd os+            render os'+            listenForSelection os'++    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) ->+        putStrLn $ (if i == s then "> " else "  ") ++ 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 o = charToChoiceEvent <$> getChar >>= \case+        Just MakeChoice -> do+            let (_, _, optionsI) = o in+                forM_ (replicate (length optionsI + 1) ())+                      (const (clearLine >> cursorUpLine 1))++            clearLine+            let (_, is, _) = o in+                return is++        Just d -> do+            let (_, _, optionsI) = o in+                clearFromCursorTo $ length optionsI+            let o' = updateSelection d o in+                render o' >> listenForSelection o'+        Nothing -> listenForSelection o++    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) ->+            putStrLn $ (if i == j then ">" else " ") +++                       (if j `elem` is then "◉ " else "◯ ") +++                       o
+ src/System/Console/Questioner/ProgressIndicators.hs view
@@ -0,0 +1,139 @@+-- |+-- Module      :  System.Console.Questioner.ProgressIndicators+-- Description :  Provides progress indicators and spinners+-- Copyright   :  (c) Pedro Yamada+-- License     :  MIT+--+-- Maintainer  :  Pedro Yamada <tacla.yamada@gmail.com>+-- Stability   :  stable+-- Portability :  non-portable (not tested on multiple environments)+--+-- Shamefully steals ideas from modules like `Inquirer.js` and `go-spin`.+module System.Console.Questioner.ProgressIndicators+  where++import Control.Applicative ((<$>))+import Control.Concurrent -- (MVar, ThreadId, forkIO, killThread, modifyMVar_,+                          --  newMVar, tryTakeMVar, threadDelay)+import Control.Monad (forever)+import Data.Maybe (fromMaybe)+import System.Console.ANSI (clearLine, setCursorColumn)+import System.Console.Terminal.Size (size, Window(..))+import System.IO (BufferMode(NoBuffering), stdout)++import System.Console.Questioner.Util++-- ProgressIndicator type and utilities+-------------------------------------------------------------------------------++data ProgressIndicator = BarIndicator ThreadId (MVar Double)+                       | SpinnerIndicator ThreadId++stopIndicator :: ProgressIndicator -> IO ()+stopIndicator i = case i of+    (BarIndicator tid _) -> stopProgressIndicator' tid+    (SpinnerIndicator tid) -> stopProgressIndicator' tid+  where+    stopProgressIndicator' tid = do+        killThread tid+        clearLine+        setCursorColumn 0++updateIndicator :: ProgressIndicator -> Double -> IO ()+updateIndicator (BarIndicator _ c) i = putMVar c i+updateIndicator _ _ = return ()++-- ProgressBars+-------------------------------------------------------------------------------++newtype ProgressBarTheme = ProgressBarTheme (Double -> IO ())++progressBar :: ProgressBarTheme -> IO ProgressIndicator+progressBar (ProgressBarTheme render) = do+    mi <- newEmptyMVar+    render 0+    tid <- forkIO $ hWithBufferMode stdout NoBuffering $ forever $ do+        i <- takeMVar mi+        clearLine+        setCursorColumn 0+        render i+    putMVar mi 0+    return $ BarIndicator tid mi++-- Spinners+-------------------------------------------------------------------------------++type SpinnerTheme = String++spinner :: SpinnerTheme -> Int -> String -> IO ProgressIndicator+spinner theme interval prompt = SpinnerIndicator <$> forkIO (setup $ loop 0)+  where+    setup = hWithBufferMode stdout NoBuffering++    loop i = do+        clearLine+        setCursorColumn 0+        putStr $ ' ' : spinnerState i : ' ' : prompt+        threadDelay interval+        loop $ i + 1++    -- TODO - parameterize+    themeLen = length theme+    spinnerState i = theme !! (i `mod` themeLen)++-- Boilerplate for easier usage (TODO - generate this with TH)+-------------------------------------------------------------------------------++simple1SpinnerTheme, simple2SpinnerTheme, simple3SpinnerTheme,+  simple4SpinnerTheme, simple5SpinnerTheme, simple6SpinnerTheme,+  simple7SpinnerTheme, simple8SpinnerTheme, simple9SpinnerTheme,+  dots1SpinnerTheme, dots2SpinnerTheme, dots3SpinnerTheme, dots4SpinnerTheme,+  dots5SpinnerTheme, dots6SpinnerTheme, dots7SpinnerTheme :: SpinnerTheme++simple1Spinner, simple2Spinner, simple3Spinner, simple4Spinner, simple5Spinner,+  simple6Spinner, simple7Spinner, simple8Spinner, simple9Spinner, dots1Spinner,+  dots2Spinner, dots3Spinner, dots4Spinner, dots5Spinner, dots6Spinner,+  dots7Spinner :: Int -> String -> IO ProgressIndicator++simple1SpinnerTheme = "|/-\\"+simple2SpinnerTheme = "◴◷◶◵"+simple3SpinnerTheme = "◰◳◲◱"+simple4SpinnerTheme = "◐◓◑◒"+simple5SpinnerTheme = "▉▊▋▌▍▎▏▎▍▌▋▊▉"+simple6SpinnerTheme = "▌▄▐▀"+simple7SpinnerTheme = "╫╪"+simple8SpinnerTheme = "■□▪▫"+simple9SpinnerTheme = "←↑→↓"+simple1Spinner = spinner simple1SpinnerTheme+simple2Spinner = spinner simple2SpinnerTheme+simple3Spinner = spinner simple3SpinnerTheme+simple4Spinner = spinner simple4SpinnerTheme+simple5Spinner = spinner simple5SpinnerTheme+simple6Spinner = spinner simple6SpinnerTheme+simple7Spinner = spinner simple7SpinnerTheme+simple8Spinner = spinner simple8SpinnerTheme+simple9Spinner = spinner simple9SpinnerTheme++dots1SpinnerTheme = "⠋⠙⠹⠸⠼⠴⠦⠧⠇⠏"+dots2SpinnerTheme = "⠋⠙⠹⠸⠼⠴⠦⠧⠇⠏"+dots3SpinnerTheme = "⠄⠆⠇⠋⠙⠸⠰⠠⠰⠸⠙⠋⠇⠆"+dots4SpinnerTheme = "⠋⠙⠚⠒⠂⠂⠒⠲⠴⠦⠖⠒⠐⠐⠒⠓⠋"+dots5SpinnerTheme = "⠁⠉⠙⠚⠒⠂⠂⠒⠲⠴⠤⠄⠄⠤⠴⠲⠒⠂⠂⠒⠚⠙⠉⠁"+dots6SpinnerTheme = "⠈⠉⠋⠓⠒⠐⠐⠒⠖⠦⠤⠠⠠⠤⠦⠖⠒⠐⠐⠒⠓⠋⠉⠈"+dots7SpinnerTheme = "⠁⠁⠉⠙⠚⠒⠂⠂⠒⠲⠴⠤⠄⠄⠤⠠⠠⠤⠦⠖⠒⠐⠐⠒⠓⠋⠉⠈⠈"+dots1Spinner = spinner dots1SpinnerTheme+dots2Spinner = spinner dots2SpinnerTheme+dots3Spinner = spinner dots3SpinnerTheme+dots4Spinner = spinner dots4SpinnerTheme+dots5Spinner = spinner dots5SpinnerTheme+dots6Spinner = spinner dots6SpinnerTheme+dots7Spinner = spinner dots7SpinnerTheme++simpleProgressBarTheme :: ProgressBarTheme+simpleProgressBarTheme = ProgressBarTheme $ \i -> do+    w <- fromMaybe (45 :: Int) <$> (fmap width <$> size)+    let blocks = floor ((fromIntegral w :: Double) * i) - 3+    putStr (replicate blocks '▉')++simpleProgressBar :: IO ProgressIndicator+simpleProgressBar = progressBar simpleProgressBarTheme
+ src/System/Console/Questioner/Util.hs view
@@ -0,0 +1,42 @@+module System.Console.Questioner.Util+  where++import Control.Exception (bracket_)+import System.Console.ANSI (clearLine, cursorDownLine, cursorUpLine,+                            hideCursor, showCursor)+import System.IO (BufferMode(..), Handle, hGetBuffering, hSetBuffering,+                  hSetEcho, stdin)++-- |+-- Performs an IO action with some buffer mode on a handle+hWithBufferMode :: Handle -> BufferMode -> IO a -> IO a+hWithBufferMode handle bufferMode action = do+    originalBuffering <- hGetBuffering handle+    bracket_+        (hSetBuffering handle bufferMode)+        (hSetBuffering handle originalBuffering)+        action++-- |+-- Performs an IO action with NoBuffering on a handle+hWithNoBuffering :: Handle -> IO a -> IO a+hWithNoBuffering handle = hWithBufferMode handle NoBuffering++-- |+-- Performs an IO action with the console cursor hidden+withNoCursor :: IO a -> IO a+withNoCursor = bracket_ hideCursor showCursor++-- |+-- Performs an IO action with console "echoing" supressed+withNoEcho :: IO a -> IO a+withNoEcho = bracket_ (hSetEcho stdin False) (hSetEcho stdin True)++-- |+-- Clears the screen from the cursor's current position until `n` lines+-- above it+clearFromCursorTo :: Int -> IO ()+clearFromCursorTo nlines = loop nlines >> cursorDownLine (nlines - 2)+  where+    loop (-1) = return ()+    loop n = clearLine >> cursorUpLine 1 >> loop (n - 1)