{-# LANGUAGE NamedFieldPuns, OverloadedStrings #-}

module FortyTwo.Utils where

import Control.Monad.IO.Class

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 :: MonadIO m => m ()
noBuffering :: forall (m :: * -> *). MonadIO m => m ()
noBuffering = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering

-- | Enaable the stdin stdout buffering
restoreBuffering :: MonadIO m => m ()
restoreBuffering :: forall (m :: * -> *). MonadIO m => m ()
restoreBuffering = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
LineBuffering
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering

-- | Avoid echoing the user input
noEcho :: MonadIO m => m ()
noEcho :: forall (m :: * -> *). MonadIO m => m ()
noEcho = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
False

-- | Restore the user input echos
restoreEcho :: MonadIO m => m ()
restoreEcho :: forall (m :: * -> *). MonadIO m => m ()
restoreEcho = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
True

-- | Clear terminal lines from the current cursor position
clearLines :: MonadIO m => Int -> m ()
clearLines :: forall (m :: * -> *). MonadIO m => Int -> m ()
clearLines Int
l = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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' :: forall a b. (Int -> a -> b) -> [a] -> [b]
map' Int -> a -> b
f = 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' :: forall a. Eq a => (Int -> a -> Bool) -> [a] -> [a]
filter' Int -> a -> Bool
f [a]
xs = [a
x | a
x <- [a]
xs, Int -> a -> Bool
f (forall a. HasCallStack => Maybe a -> a
fromJust (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 [Char]
getKey = forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
getKey' [Char]
emptyString
  where
    getKey' :: [Char] -> IO [Char]
getKey' [Char]
chars = do
      Char
char <- IO Char
getChar
      Bool
more <- Handle -> IO Bool
hReady Handle
stdin
      (if Bool
more then [Char] -> IO [Char]
getKey' else forall (m :: * -> *) a. Monad m => a -> m a
return) (Char
charforall a. a -> [a] -> [a]
:[Char]
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, forall (t :: * -> *) a. Foldable t => t a -> Int
length Options
options 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 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> [Char]
getOptionValue)

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

-- | Give the focus to a single option in the collection
focusOption :: Int -> Options -> Options
focusOption :: Int -> Options -> Options
focusOption Int
focusedIndex = forall a b. (Int -> a -> b) -> [a] -> [b]
map' forall a b. (a -> b) -> a -> b
$ \ Int
i Option
o ->
  Option {
    value :: [Char]
value = Option -> [Char]
getOptionValue Option
o,
    isSelected :: Bool
isSelected = Option -> Bool
getOptionIsSelected Option
o,
    isFocused :: Bool
isFocused = Int
focusedIndex 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 :: [Char] -> [Char] -> [Char]
addBreakingLinesSpacing [Char]
separator [Char]
value =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
multiLines then
    [Char]
value
  else
    [Char]
firstLine forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines (forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
normalisedLines forall a. Num a => a -> a -> a
- Int
1) [[Char]]
normalisedLines) forall a. [a] -> [a] -> [a]
++ forall a. [a] -> a
last [[Char]]
normalisedLines
  where
    values :: [[Char]]
values = [Char] -> [[Char]]
lines [Char]
value
    firstLine :: [Char]
firstLine = forall a. [a] -> a
head [[Char]]
values
    multiLines :: [[Char]]
multiLines = forall a. [a] -> [a]
tail [[Char]]
values
    normalisedLines :: [[Char]]
normalisedLines = forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
text -> [Char]
separator forall a. [a] -> [a] -> [a]
++ [Char]
text) [[Char]]
multiLines

-- | Toggle the isSelected flag for a single option
toggleFocusedOption :: Int -> Options -> Options
toggleFocusedOption :: Int -> Options -> Options
toggleFocusedOption Int
focusedIndex = forall a b. (Int -> a -> b) -> [a] -> [b]
map' forall a b. (a -> b) -> a -> b
$ \ Int
i Option
o ->
  Option {
    value :: [Char]
value = Option -> [Char]
getOptionValue Option
o,
    isFocused :: Bool
isFocused = Int
focusedIndex forall a. Eq a => a -> a -> Bool
== Int
i,
    isSelected :: Bool
isSelected = if Int
focusedIndex forall a. Eq a => a -> a -> Bool
== Int
i then
      Bool -> Bool
not 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 :: [[Char]] -> [Char]
toCommaSeparatedString = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", "

-- | Get the value of any option
getOptionValue :: Option -> String
getOptionValue :: Option -> [Char]
getOptionValue Option { [Char]
value :: [Char]
value :: Option -> [Char]
value } = [Char]
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 = 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 = forall a. (a -> Bool) -> [a] -> [Int]
findIndices Option -> Bool
getOptionIsSelected