{-# 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
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 :: 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
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 :: 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)