{-# LANGUAGE NamedFieldPuns #-}

module FortyTwo.Prompts.Multiselect (multiselect, multiselectWithDefault) where

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

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

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

-- | Toggle the isSelected value of a single option element
toggle :: Options -> (Int, Int, Maybe Int) -> Options
toggle :: Options -> (Int, Int, Maybe Int) -> Options
toggle Options
options (Int
_, Int
_, Maybe Int
focusedIndex) = case Maybe Int
focusedIndex of
  Just Int
x -> Int -> Options -> Options
toggleFocusedOption Int
x Options
options
  Maybe Int
Nothing -> 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 Int -> Int -> Bool
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 Int -> Int -> Int
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 Int -> Int -> Bool
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Options
options
  Maybe Int
Nothing -> Int -> Options -> Options
focusOption Int
minVal Options
options

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

  if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
res then do
    String -> String -> String -> IO ()
renderQuestion String
question String
emptyString ([String] -> String
toCommaSeparatedString [String]
defaultAnswer)
    [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
defaultAnswer
  else do
    let answer :: [String]
answer = (Int -> String -> Bool) -> [String] -> [String]
forall a. Eq a => (Int -> a -> Bool) -> [a] -> [a]
filter' (\ Int
i String
_ -> Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
i [Int]
res) [String]
options
    String -> String -> String -> IO ()
renderQuestion String
question String
emptyString ([String] -> String
toCommaSeparatedString [String]
answer)
    [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
answer

-- | Multi Select prompt
-- multiselect "What's your favourite color?" ["Red", "Yellow", "Blue"]
multiselect :: String -> [String] -> IO [String]
multiselect :: String -> [String] -> IO [String]
multiselect String
question [String]
options = String -> [String] -> [String] -> IO [String]
multiselectWithDefault String
question [String]
options []