{-# LANGUAGE NamedFieldPuns #-}

module FortyTwo.Renderers.Select (renderOptions, renderOption) where

import FortyTwo.Types (Option(..), Options)
import System.Console.ANSI
import FortyTwo.Utils (addBreakingLinesSpacing)
import FortyTwo.Constants

-- | Render all the options collection
renderOptions :: Options -> IO ()
renderOptions :: Options -> IO ()
renderOptions = (Option -> IO ()) -> Options -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Option -> IO ()
renderOption

-- | Render a single option items
renderOption :: Option -> IO()
renderOption :: Option -> IO ()
renderOption Option { Bool
isFocused :: Option -> Bool
isFocused :: Bool
isFocused, String
value :: Option -> String
value :: String
value } =
  if Bool
isFocused then do
    [SGR] -> IO ()
setSGR [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Cyan]
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [[Char
focusIcon], String
text]
    [SGR] -> IO ()
setSGR [SGR
Reset]
  else
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
separator String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
text
  where
    separator :: String
separator = String
"  "
    text :: String
text = String -> String -> String
addBreakingLinesSpacing String
separator String
value