{-# LANGUAGE NamedFieldPuns, OverloadedStrings #-}

module FortyTwo.Utils where

import System.Console.ANSI (cursorUpLine, clearFromCursorToScreenEnd)
import System.IO (hSetBuffering, hFlush, hSetEcho, hReady, stdin, stdout, BufferMode(..))
import Data.List (findIndex, findIndices, elemIndex, intercalate)
import Control.Applicative ((<$>))
import Data.Maybe (fromJust)
import FortyTwo.Types(Option(..), Options)
import FortyTwo.Constants (emptyString)

-- | Disable the stdin stdout output buffering
noBuffering :: IO()
noBuffering :: IO ()
noBuffering = do
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering

-- | Enaable the stdin stdout buffering
restoreBuffering :: IO()
restoreBuffering :: IO ()
restoreBuffering = do
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
LineBuffering
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering

-- | Avoid echoing the user input
noEcho :: IO ()
noEcho :: IO ()
noEcho = Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
False

-- | Restore the user input echos
restoreEcho :: IO ()
restoreEcho :: IO ()
restoreEcho = Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
True

-- | Clear terminal lines from the current cursor position
clearLines :: Int -> IO()
clearLines :: Int -> IO ()
clearLines Int
l = do
  -- move up of some lines...
  Int -> IO ()
cursorUpLine Int
l
  -- and clear them
  IO ()
clearFromCursorToScreenEnd

-- | Map a collection with an index
map' :: (Int -> a -> b) -> [a] -> [b]
map' :: (Int -> a -> b) -> [a] -> [b]
map' Int -> a -> b
f = (Int -> a -> b) -> [Int] -> [a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> a -> b
f [Int
0..]

-- | Filter a collection with index
filter' :: Eq a => (Int -> a -> Bool) -> [a] -> [a]
filter' :: (Int -> a -> Bool) -> [a] -> [a]
filter' Int -> a -> Bool
f [a]
xs = [a
x | a
x <- [a]
xs, Int -> a -> Bool
f (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
x [a]
xs)) a
x]

-- | Get the value of any keyboard press
getKey :: IO String
getKey :: IO String
getKey = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getKey' String
emptyString
  where
    getKey' :: String -> IO String
getKey' String
chars = do
      Char
char <- IO Char
getChar
      Bool
more <- Handle -> IO Bool
hReady Handle
stdin
      (if Bool
more then String -> IO String
getKey' else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return) (Char
charChar -> String -> String
forall a. a -> [a] -> [a]
:String
chars)

-- | Flush the output buffer
flush :: IO()
flush :: IO ()
flush = Handle -> IO ()
hFlush Handle
stdout

-- | Get useful informations from the options collection, like minVal, maxVal, activeIndex
getOptionsMeta :: Options -> (Int, Int, Maybe Int)
getOptionsMeta :: Options -> (Int, Int, Maybe Int)
getOptionsMeta Options
options = (Int
0, Options -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Options
options Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Options -> Maybe Int
getFocusedOptionIndex Options
options)

-- | Get the amount of breaking lines needed to display all the options
getOptionsLines :: Options -> Int
getOptionsLines :: Options -> Int
getOptionsLines = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (Options -> [Int]) -> Options -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Option -> Int) -> Options -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> (Option -> [String]) -> Option -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> (Option -> String) -> Option -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> String
getOptionValue)

-- | Convert a string array to
stringsToOptions :: [String] -> Options
stringsToOptions :: [String] -> Options
stringsToOptions [String]
options = [
    Option :: Bool -> Bool -> String -> Option
Option { value :: String
value = String
o, isFocused :: Bool
isFocused = Bool
False, isSelected :: Bool
isSelected = Bool
False } | String
o <- [String]
options
  ]

-- | Give the focus to a single option in the collection
focusOption :: Int -> Options -> Options
focusOption :: Int -> Options -> Options
focusOption Int
focusedIndex = (Int -> Option -> Option) -> Options -> Options
forall a b. (Int -> a -> b) -> [a] -> [b]
map' ((Int -> Option -> Option) -> Options -> Options)
-> (Int -> Option -> Option) -> Options -> Options
forall a b. (a -> b) -> a -> b
$ \ Int
i Option
o ->
  Option :: Bool -> Bool -> String -> Option
Option {
    value :: String
value = Option -> String
getOptionValue Option
o,
    isSelected :: Bool
isSelected = Option -> Bool
getOptionIsSelected Option
o,
    isFocused :: Bool
isFocused = Int
focusedIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i
  }

-- | Normalise the select/multiselect multi lines adding the spaces to format them properly
addBreakingLinesSpacing :: String -> String -> String
addBreakingLinesSpacing :: String -> String -> String
addBreakingLinesSpacing String
separator String
value =
  if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
multiLines then
    String
value
  else
    String
firstLine String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
normalisedLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [String]
normalisedLines) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. [a] -> a
last [String]
normalisedLines
  where
    values :: [String]
values = String -> [String]
lines String
value
    firstLine :: String
firstLine = [String] -> String
forall a. [a] -> a
head [String]
values
    multiLines :: [String]
multiLines = [String] -> [String]
forall a. [a] -> [a]
tail [String]
values
    normalisedLines :: [String]
normalisedLines = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
text -> String
separator String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
text) [String]
multiLines

-- | Toggle the isSelected flag for a single option
toggleFocusedOption :: Int -> Options -> Options
toggleFocusedOption :: Int -> Options -> Options
toggleFocusedOption Int
focusedIndex = (Int -> Option -> Option) -> Options -> Options
forall a b. (Int -> a -> b) -> [a] -> [b]
map' ((Int -> Option -> Option) -> Options -> Options)
-> (Int -> Option -> Option) -> Options -> Options
forall a b. (a -> b) -> a -> b
$ \ Int
i Option
o ->
  Option :: Bool -> Bool -> String -> Option
Option {
    value :: String
value = Option -> String
getOptionValue Option
o,
    isFocused :: Bool
isFocused = Int
focusedIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i,
    isSelected :: Bool
isSelected = if Int
focusedIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i then
      Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Option -> Bool
getOptionIsSelected Option
o
      else Option -> Bool
getOptionIsSelected Option
o
  }

-- | Print a list to comma separated
toCommaSeparatedString :: [String] -> String
toCommaSeparatedString :: [String] -> String
toCommaSeparatedString = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", "

-- | Get the value of any option
getOptionValue :: Option -> String
getOptionValue :: Option -> String
getOptionValue Option { String
value :: String
value :: Option -> String
value } = String
value

-- | Get the is focused attribute of any option
getOptionIsFocused :: Option -> Bool
getOptionIsFocused :: Option -> Bool
getOptionIsFocused Option { Bool
isFocused :: Bool
isFocused :: Option -> Bool
isFocused } = Bool
isFocused

-- | Get the is selected attribute of any option
getOptionIsSelected :: Option -> Bool
getOptionIsSelected :: Option -> Bool
getOptionIsSelected Option { Bool
isSelected :: Bool
isSelected :: Option -> Bool
isSelected } = Bool
isSelected

-- | Get the index of the option selected
getFocusedOptionIndex :: Options -> Maybe Int
getFocusedOptionIndex :: Options -> Maybe Int
getFocusedOptionIndex = (Option -> Bool) -> Options -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex Option -> Bool
getOptionIsFocused

-- | Filter the indexes of the options selected
getSelecteOptionsIndexes :: Options -> [Int]
getSelecteOptionsIndexes :: Options -> [Int]
getSelecteOptionsIndexes = (Option -> Bool) -> Options -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices Option -> Bool
getOptionIsSelected