{-# LANGUAGE NamedFieldPuns #-}
module Rob.Questionnaire where
import Rob.Types
import Rob.Project (questionnaireFileByPath, hasPathQuestionnaire)
import Rob.UserMessages (unableToParseQuestionnaire, projectQuestionnaireMissing)
import qualified Rob.Logger as Logger

import System.Exit (exitFailure)
import FortyTwo
import Data.Yaml
import Data.Text (Text, pack)
import Data.HashMap.Strict (toList)
import qualified Data.Vector as V

-- | Get only the questions out of a questionnaier data struct as list
getQuestions :: Questionnaire -> [(Text, Question)]
getQuestions :: Questionnaire -> [(Text, Question)]
getQuestions Questionnaire { HashMap Text Question
$sel:questions:Questionnaire :: Questionnaire -> HashMap Text Question
questions :: HashMap Text Question
questions } = HashMap Text Question -> [(Text, Question)]
forall k v. HashMap k v -> [(k, v)]
toList HashMap Text Question
questions

-- | Run the questionnaire
run :: FilePath -> IO [(Text, Value)]
run :: FilePath -> IO [(Text, Value)]
run FilePath
path = do
  Bool
hasQuestionnaireFile <- FilePath -> IO Bool
hasPathQuestionnaire FilePath
path
  if Bool
hasQuestionnaireFile then do
    Either ParseException Questionnaire
questionnaire <- FilePath -> IO (Either ParseException Questionnaire)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither FilePath
questionnaireFile
    case Either ParseException Questionnaire
questionnaire of
      Right Questionnaire
q -> ((Text, Question) -> IO (Text, Value))
-> [(Text, Question)] -> IO [(Text, Value)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Question) -> IO (Text, Value)
mapQuestion (Questionnaire -> [(Text, Question)]
getQuestions Questionnaire
q)
      Left ParseException
e -> do
        FilePath -> IO ()
Logger.err FilePath
unableToParseQuestionnaire
        FilePath -> IO ()
Logger.warning (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ ParseException -> FilePath
forall a. Show a => a -> FilePath
show ParseException
e
        IO [(Text, Value)]
forall a. IO a
exitFailure
  else do
    FilePath -> IO ()
Logger.err (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
projectQuestionnaireMissing FilePath
path
    IO [(Text, Value)]
forall a. IO a
exitFailure

  where
    questionnaireFile :: FilePath
questionnaireFile = FilePath -> FilePath
questionnaireFileByPath FilePath
path

-- Map all the questions to answers
mapQuestion :: (Text, Question) -> IO (Text, Value)
mapQuestion :: (Text, Question) -> IO (Text, Value)
mapQuestion (Text
key, Question
q) = do
  Value
answer <- Question -> IO Value
ask Question
q
  (Text, Value) -> IO (Text, Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
key, Value
answer)

-- Ask a Question to get a response from the user
ask :: Question -> IO Value
ask :: Question -> IO Value
ask (PasswordQuestion FilePath
question) = do
  FilePath
res <- FilePath -> IO FilePath
password FilePath
question
  Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
pack FilePath
res)
ask (SimpleQuestion FilePath
question FilePath
defaultValue) = do
  FilePath
res <- FilePath -> FilePath -> IO FilePath
inputWithDefault FilePath
question FilePath
defaultValue
  Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
pack FilePath
res)
ask (SelectQuestion FilePath
question [FilePath]
answers FilePath
defaultValue) = do
  FilePath
res <- FilePath -> [FilePath] -> FilePath -> IO FilePath
selectWithDefault FilePath
question [FilePath]
answers FilePath
defaultValue
  Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
pack FilePath
res)
ask (ConfirmQuestion FilePath
question Bool
defaultValue) = do
  Bool
res <- FilePath -> Bool -> IO Bool
confirmWithDefault FilePath
question Bool
defaultValue
  Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value
Bool Bool
res)
ask (MultiselectQuestion FilePath
question [FilePath]
answers [FilePath]
defaultValues) = do
  [FilePath]
res <- FilePath -> [FilePath] -> [FilePath] -> IO [FilePath]
multiselectWithDefault FilePath
question [FilePath]
answers [FilePath]
defaultValues
  Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> [Value] -> Array
forall a b. (a -> b) -> a -> b
$ (FilePath -> Value) -> [FilePath] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Value
String (Text -> Value) -> (FilePath -> Text) -> FilePath -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack) [FilePath]
res)