Rewrite templates to include description (#1283)

waspc/cli/src/Wasp/Cli/Command/CreateNewProject.hs

@@ -16,8 +16,9 @@ import Wasp.Cli.Command.CreateNewProject.ProjectDescription
     obtainNewProjectDescription,
   )
 import Wasp.Cli.Command.CreateNewProject.StarterTemplates
-  ( StarterTemplateName (..),
-    getStarterTemplateNames,
+  ( StarterTemplate (..),
+    TemplateMetadata (..),
+    getStarterTemplates,
   )
 import Wasp.Cli.Command.CreateNewProject.StarterTemplates.Local (createProjectOnDiskFromLocalTemplate)
 import Wasp.Cli.Command.CreateNewProject.StarterTemplates.Remote (createProjectOnDiskFromRemoteTemplate)
@@ -30,9 +31,9 @@ import qualified Wasp.Util.Terminal as Term
 createNewProject :: Arguments -> Command ()
 createNewProject args = do
   newProjectArgs <- parseNewProjectArgs args & either throwProjectCreationError return
-  starterTemplateNames <- liftIO getStarterTemplateNames
+  starterTemplates <- liftIO getStarterTemplates
 
-  newProjectDescription <- obtainNewProjectDescription newProjectArgs starterTemplateNames
+  newProjectDescription <- obtainNewProjectDescription newProjectArgs starterTemplates
 
   createProjectOnDisk newProjectDescription
   liftIO $ printGettingStartedInstructions $ _absWaspProjectDir newProjectDescription
@@ -55,12 +56,12 @@ createProjectOnDisk
   NewProjectDescription
     { _projectName = projectName,
       _appName = appName,
-      _templateName = templateName,
+      _template = template,
       _absWaspProjectDir = absWaspProjectDir
     } = do
-    cliSendMessageC $ Msg.Start $ "Creating your project from the " ++ show templateName ++ " template..."
-    case templateName of
-      RemoteStarterTemplate remoteTemplateName ->
-        createProjectOnDiskFromRemoteTemplate absWaspProjectDir projectName appName remoteTemplateName
-      LocalStarterTemplate localTemplateName ->
-        liftIO $ createProjectOnDiskFromLocalTemplate absWaspProjectDir projectName appName localTemplateName
+    cliSendMessageC $ Msg.Start $ "Creating your project from the \"" ++ show template ++ "\" template..."
+    case template of
+      RemoteStarterTemplate TemplateMetadata {_path = remoteTemplatePath} ->
+        createProjectOnDiskFromRemoteTemplate absWaspProjectDir projectName appName remoteTemplatePath
+      LocalStarterTemplate TemplateMetadata {_path = localTemplatePath} ->
+        liftIO $ createProjectOnDiskFromLocalTemplate absWaspProjectDir projectName appName localTemplatePath

waspc/cli/src/Wasp/Cli/Command/CreateNewProject/ProjectDescription.hs

@@ -21,9 +21,9 @@ import Wasp.Cli.Command.CreateNewProject.Common
     throwProjectCreationError,
   )
 import Wasp.Cli.Command.CreateNewProject.StarterTemplates
-  ( StarterTemplateName,
-    defaultStarterTemplateName,
-    findTemplateNameByString,
+  ( StarterTemplate,
+    defaultStarterTemplate,
+    findTemplateByString,
   )
 import Wasp.Cli.FileSystem (getAbsPathToDirInCwd)
 import qualified Wasp.Cli.Interactive as Interactive
@@ -33,7 +33,7 @@ import Wasp.Util (indent, kebabToCamelCase, whenM)
 data NewProjectDescription = NewProjectDescription
   { _projectName :: NewProjectName,
     _appName :: NewProjectAppName,
-    _templateName :: StarterTemplateName,
+    _template :: StarterTemplate,
     _absWaspProjectDir :: Path' Abs (Dir WaspProjectDir)
   }
 
@@ -62,21 +62,21 @@ instance Show NewProjectAppName where
     - Project name is required.
     - Template name is required, we ask the user to choose from available templates.
 -}
-obtainNewProjectDescription :: NewProjectArgs -> [StarterTemplateName] -> Command NewProjectDescription
-obtainNewProjectDescription NewProjectArgs {_projectName = projectNameArg, _templateName = templateNameArg} starterTemplateNames =
+obtainNewProjectDescription :: NewProjectArgs -> [StarterTemplate] -> Command NewProjectDescription
+obtainNewProjectDescription NewProjectArgs {_projectName = projectNameArg, _templateName = templateNameArg} starterTemplates =
   case projectNameArg of
