never executed always true always false
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Distribution.Client.Init.Prompt
4 -- Copyright : (c) Brent Yorgey 2009
5 -- License : BSD-like
6 --
7 -- Maintainer : cabal-devel@haskell.org
8 -- Stability : provisional
9 -- Portability : portable
10 --
11 -- User prompt utility functions for use by the 'cabal init' command.
12 --
13 -----------------------------------------------------------------------------
14
15 module Distribution.Client.Init.Prompt (
16
17 -- * Commands
18 prompt
19 , promptYesNo
20 , promptStr
21 , promptList
22 , promptListOptional
23 , maybePrompt
24 ) where
25
26 import Prelude ()
27 import Distribution.Client.Compat.Prelude hiding (empty)
28
29 import Distribution.Client.Init.Types
30 ( InitFlags(..) )
31 import Distribution.Simple.Setup
32 ( Flag(..) )
33
34
35 -- | Run a prompt or not based on the interactive flag of the
36 -- InitFlags structure.
37 maybePrompt :: InitFlags -> IO t -> IO (Maybe t)
38 maybePrompt flags p =
39 case interactive flags of
40 Flag True -> Just `fmap` p
41 _ -> return Nothing
42
43 -- | Create a prompt with optional default value that returns a
44 -- String.
45 promptStr :: String -> Maybe String -> IO String
46 promptStr = promptDefault' Just id
47
48 -- | Create a yes/no prompt with optional default value.
49 promptYesNo :: String -- ^ prompt message
50 -> Maybe Bool -- ^ optional default value
51 -> IO Bool
52 promptYesNo =
53 promptDefault' recogniseYesNo showYesNo
54 where
55 recogniseYesNo s | s == "y" || s == "Y" = Just True
56 | s == "n" || s == "N" = Just False
57 | otherwise = Nothing
58 showYesNo True = "y"
59 showYesNo False = "n"
60
61 -- | Create a prompt with optional default value that returns a value
62 -- of some Text instance.
63 prompt :: (Parsec t, Pretty t) => String -> Maybe t -> IO t
64 prompt = promptDefault' simpleParsec prettyShow
65
66 -- | Create a prompt with an optional default value.
67 promptDefault' :: (String -> Maybe t) -- ^ parser
68 -> (t -> String) -- ^ pretty-printer
69 -> String -- ^ prompt message
70 -> Maybe t -- ^ optional default value
71 -> IO t
72 promptDefault' parser ppr pr def = do
73 putStr $ mkDefPrompt pr (ppr `fmap` def)
74 inp <- getLine
75 case (inp, def) of
76 ("", Just d) -> return d
77 _ -> case parser inp of
78 Just t -> return t
79 Nothing -> do putStrLn $ "Couldn't parse " ++ inp ++ ", please try again!"
80 promptDefault' parser ppr pr def
81
82 -- | Create a prompt from a prompt string and a String representation
83 -- of an optional default value.
84 mkDefPrompt :: String -> Maybe String -> String
85 mkDefPrompt pr def = pr ++ "?" ++ defStr def
86 where defStr Nothing = " "
87 defStr (Just s) = " [default: " ++ s ++ "] "
88
89 -- | Create a prompt from a list of items, where no selected items is
90 -- valid and will be represented as a return value of 'Nothing'.
91 promptListOptional :: (Pretty t, Eq t)
92 => String -- ^ prompt
93 -> [t] -- ^ choices
94 -> IO (Maybe (Either String t))
95 promptListOptional pr choices = promptListOptional' pr choices prettyShow
96
97 promptListOptional' :: Eq t
98 => String -- ^ prompt
99 -> [t] -- ^ choices
100 -> (t -> String) -- ^ show an item
101 -> IO (Maybe (Either String t))
102 promptListOptional' pr choices displayItem =
103 fmap rearrange
104 $ promptList pr (Nothing : map Just choices) (Just Nothing)
105 (maybe "(none)" displayItem) True
106 where
107 rearrange = either (Just . Left) (fmap Right)
108
109 -- | Create a prompt from a list of items.
110 promptList :: Eq t
111 => String -- ^ prompt
112 -> [t] -- ^ choices
113 -> Maybe t -- ^ optional default value
114 -> (t -> String) -- ^ show an item
115 -> Bool -- ^ whether to allow an 'other' option
116 -> IO (Either String t)
117 promptList pr choices def displayItem other = do
118 putStrLn $ pr ++ ":"
119 let options1 = map (\c -> (Just c == def, displayItem c)) choices
120 options2 = zip ([1..]::[Int])
121 (options1 ++ [(False, "Other (specify)") | other])
122 traverse_ (putStrLn . \(n,(i,s)) -> showOption n i ++ s) options2
123 promptList' displayItem (length options2) choices def other
124 where showOption n i | n < 10 = " " ++ star i ++ " " ++ rest
125 | otherwise = " " ++ star i ++ rest
126 where rest = show n ++ ") "
127 star True = "*"
128 star False = " "
129
130 promptList' :: (t -> String) -> Int -> [t] -> Maybe t -> Bool -> IO (Either String t)
131 promptList' displayItem numChoices choices def other = do
132 putStr $ mkDefPrompt "Your choice" (displayItem `fmap` def)
133 inp <- getLine
134 case (inp, def) of
135 ("", Just d) -> return $ Right d
136 _ -> case readMaybe inp of
137 Nothing -> invalidChoice inp
138 Just n -> getChoice n
139 where invalidChoice inp = do putStrLn $ inp ++ " is not a valid choice."
140 promptList' displayItem numChoices choices def other
141 getChoice n | n < 1 || n > numChoices = invalidChoice (show n)
142 | n < numChoices ||
143 (n == numChoices && not other)
144 = return . Right $ choices !! (n-1)
145 | otherwise = Left `fmap` promptStr "Please specify" Nothing