{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

module GHCup.Prompts
  ( PromptQuestion,
    PromptResponse (..),
    getUserPromptResponse,
  )
where

import Control.Monad.Reader
import qualified Data.Text.IO as TIO
import GHCup.Prelude.Logger
import GHCup.Types.Optics
import GHCup.Types (PromptQuestion, PromptResponse(..))

getUserPromptResponse :: ( HasLog env
                         , MonadReader env m
                         , MonadIO m)
                      => PromptQuestion
                      -> m PromptResponse

getUserPromptResponse :: forall env (m :: * -> *).
(HasLog env, MonadReader env m, MonadIO m) =>
PromptQuestion -> m PromptResponse
getUserPromptResponse PromptQuestion
prompt = do
  PromptQuestion -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
PromptQuestion -> m ()
logInfo PromptQuestion
prompt
  PromptQuestion
resp <- IO PromptQuestion -> m PromptQuestion
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO PromptQuestion
TIO.getLine
  if PromptQuestion
resp PromptQuestion -> [PromptQuestion] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PromptQuestion
"YES", PromptQuestion
"yes", PromptQuestion
"y", PromptQuestion
"Y"]
    then PromptResponse -> m PromptResponse
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PromptResponse
PromptYes
    else PromptResponse -> m PromptResponse
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PromptResponse
PromptNo