-- | A more high-level API for what "Darcs.Util.Prompt" offers
module Darcs.UI.Prompt
    ( PromptChoice(..)
    , PromptConfig(..)
    , runPrompt
    ) where

import Darcs.Prelude
import Data.List ( find, intercalate )
import qualified Darcs.Util.Prompt as P

data PromptChoice a = PromptChoice
  { forall a. PromptChoice a -> Char
pcKey :: Char
  , forall a. PromptChoice a -> Bool
pcWhen :: Bool
  , forall a. PromptChoice a -> IO a
pcAction :: IO a
  , forall a. PromptChoice a -> String
pcHelp :: String
  }

data PromptConfig a = PromptConfig
  { forall a. PromptConfig a -> String
pPrompt :: String               -- what to ask the user
  , forall a. PromptConfig a -> String
pVerb :: String                 -- command (what we are doing)
  , forall a. PromptConfig a -> [[PromptChoice a]]
pChoices :: [[PromptChoice a]]  -- list of choice groups
  , forall a. PromptConfig a -> Maybe Char
pDefault :: Maybe Char          -- default choice, capitalized
  }

-- | Generate the help string from a verb and list of choice groups
helpFor :: String -> [[PromptChoice a]] -> String
helpFor :: forall a. String -> [[PromptChoice a]] -> String
helpFor String
jn [[PromptChoice a]]
choices =
  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    [ String
"How to use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
jn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate [String
""] (([PromptChoice a] -> [String]) -> [[PromptChoice a]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ((PromptChoice a -> String) -> [PromptChoice a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PromptChoice a -> String
forall a. PromptChoice a -> String
help ([PromptChoice a] -> [String])
-> ([PromptChoice a] -> [PromptChoice a])
-> [PromptChoice a]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PromptChoice a -> Bool) -> [PromptChoice a] -> [PromptChoice a]
forall a. (a -> Bool) -> [a] -> [a]
filter PromptChoice a -> Bool
forall a. PromptChoice a -> Bool
pcWhen) [[PromptChoice a]]
choices) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [ String
""
    , String
"?: show this help"
    , String
""
    , String
"<Space>: accept the current default (which is capitalized)"
    ]
  where
    help :: PromptChoice a -> String
help PromptChoice a
i = PromptChoice a -> Char
forall a. PromptChoice a -> Char
pcKey PromptChoice a
i Char -> String -> String
forall a. a -> [a] -> [a]
: (String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PromptChoice a -> String
forall a. PromptChoice a -> String
pcHelp PromptChoice a
i)

lookupAction :: Char -> [PromptChoice a] -> Maybe (IO a)
lookupAction :: forall a. Char -> [PromptChoice a] -> Maybe (IO a)
lookupAction Char
key [PromptChoice a]
choices = PromptChoice a -> IO a
forall a. PromptChoice a -> IO a
pcAction (PromptChoice a -> IO a) -> Maybe (PromptChoice a) -> Maybe (IO a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PromptChoice a -> Bool)
-> [PromptChoice a] -> Maybe (PromptChoice a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
key)(Char -> Bool)
-> (PromptChoice a -> Char) -> PromptChoice a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PromptChoice a -> Char
forall a. PromptChoice a -> Char
pcKey) [PromptChoice a]
choices

runPrompt :: PromptConfig a -> IO a
runPrompt :: forall a. PromptConfig a -> IO a
runPrompt pcfg :: PromptConfig a
pcfg@PromptConfig{String
[[PromptChoice a]]
Maybe Char
pPrompt :: forall a. PromptConfig a -> String
pVerb :: forall a. PromptConfig a -> String
pChoices :: forall a. PromptConfig a -> [[PromptChoice a]]
pDefault :: forall a. PromptConfig a -> Maybe Char
pPrompt :: String
pVerb :: String
pChoices :: [[PromptChoice a]]
pDefault :: Maybe Char
..} = do
  let choices :: [PromptChoice a]
choices = (PromptChoice a -> Bool) -> [PromptChoice a] -> [PromptChoice a]
forall a. (a -> Bool) -> [a] -> [a]
filter PromptChoice a -> Bool
forall a. PromptChoice a -> Bool
pcWhen ([PromptChoice a] -> [PromptChoice a])
-> [PromptChoice a] -> [PromptChoice a]
forall a b. (a -> b) -> a -> b
$ [[PromptChoice a]] -> [PromptChoice a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PromptChoice a]]
pChoices
  Char
key <-
    PromptConfig -> IO Char
P.promptChar (PromptConfig -> IO Char) -> PromptConfig -> IO Char
forall a b. (a -> b) -> a -> b
$
      String -> String -> String -> Maybe Char -> String -> PromptConfig
P.PromptConfig String
pPrompt ((PromptChoice a -> Char) -> [PromptChoice a] -> String
forall a b. (a -> b) -> [a] -> [b]
map PromptChoice a -> Char
forall a. PromptChoice a -> Char
pcKey [PromptChoice a]
choices) [] Maybe Char
forall a. Maybe a
Nothing String
"?h"
  case Char -> [PromptChoice a] -> Maybe (IO a)
forall a. Char -> [PromptChoice a] -> Maybe (IO a)
lookupAction Char
key [PromptChoice a]
choices of
    Just IO a
action -> IO a
action
    Maybe (IO a)
Nothing -> String -> IO ()
putStrLn (String -> [[PromptChoice a]] -> String
forall a. String -> [[PromptChoice a]] -> String
helpFor String
pVerb [[PromptChoice a]]
pChoices) IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PromptConfig a -> IO a
forall a. PromptConfig a -> IO a
runPrompt PromptConfig a
pcfg