-    Just projectName -> obtainNewProjectDescriptionFromCliArgs projectName templateNameArg starterTemplateNames
-    Nothing -> obtainNewProjectDescriptionInteractively templateNameArg starterTemplateNames
+    Just projectName -> obtainNewProjectDescriptionFromCliArgs projectName templateNameArg starterTemplates
+    Nothing -> obtainNewProjectDescriptionInteractively templateNameArg starterTemplates
 
-obtainNewProjectDescriptionFromCliArgs :: String -> Maybe String -> [StarterTemplateName] -> Command NewProjectDescription
+obtainNewProjectDescriptionFromCliArgs :: String -> Maybe String -> [StarterTemplate] -> Command NewProjectDescription
 obtainNewProjectDescriptionFromCliArgs projectName templateNameArg availableTemplates =
   obtainNewProjectDescriptionFromProjectNameAndTemplateArg
     projectName
     templateNameArg
     availableTemplates
-    (return defaultStarterTemplateName)
+    (return defaultStarterTemplate)
 
-obtainNewProjectDescriptionInteractively :: Maybe String -> [StarterTemplateName] -> Command NewProjectDescription
+obtainNewProjectDescriptionInteractively :: Maybe String -> [StarterTemplate] -> Command NewProjectDescription
 obtainNewProjectDescriptionInteractively templateNameArg availableTemplates = do
   projectName <- liftIO $ Interactive.askForRequiredInput "Enter the project name (e.g. my-project)"
   obtainNewProjectDescriptionFromProjectNameAndTemplateArg
@@ -91,17 +91,17 @@ obtainNewProjectDescriptionInteractively templateNameArg availableTemplates = do
 obtainNewProjectDescriptionFromProjectNameAndTemplateArg ::
   String ->
   Maybe String ->
-  [StarterTemplateName] ->
-  Command StarterTemplateName ->
+  [StarterTemplate] ->
+  Command StarterTemplate ->
   Command NewProjectDescription
 obtainNewProjectDescriptionFromProjectNameAndTemplateArg projectName templateNameArg availableTemplates obtainTemplateWhenNoArg = do
   absWaspProjectDir <- obtainAvailableProjectDirPath projectName
-  selectedTemplate <- maybe obtainTemplateWhenNoArg findTemplateNameOrThrow templateNameArg
+  selectedTemplate <- maybe obtainTemplateWhenNoArg findTemplateOrThrow templateNameArg
   mkNewProjectDescription projectName absWaspProjectDir selectedTemplate
   where
