content: {-# LANGUAGE MultiWayIf   #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE ViewPatterns #-}
  
  {- |
  Module                  : Summoner.Question
  Copyright               : (c) 2017-2022 Kowainik
  SPDX-License-Identifier : MPL-2.0
  Maintainer              : Kowainik <xrom.xkov@gmail.com>
  Stability               : Stable
  Portability             : Portable
  
  This module contains function to proper questioning in terminal.
  -}
  
  module Summoner.Question
         ( -- * Choose functions.
           choose
         , chooseYesNo
         , chooseYesNoBool
  
           -- * YesNoPrompt
         , YesNoPrompt(..)
         , mkDefaultYesNoPrompt
  
           -- * Queries
         , query
         , queryWithPredicate
         , queryNotNull
         , queryDef
         , queryManyRepeatOnFail
         , checkUniqueName
         , doesExistProjectName
  
           -- * Customize target message
         , targetMessageWithText
         , targetMessage
         , trueMessage
         , falseMessage
         ) where
  
  import Colourista (blue, bold, cyan, errorMessage, formatWith, formattedMessage, green, italic,
                     warningMessage)
  import System.Directory (doesPathExist, getCurrentDirectory)
  import System.FilePath ((</>))
  
  import Summoner.Text (headToUpper, intercalateMap)
  
  import qualified Data.Text as T
  
  
  {- HLINT ignore "Redundant multi-way if" -}
  
  {- | Build a prompt
  
  For example,
  
  @
  YesNoPrompt
    { yesNoTarget = "Cabal"
    , yesNoPrompt = "Do you want to add a cabal integration?"}
  @
  
  will generate a following prompt message to the user
  
  @
  Do you want to add a cabal integration? [y]/n
   -> y
  [Cabal] will be added to the project
  @
  
  -}
  data YesNoPrompt = YesNoPrompt
      { yesNoTarget :: !Text -- ^ target (e.g., __TARGET will be added to the project__)
      , yesNoPrompt :: !Text -- ^ prompt (e.g., __PROMPT [y]/n__)
      }
  
  {- | Build a prompt with the TARGET name only
  
  It will generate a simple default prompt such that
  
  @
  Add TARGET? [y]/n
  @
  
  -}
  mkDefaultYesNoPrompt
      :: Text -- ^ target name
      -> YesNoPrompt
  mkDefaultYesNoPrompt target = YesNoPrompt target ("Add " <> target <> "?")
  
  -- | Represents a user's answer
  data Answer
      = Y
      | N
  
  -- | Parse an answer to 'Answer'
  yesOrNo :: Text -> Maybe Answer
  yesOrNo (T.toLower -> answer )
      | T.null answer = Just Y
      | answer `elem` ["yes", "y", "ys"] = Just Y
      | answer `elem` ["no", "n"]  = Just N
      | otherwise = Nothing
  
  ----------------------------------------------------------------------------
  -- IO Questioning
  ----------------------------------------------------------------------------
  
  {- | Prints the given question in the following way:
  
  >>> printQuestion "Which option?" [A, B, C]
  "Which option? [A]/B/C"
  
  __ Note__ that the first element in the given list is considered as
  the default one.
  -}
  printQuestion
      :: Text    -- ^ Question text.
      -> [Text]  -- ^ List of available answers.
      -> IO ()
  printQuestion question [] = putTextLn question
  printQuestion question (def:rest) = do
      putStrFlush $ question <> boldDefault def
      let restSlash = T.intercalate "/" rest
      if restSlash == ""
      then putTextLn ""
      else putTextLn $ "/" <> restSlash
  
  -- | Allows users to choose one of the given options.
  -- It asks the question until the appropriate answer is received.
  choose :: Show a
      => (Text -> Maybe a)  -- ^ Parse function
      -> Text  -- ^ Question text.
      -> NonEmpty a   -- ^ List of available options.
      -> IO a  -- ^ The chosen option.
  choose parser question choices = do
      let showChoices = map show $ toList choices
      printQuestion question showChoices
      answer <- prompt
      if T.null answer
          then pure (head choices)
          else whenNothing (parser answer)
                  (errorMessage "This wasn't a valid choice." >> choose parser question choices)
  
  -- | Like 'choose' but the possible answer are 'Y' or 'N'.
  chooseYesNo
      :: YesNoPrompt -- ^ Target and Prompt
      -> IO a -- ^ action for 'Y' answer
      -> IO a -- ^ action for 'N' answer
      -> IO a
  chooseYesNo p@YesNoPrompt {..} yesDo noDo = do
      printQuestion yesNoPrompt ["y", "n"]
      answer <- yesOrNo <$> prompt
      case answer of
          Nothing -> do
             errorMessage "This wasn't a valid choice."
             chooseYesNo p yesDo noDo
          Just Y -> trueMessage yesNoTarget >> yesDo
          Just N -> falseMessage yesNoTarget >> noDo
  
  -- | Like 'chooseYesNo' but returns 'Bool'.
  chooseYesNoBool :: YesNoPrompt -> IO Bool
  chooseYesNoBool ynPrompt = chooseYesNo ynPrompt (pure True) (pure False)
  
  {- | The message after yes/no questions. The output depends on the answer.
  
  @
    __Benchmarks__ will be added to the project
  @
  -}
  targetMessageWithText :: Bool -> Text -> Text -> IO Bool
  targetMessageWithText result target text = do
      let (color, actionResult) = if result
            then (green, " will be "  <> text)
            else (cyan,  " won't be " <> text)
  
      putTextLn $ mconcat
              [ formatWith [italic, bold, color] $ "  " <> headToUpper target
              , formatWith [color] actionResult
              ]
      pure result
  
  -- | Like 'targetMessageWithText' but the text is "added to the project"
  targetMessage :: Bool -> Text -> IO Bool
  targetMessage result target = targetMessageWithText result target "added to the project"
  
  trueMessage, falseMessage :: Text -> IO Bool
  trueMessage  = targetMessage True
  falseMessage = targetMessage False
  
  
  {- | Queries for any answer.
  
  @
    Short project description:
    ->
  @
  -}
  query :: Text -> IO Text
  query question = putTextLn question >> prompt
  
  {- | Queries for the answer that should satisfy the given predicate, or be empty.
  -}
  queryWithPredicate :: Text -> [Text] -> Text -> (Text -> Bool) -> IO Text
  queryWithPredicate question options instruction p = loop
    where
      loop :: IO Text
      loop = do
          printQuestion question options
          formattedMessage [italic] instruction
          input <- prompt
          if input /= "" && not (p input)
          then errorMessage ("'" <> input <> "' doesn't satisfy the requirements.") >> loop
          else pure input
  
  
  -- | Queries for an non-empty answer.
  queryNotNull :: Text -> IO Text
  queryNotNull question = do
      putTextLn question
      answer <- prompt
      if | T.null answer -> do
             errorMessage "An answer is required."
             queryNotNull question
         | otherwise -> pure answer
  
  -- | Like 'query' but has the default answer if no answer is specified.
  queryDef :: Text -> Text -> IO Text
  queryDef question defAnswer = do
      putTextLn $ question <> boldDefault defAnswer
      answer <- prompt
      if | T.null answer -> pure defAnswer
         | otherwise     -> pure answer
  
  -- | Queries many answers. If answers are not parsable shows the failing part
  -- and queries again
  queryManyRepeatOnFail :: forall a . (Text -> Maybe a) -> IO [a]
  queryManyRepeatOnFail parser = promptLoop
    where
      -- TODO: probably a good idea to use 'Validation' here to simplify code
      promptLoop :: IO [a]
      promptLoop = do
          answer <- prompt
          let answers = map (id &&& parser) $ words answer  -- converts [Text] into [(Text, Maybe a)]
          case partitionPairs answers of
              Left unparsed -> do
                  -- TODO: create intercalateMap function
                  errorMessage $ "Unable to parse the following items: " <> intercalateMap " " quote unparsed
                  promptLoop
              Right results -> pure results
  
      -- puts only those @c@ into Left list where snd is Nothing;
      -- returns Left if at least one second element is Nothing
      partitionPairs :: forall x y . [(x, Maybe y)] -> Either [x] [y]
      partitionPairs [] = Right []
      partitionPairs ((x, my):xs) = case my of
          Just y -> (y:) <$> partitionPairs xs
          Nothing -> case partitionPairs xs of
              Left fails -> Left (x : fails)
              Right _    -> Left [x]
  
      quote :: Text -> Text
      quote t = "'" <> t <> "'"
  
  checkUniqueName :: Text -> IO Text
  checkUniqueName nm = do
      exist <- doesExistProjectName nm
      if exist then do
          warningMessage "Project with this name is already exist. Please choose another one"
          newNm <- queryNotNull "Project name: "
          checkUniqueName newNm
      else
          pure nm
  
  -- | Check if the folder with the suggested project name is already exist.
  doesExistProjectName :: Text -> IO Bool
  doesExistProjectName projectName = do
      curPath <- getCurrentDirectory
      doesPathExist $ curPath </> toString projectName
  
  ----------------------------------------------------------------------------
  -- Internal implementation details
  ----------------------------------------------------------------------------
  
  -- | Explicit flush ensures prompt messages are in the correct order on all systems.
  putStrFlush :: Text -> IO ()
  putStrFlush msg = do
      putText msg
      hFlush stdout
  
  {- | Read 'Text' from standard input after arrow prompt.
  -}
  prompt :: IO Text
  prompt = do
      putStrFlush $ formatWith [blue] "  ->   "
      T.strip <$> getLine
  
  boldDefault :: Text -> Text
  boldDefault message = formatWith [bold] $ " [" <> message <> "]"
  