{-# LANGUAGE NamedFieldPuns #-}

module FortyTwo.Prompts.Select (select, selectWithDefault) where

import Control.Monad.IO.Class

import System.Console.ANSI (hideCursor, showCursor)
import FortyTwo.Renderers.Select (renderOptions)
import FortyTwo.Renderers.Question (renderQuestion)
import FortyTwo.Types(Options)
import FortyTwo.Utils
import FortyTwo.Constants

-- | Loop to let the users select an single option
loop :: Options -> IO (Maybe Int)
loop :: Options -> IO (Maybe Int)
loop Options
options = do
  forall (m :: * -> *). MonadIO m => m ()
noEcho
  forall (m :: * -> *). MonadIO m => Options -> m ()
renderOptions Options
options
  String
key <- IO String
getKey
  forall (m :: * -> *). MonadIO m => Int -> m ()
clearLines forall a b. (a -> b) -> a -> b
$ Options -> Int
getOptionsLines Options
options
  Maybe Int
res <- Options -> String -> IO (Maybe Int)
handleEvent Options
options String
key
  forall (m :: * -> *). MonadIO m => m ()
restoreEcho
  forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
res

-- | Handle a user event
handleEvent :: Options -> String -> IO (Maybe Int)
handleEvent :: Options -> String -> IO (Maybe Int)
handleEvent Options
options String
key
  | String
key forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
upKey, String
leftKey]  = Options -> IO (Maybe Int)
loop forall a b. (a -> b) -> a -> b
$ Options -> (Int, Int, Maybe Int) -> Options
moveUp Options
options forall a b. (a -> b) -> a -> b
$ Options -> (Int, Int, Maybe Int)
getOptionsMeta Options
options
  | String
key forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
downKey, String
rightKey]  = Options -> IO (Maybe Int)
loop forall a b. (a -> b) -> a -> b
$ Options -> (Int, Int, Maybe Int) -> Options
moveDown Options
options forall a b. (a -> b) -> a -> b
$ Options -> (Int, Int, Maybe Int)
getOptionsMeta Options
options
  | String
key forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
enterKey, String
spaceKey] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Options -> Maybe Int
getFocusedOptionIndex Options
options
  | Bool
otherwise = Options -> IO (Maybe Int)
loop Options
options

-- | Handle an arrow up event
moveUp :: Options -> (Int, Int, Maybe Int) -> Options
moveUp :: Options -> (Int, Int, Maybe Int) -> Options
moveUp Options
options (Int
minVal, Int
maxVal, Maybe Int
focusedIndex) = case Maybe Int
focusedIndex of
  Just Int
x -> if Int
x forall a. Eq a => a -> a -> Bool
== Int
minVal then
             Int -> Options -> Options
focusOption Int
x Options
options
            else
             Int -> Options -> Options
focusOption (Int
x forall a. Num a => a -> a -> a
- Int
1) Options
options
  Maybe Int
Nothing -> Int -> Options -> Options
focusOption Int
maxVal Options
options

-- | Handle an arrow down event
moveDown :: Options -> (Int, Int, Maybe Int) -> Options
moveDown :: Options -> (Int, Int, Maybe Int) -> Options
moveDown Options
options (Int
minVal, Int
maxVal, Maybe Int
focusedIndex) = case Maybe Int
focusedIndex of
  Just Int
x -> if Int
x forall a. Eq a => a -> a -> Bool
== Int
maxVal then
             Int -> Options -> Options
focusOption Int
x Options
options
            else
             Int -> Options -> Options
focusOption (Int
x forall a. Num a => a -> a -> a
+ Int
1) Options
options
  Maybe Int
Nothing -> Int -> Options -> Options
focusOption Int
minVal Options
options

-- | Select prompt from a list of options falling back to a default value if no answer will be provided
-- selectWithDefault "What's your favourite color?" ["Red", "Yellow", "Blue"] "Red"
selectWithDefault :: MonadIO m => String -> [String] -> String -> m String
selectWithDefault :: forall (m :: * -> *).
MonadIO m =>
String -> [String] -> String -> m String
selectWithDefault String
question [String]
options String
defaultAnswer = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  String -> IO ()
putStrLn String
emptyString
  forall (m :: * -> *).
MonadIO m =>
String -> String -> String -> m ()
renderQuestion String
question String
defaultAnswer String
emptyString
  String -> IO ()
putStrLn String
emptyString
  IO ()
hideCursor
  IO ()
flush
  forall (m :: * -> *). MonadIO m => m ()
noBuffering
  Maybe Int
res <- Options -> IO (Maybe Int)
loop forall a b. (a -> b) -> a -> b
$ [String] -> Options
stringsToOptions [String]
options
  forall (m :: * -> *). MonadIO m => m ()
restoreBuffering
  IO ()
showCursor
  forall (m :: * -> *). MonadIO m => Int -> m ()
clearLines Int
1

  case Maybe Int
res of
    Just Int
x  -> do
      let answer :: String
answer = forall a. [a] -> Int -> a
(!!) [String]
options Int
x
      forall (m :: * -> *).
MonadIO m =>
String -> String -> String -> m ()
renderQuestion String
question String
emptyString String
answer
      forall (m :: * -> *) a. Monad m => a -> m a
return String
answer
    -- If no user input will be provided..
    Maybe Int
Nothing -> do
      -- ..let's return the default answer
      forall (m :: * -> *).
MonadIO m =>
String -> String -> String -> m ()
renderQuestion String
question String
emptyString String
defaultAnswer
      forall (m :: * -> *) a. Monad m => a -> m a
return String
defaultAnswer

-- | Select prompt from a list of options
-- select "What's your favourite color?" ["Red", "Yellow", "Blue"]
select :: MonadIO m => String -> [String] -> m String
select :: forall (m :: * -> *). MonadIO m => String -> [String] -> m String
select String
question [String]
options = forall (m :: * -> *).
MonadIO m =>
String -> [String] -> String -> m String
selectWithDefault String
question [String]
options String
emptyString