-    findTemplateNameOrThrow :: String -> Command StarterTemplateName
-    findTemplateNameOrThrow templateName =
-      findTemplateNameByString availableTemplates templateName
+    findTemplateOrThrow :: String -> Command StarterTemplate
+    findTemplateOrThrow templateName =
+      findTemplateByString availableTemplates templateName
         & maybe throwInvalidTemplateNameUsedError return
 
 obtainAvailableProjectDirPath :: String -> Command (Path' Abs (Dir WaspProjectDir))
@@ -121,14 +121,14 @@ obtainAvailableProjectDirPath projectName = do
         throwProjectCreationError $
           "Directory \"" ++ projectDirName ++ "\" is not empty."
 
-mkNewProjectDescription :: String -> Path' Abs (Dir WaspProjectDir) -> StarterTemplateName -> Command NewProjectDescription
-mkNewProjectDescription projectName absWaspProjectDir templateName
+mkNewProjectDescription :: String -> Path' Abs (Dir WaspProjectDir) -> StarterTemplate -> Command NewProjectDescription
+mkNewProjectDescription projectName absWaspProjectDir template
   | isValidWaspIdentifier appName =
       return $
         NewProjectDescription
           { _projectName = NewProjectName projectName,
             _appName = NewProjectAppName appName,
-            _templateName = templateName,
+            _template = template,
             _absWaspProjectDir = absWaspProjectDir
           }
   | otherwise =

waspc/cli/src/Wasp/Cli/Command/CreateNewProject/StarterTemplates.hs

@@ -1,41 +1,63 @@
 module Wasp.Cli.Command.CreateNewProject.StarterTemplates
-  ( getStarterTemplateNames,
-    StarterTemplateName (..),
-    findTemplateNameByString,
-    defaultStarterTemplateName,
+  ( getStarterTemplates,
+    StarterTemplate (..),
+    TemplateMetadata (..),
+    findTemplateByString,
+    defaultStarterTemplate,
   )
 where
 
 import Data.Either (fromRight)
 import Data.Foldable (find)
-import Wasp.Cli.Command.CreateNewProject.StarterTemplates.Remote.Github (starterTemplateGithubRepo)
-import qualified Wasp.Cli.GithubRepo as GR
+import qualified Wasp.Cli.Command.CreateNewProject.StarterTemplates.Remote.Github as Github
+import qualified Wasp.Cli.Interactive as Interactive
 
-data StarterTemplateName = RemoteStarterTemplate String | LocalStarterTemplate String
+data StarterTemplate = RemoteStarterTemplate TemplateMetadata | LocalStarterTemplate TemplateMetadata
   deriving (Eq)
 
-instance Show StarterTemplateName where
-  show (RemoteStarterTemplate templateName) = templateName
-  show (LocalStarterTemplate templateName) = templateName
+data TemplateMetadata = TemplateMetadata
+  { _name :: String,
+    _path :: String,
+    _description :: String
+  }
+  deriving (Eq, Show)
 
-getStarterTemplateNames :: IO [StarterTemplateName]
-getStarterTemplateNames = do
-  remoteTemplates <- fromRight [] <$> fetchRemoteStarterTemplateNames
+instance Show StarterTemplate where
+  show (RemoteStarterTemplate TemplateMetadata {_name = title}) = title
+  show (LocalStarterTemplate TemplateMetadata {_name = title}) = title
+
+instance Interactive.Option StarterTemplate where
+  showOption = show
+  showOptionDescription (RemoteStarterTemplate TemplateMetadata {_description = description}) = Just description
+  showOptionDescription (LocalStarterTemplate TemplateMetadata {_description = description}) = Just description
+
+getStarterTemplates :: IO [StarterTemplate]
+getStarterTemplates = do
+  remoteTemplates <- fromRight [] <$> fetchRemoteStarterTemplates
   return $ localTemplates ++ remoteTemplates
 
-fetchRemoteStarterTemplateNames :: IO (Either String [StarterTemplateName])
-fetchRemoteStarterTemplateNames = do
-  fmap extractTemplateNames <$> GR.fetchRepoRootFolderContents starterTemplateGithubRepo
+fetchRemoteStarterTemplates :: IO (Either String [StarterTemplate])
+fetchRemoteStarterTemplates = do
+  fmap extractTemplateNames <$> Github.fetchRemoteTemplatesGithubData
   where
-    extractTemplateNames :: GR.RepoFolderContents -> [StarterTemplateName]
+    extractTemplateNames :: [Github.RemoteTemplateGithubData] -> [StarterTemplate]
     -- Each folder in the repo is a template.
-    extractTemplateNames = map (RemoteStarterTemplate . GR._name) . filter ((== GR.Folder) . GR._type)
+    extractTemplateNames =
+      map
+        ( \metadata ->
+            RemoteStarterTemplate $
+              TemplateMetadata
+                { _name = Github._name metadata,
+                  _path = Github._path metadata,
+                  _description = Github._description metadata
+                }
+        )
 
-localTemplates :: [StarterTemplateName]
-localTemplates = [defaultStarterTemplateName]
+localTemplates :: [StarterTemplate]
+localTemplates = [defaultStarterTemplate]
 
-defaultStarterTemplateName :: StarterTemplateName
-defaultStarterTemplateName = LocalStarterTemplate "basic"
+defaultStarterTemplate :: StarterTemplate
+defaultStarterTemplate = LocalStarterTemplate $ TemplateMetadata {_name = "basic", _path = "basic", _description = "Simple starter template with a single page."}
 
-findTemplateNameByString :: [StarterTemplateName] -> String -> Maybe StarterTemplateName
-findTemplateNameByString templateNames query = find ((== query) . show) templateNames
+findTemplateByString :: [StarterTemplate] -> String -> Maybe StarterTemplate
+findTemplateByString templates query = find ((== query) . show) templates

waspc/cli/src/Wasp/Cli/Command/CreateNewProject/StarterTemplates/Local.hs

@@ -14,8 +14,8 @@ import qualified Wasp.Data as Data
 import Wasp.Project (WaspProjectDir)
 
 createProjectOnDiskFromLocalTemplate :: Path' Abs (Dir WaspProjectDir) -> NewProjectName -> NewProjectAppName -> String -> IO ()
-createProjectOnDiskFromLocalTemplate absWaspProjectDir projectName appName templateName = do
-  copyLocalTemplateToNewProjectDir templateName
+createProjectOnDiskFromLocalTemplate absWaspProjectDir projectName appName templatePath = do
+  copyLocalTemplateToNewProjectDir templatePath
   replaceTemplatePlaceholdersInWaspFile appName projectName absWaspProjectDir
   where
     copyLocalTemplateToNewProjectDir :: String -> IO ()

waspc/cli/src/Wasp/Cli/Command/CreateNewProject/StarterTemplates/Remote.hs

@@ -21,11 +21,11 @@ createProjectOnDiskFromRemoteTemplate ::
   NewProjectAppName ->
   String ->
   Command ()
-createProjectOnDiskFromRemoteTemplate absWaspProjectDir projectName appName templateName = do
-  fetchGithubTemplateToDisk absWaspProjectDir templateName >>= either throwProjectCreationError pure
+createProjectOnDiskFromRemoteTemplate absWaspProjectDir projectName appName templatePath = do
+  fetchGithubTemplateToDisk absWaspProjectDir templatePath >>= either throwProjectCreationError pure
   liftIO $ replaceTemplatePlaceholdersInWaspFile appName projectName absWaspProjectDir
   where
     fetchGithubTemplateToDisk :: Path' Abs (Dir WaspProjectDir) -> String -> Command (Either String ())
-    fetchGithubTemplateToDisk projectDir templateFolderName = do
-      let templateFolderPath = fromJust . SP.parseRelDir $ templateFolderName
+    fetchGithubTemplateToDisk projectDir templatePathInRepo = do
+      let templateFolderPath = fromJust . SP.parseRelDir $ templatePathInRepo
       liftIO $ fetchFolderFromGithubRepoToDisk starterTemplateGithubRepo templateFolderPath projectDir

waspc/cli/src/Wasp/Cli/Command/CreateNewProject/StarterTemplates/Remote/Github.hs

@@ -1,6 +1,8 @@
 module Wasp.Cli.Command.CreateNewProject.StarterTemplates.Remote.Github where
 
+import Data.Aeson (FromJSON (parseJSON), withObject, (.:))
 import Wasp.Cli.GithubRepo (GithubRepoRef (..))
+import qualified Wasp.Cli.GithubRepo as GR
 
 starterTemplateGithubRepo :: GithubRepoRef
 starterTemplateGithubRepo =
@@ -9,3 +11,26 @@ starterTemplateGithubRepo =
       _repoName = "starters",
       _repoReferenceName = "main"
     }
+
+starterTemplatesDataGithubFilePath :: FilePath
+starterTemplatesDataGithubFilePath = "templates.json"
+
+fetchRemoteTemplatesGithubData :: IO (Either String [RemoteTemplateGithubData])
+fetchRemoteTemplatesGithubData = GR.fetchRepoFileContents starterTemplateGithubRepo starterTemplatesDataGithubFilePath
+
+data RemoteTemplateGithubData = RemoteTemplateGithubData
+  { _name :: String,
+    _description :: String,
+    _path :: String
+  }
+  deriving (Show, Eq)
+
+instance FromJSON RemoteTemplateGithubData where
+  parseJSON = withObject "RemoteTemplateGithubData" $ \obj ->
+    RemoteTemplateGithubData
+      <$> obj
+      .: "name"
+      <*> obj
+      .: "description"
+      <*> obj
+      .: "path"

waspc/cli/src/Wasp/Cli/GithubRepo.hs

@@ -3,15 +3,10 @@
 module Wasp.Cli.GithubRepo where
 
 import Control.Exception (try)
-import Data.Aeson
-  ( FromJSON,
-    parseJSON,
-    withObject,
-    (.:),
-  )
+import Data.Aeson (FromJSON)
 import Data.Functor ((<&>))
 import Data.List (intercalate)
-import Data.Maybe (fromJust, maybeToList)
+import Data.Maybe (fromJust)
 import qualified Network.HTTP.Simple as HTTP
 import StrongPath (Abs, Dir, Path', Rel, (</>))
 import qualified StrongPath as SP
@@ -69,46 +64,15 @@ fetchFolderFromGithubRepoToDisk githubRepoRef folderInRepoRoot destinationOnDisk
           githubRepoArchiveRootFolderName :: Path' (Rel archiveRoot) (Dir archiveInnerDir)
           githubRepoArchiveRootFolderName = fromJust . SP.parseRelDir $ repoName ++ "-" ++ repoReferenceName
 
-fetchRepoRootFolderContents :: GithubRepoRef -> IO (Either String RepoFolderContents)
-fetchRepoRootFolderContents githubRepo = fetchRepoFolderContents githubRepo Nothing
-
-fetchRepoFolderContents :: GithubRepoRef -> Maybe String -> IO (Either String RepoFolderContents)
-fetchRepoFolderContents githubRepo pathToFolderInRepo = do
+fetchRepoFileContents :: FromJSON a => GithubRepoRef -> String -> IO (Either String a)
+fetchRepoFileContents githubRepo filePath = do
   try (HTTP.httpJSONEither ghRepoInfoRequest) <&> \case
     Right response -> either (Left . show) Right $ HTTP.getResponseBody response
     Left (e :: HTTP.HttpException) -> Left $ show e
   where
-    ghRepoInfoRequest =
-      -- Github returns 403 if we don't specify user-agent.
-      HTTP.addRequestHeader "User-Agent" "wasp-lang/wasp" $ HTTP.parseRequest_ apiURL
-    apiURL = intercalate "/" $ ["https://api.github.com/repos", _repoOwner githubRepo, _repoName githubRepo, "contents"] ++ maybeToList pathToFolderInRepo
+    ghRepoInfoRequest = mkGithubApiRequest apiURL
+    apiURL = intercalate "/" ["https://raw.githubusercontent.com", _repoOwner githubRepo, _repoName githubRepo, _repoReferenceName githubRepo, filePath]
 
-type RepoFolderContents = [RepoObject]
-
-data RepoObject = RepoObject
-  { _name :: String,
-    _type :: RepoObjectType,
-    _downloadUrl :: Maybe String
-  }
-  deriving (Show)
-
-data RepoObjectType = Folder | File
-  deriving (Show, Eq)
-
-instance FromJSON RepoObject where
-  parseJSON = withObject "RepoObject" $ \o -> do
-    name <- o .: "name"
-    type_ <- o .: "type"
-    downloadUrl <- o .: "download_url"
-    return
-      RepoObject
-        { _name = name,
-          _type = parseType type_,
-          _downloadUrl = downloadUrl
-        }
-    where
-      parseType :: String -> RepoObjectType
-      parseType = \case
-        "dir" -> Folder
-        "file" -> File
-        _ -> error "Unable to parse repo object type."
+-- Github returns 403 if we don't specify a user-agent.
+mkGithubApiRequest :: String -> HTTP.Request
+mkGithubApiRequest url = HTTP.addRequestHeader "User-Agent" "wasp-lang/wasp" $ HTTP.parseRequest_ url

waspc/cli/src/Wasp/Cli/Interactive.hs

@@ -1,11 +1,10 @@
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 module Wasp.Cli.Interactive
   ( askForInput,
     askToChoose,
     askForRequiredInput,
-    Option,
+    Option (..),
   )
 where
 
@@ -39,17 +38,16 @@ import qualified Wasp.Util.Terminal as Term
   without having to type the quotes as well.
 
   We introduced the Option class to get different "show" behavior for Strings and other
-  types. Option delegates to the Show instance for all other types, but for Strings it
-  just returns the String itself.
+  types. If we are using something other then String, an instance of Option needs to be defined,
+  but for Strings it just returns the String itself.
 -}
 class Option o where
   showOption :: o -> String
+  showOptionDescription :: o -> Maybe String
 
-instance {-# OVERLAPPING #-} Option [Char] where
+instance Option [Char] where
   showOption = id
-
-instance {-# OVERLAPPABLE #-} Show t => Option t where
-  showOption = show
+  showOptionDescription = const Nothing
 
 askForRequiredInput :: String -> IO String
 askForRequiredInput = repeatIfNull . askForInput
@@ -85,8 +83,18 @@ askToChoose question options = do
     showIndexedOptions = intercalate "\n" $ showIndexedOption <$> zip [1 ..] (NE.toList options)
       where
         showIndexedOption (idx, option) =
-          showIndex idx <> " " <> showOption option <> (if isDefaultOption option then " (default)" else "")
-        showIndex i = Term.applyStyles [Term.Yellow] $ "[" ++ show (i :: Int) ++ "]"
+          Term.applyStyles [Term.Yellow] indexPrefix
+            <> Term.applyStyles [Term.Bold] (showOption option)
+            <> (if isDefaultOption option then " (default)" else "")
+            <> showDescription option (length indexPrefix)
+          where
+            indexPrefix = showIndex idx <> " "
+
+        showIndex i = "[" ++ show (i :: Int) ++ "]"
+
+        showDescription option indentLength = case showOptionDescription option of
+          Just description -> "\n" <> replicate indentLength ' ' <> description
+          Nothing -> ""
 
     defaultOption :: o
     defaultOption = NE.head options