module Rob.Actions.New (main) where

import Rob.Logger (err, success)
import Rob.Config (get, errorNoTemplatesAvailable)
import Rob.Types (Config(..))
import Rob.Questionnaire (run)
import Rob.Project (getTemplatePathByName, getTemplateName, createFilesFromTemplate)
import Rob.UserMessages (
    choseATemplate,
    noTemplateSelected,
    projectSuccessfullyCreated,
    projectPathDoesNotExist,
    emptyString
  )

import System.Exit (exitFailure, exitSuccess)
import System.Directory (doesPathExist)
import FortyTwo (select)

main :: IO ()
main :: IO ()
main = do
  Config
config <- IO Config
get
  Config -> IO ()
createNewProject Config
config

-- | Create a new project using one of the templates available
createNewProject :: Config -> IO ()
createNewProject :: Config -> IO ()
createNewProject (Config []) = IO ()
errorNoTemplatesAvailable
createNewProject (Config [Template]
templates) = do
  String
templateName <- String -> [String] -> IO String
select String
choseATemplate ([String] -> IO String) -> [String] -> IO String
forall a b. (a -> b) -> a -> b
$ (Template -> String) -> [Template] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Template -> String
getTemplateName [Template]
templates
  String -> IO ()
putStrLn String
emptyString
  if Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
templateName then do
    let path :: String
path = [Template] -> String -> String
getTemplatePathByName [Template]
templates String
templateName
    Bool
hasProjectPath <- String -> IO Bool
doesPathExist String
path
    if Bool
hasProjectPath then do
      [(Text, Value)]
responses <- String -> IO [(Text, Value)]
run String
path
      String -> IO ()
putStrLn String
emptyString
      String -> [(Text, Value)] -> IO ()
createFilesFromTemplate String
path [(Text, Value)]
responses
      String -> IO ()
success String
projectSuccessfullyCreated
      IO ()
forall a. IO a
exitSuccess
    else do
      String -> IO ()
err (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
projectPathDoesNotExist String
path
      IO ()
forall a. IO a
exitFailure
  else do
    String -> IO ()
err String
noTemplateSelected
    IO ()
forall a. IO a
exitFailure