{-# LANGUAGE QuasiQuotes #-}
module Summoner.Project
( generateProject
, generateProjectInteractive
, generateProjectNonInteractive
, initializeProject
) where
import Colourista (bold, errorMessage, formattedMessage, green, infoMessage, skipMessage,
successMessage, warningMessage)
import Data.List.NonEmpty ((<|))
import NeatInterpolation (text)
import Relude.Extra.Enum (universe, universeNonEmpty)
import Shellmet (($?))
import System.Directory (findExecutable, setCurrentDirectory)
import Summoner.Config (Config, ConfigP (..))
import Summoner.CustomPrelude (CustomPrelude (..))
import Summoner.Decision (Decision (..), decisionToBool, decisionsToBools, promptDecisionToBool)
import Summoner.Default (currentYear, defaultDescription, defaultGHC)
import Summoner.GhcVer (parseGhcVer, showGhcVer)
import Summoner.License (LicenseName (..), fetchLicenseCustom, licenseShortDesc, parseLicenseName)
import Summoner.Mode (ConnectMode (..), Interactivity (..), isOffline)
import Summoner.Question (YesNoPrompt (..), checkUniqueName, choose, doesExistProjectName,
falseMessage, mkDefaultYesNoPrompt, query, queryDef,
queryManyRepeatOnFail, queryWithPredicate, targetMessageWithText,
trueMessage)
import Summoner.Settings (Settings (..))
import Summoner.Source (fetchSources)
import Summoner.Template (createProjectTemplate)
import Summoner.Text (intercalateMap, moduleNameValid, packageNameValid, packageToModule)
import Summoner.Tree (showBoldTree, traverseTree)
import qualified Data.List.NonEmpty as NE
generateProject
:: Interactivity
-> ConnectMode
-> Text
-> Config
-> IO ()
generateProject :: Interactivity -> ConnectMode -> Text -> Config -> IO ()
generateProject Interactive = ConnectMode -> Text -> Config -> IO ()
generateProjectInteractive
generateProject NonInteractive = ConnectMode -> Text -> Config -> IO ()
generateProjectNonInteractive
generateProjectInteractive
:: ConnectMode
-> Text
-> Config
-> IO ()
generateProjectInteractive :: ConnectMode -> Text -> Config -> IO ()
generateProjectInteractive connectMode :: ConnectMode
connectMode projectName :: Text
projectName ConfigP{..} = do
Text
settingsRepo <- Text -> IO Text
checkUniqueName Text
projectName
(settingsCabal :: Bool
settingsCabal, settingsStack :: Bool
settingsStack) <- (Decision, Decision) -> IO (Bool, Bool)
getCabalStack (Decision
cCabal, Decision
cStack)
Text
settingsOwner <- Text -> Text -> IO Text
queryDef "Repository owner: " Text
'Final :- Text
cOwner
Text
settingsDescription <- Text -> Text -> IO Text
queryDef "Short project description: " Text
defaultDescription
Text
settingsFullName <- Text -> Text -> IO Text
queryDef "Author: " Text
'Final :- Text
cFullName
Text
settingsEmail <- Text -> Text -> IO Text
queryDef "Maintainer e-mail: " Text
'Final :- Text
cEmail
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText Text
categoryText
Text
settingsCategories <- Text -> IO Text
query "Category: "
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText Text
licenseText
LicenseName
settingsLicenseName <- if ConnectMode -> Bool
isOffline ConnectMode
connectMode
then LicenseName
NONE LicenseName -> IO () -> IO LicenseName
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> IO ()
infoMessage "'NONE' license is used in offline mode"
else (Text -> Maybe LicenseName)
-> Text -> NonEmpty LicenseName -> IO LicenseName
forall a. Show a => (Text -> Maybe a) -> Text -> NonEmpty a -> IO a
choose Text -> Maybe LicenseName
parseLicenseName "License: " (NonEmpty LicenseName -> IO LicenseName)
-> NonEmpty LicenseName -> IO LicenseName
forall a b. (a -> b) -> a -> b
$ NonEmpty LicenseName -> NonEmpty LicenseName
forall a. Eq a => NonEmpty a -> NonEmpty a
NE.nub (LicenseName
'Final :- LicenseName
cLicense LicenseName -> NonEmpty LicenseName -> NonEmpty LicenseName
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty LicenseName
forall a. (Bounded a, Enum a, Eq a) => NonEmpty a
universeNonEmpty)
Text
settingsYear <- IO Text
currentYear
License
settingsLicenseText <- LicenseName -> Text -> Text -> IO License
fetchLicenseCustom
LicenseName
settingsLicenseName
Text
settingsFullName
Text
settingsYear
Bool
settingsGitHub <- Decision -> YesNoPrompt -> IO Bool
promptDecisionToBool Decision
cGitHub
(Text -> Text -> YesNoPrompt
YesNoPrompt "GitHub integration" "Do you want to create a GitHub repository?")
let settingsNoUpload :: Bool
settingsNoUpload = Any -> Bool
getAny Any
cNoUpload
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
settingsNoUpload (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Text -> IO ()
infoMessage "'No upload' option is selected. The project won't be uploaded to GitHub."
Text -> IO ()
infoMessage "Use 'hub' and 'git' commands manually in order to upload the project to GitHub"
Bool
settingsPrivate <- Bool -> YesNoPrompt -> Decision -> IO Bool
decisionIf
(Bool
settingsGitHub Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
settingsNoUpload)
(Text -> Text -> YesNoPrompt
YesNoPrompt "private repository" "Create as a private repository (Requires a GitHub private repo plan)?")
Decision
cPrivate
Bool
settingsGhActions <- Bool -> YesNoPrompt -> Decision -> IO Bool
decisionIf (Bool
settingsCabal Bool -> Bool -> Bool
&& Bool
settingsGitHub) (Text -> YesNoPrompt
mkDefaultYesNoPrompt "GitHub Actions CI integration") Decision
cGhActions
Bool
settingsTravis <- Bool -> YesNoPrompt -> Decision -> IO Bool
decisionIf Bool
settingsGitHub (Text -> YesNoPrompt
mkDefaultYesNoPrompt "Travis CI integration") Decision
cTravis
Bool
settingsAppVeyor <- Bool -> YesNoPrompt -> Decision -> IO Bool
decisionIf Bool
settingsGitHub (Text -> YesNoPrompt
mkDefaultYesNoPrompt "AppVeyor CI integration") Decision
cAppVey
Bool
settingsIsLib <- Decision -> YesNoPrompt -> IO Bool
promptDecisionToBool Decision
cLib (Text -> YesNoPrompt
mkDefaultYesNoPrompt "library target")
Bool
settingsIsExe <- let target :: Text
target = "executable target" in
if Bool
settingsIsLib
then Decision -> YesNoPrompt -> IO Bool
promptDecisionToBool Decision
cExe (Text -> YesNoPrompt
mkDefaultYesNoPrompt Text
target)
else Text -> IO Bool
trueMessage Text
target
Bool
settingsTest <- Decision -> YesNoPrompt -> IO Bool
promptDecisionToBool Decision
cTest (Text -> YesNoPrompt
mkDefaultYesNoPrompt "tests")
Bool
settingsBench <- Decision -> YesNoPrompt -> IO Bool
promptDecisionToBool Decision
cBench (Text -> YesNoPrompt
mkDefaultYesNoPrompt "benchmarks")
Maybe CustomPrelude
settingsPrelude <- IO (Maybe CustomPrelude)
getPrelude
let settingsExtensions :: [Text]
settingsExtensions = [Text]
cExtensions
let settingsGhcOptions :: [Text]
settingsGhcOptions = [Text]
cGhcOptions
let settingsGitignore :: [Text]
settingsGitignore = [Text]
cGitignore
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "The project will be created with GHC-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GhcVer -> Text
showGhcVer GhcVer
defaultGHC
[GhcVer]
settingsTestedVersions <- [GhcVer] -> [GhcVer]
forall a. Ord a => [a] -> [a]
sortNub ([GhcVer] -> [GhcVer])
-> ([GhcVer] -> [GhcVer]) -> [GhcVer] -> [GhcVer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GhcVer
defaultGHC GhcVer -> [GhcVer] -> [GhcVer]
forall a. a -> [a] -> [a]
:) ([GhcVer] -> [GhcVer]) -> IO [GhcVer] -> IO [GhcVer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case 'Final :- [GhcVer]
cGhcVer of
[] -> do
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn "Additionally you can specify versions of GHC to test with (space-separated): "
Text -> IO ()
infoMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Supported by 'summoner' GHCs: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (GhcVer -> Text) -> [GhcVer] -> Text
forall a. Text -> (a -> Text) -> [a] -> Text
intercalateMap " " GhcVer -> Text
showGhcVer [GhcVer]
forall a. (Bounded a, Enum a) => [a]
universe
(Text -> Maybe GhcVer) -> IO [GhcVer]
forall a. (Text -> Maybe a) -> IO [a]
queryManyRepeatOnFail Text -> Maybe GhcVer
parseGhcVer
vers :: 'Final :- [GhcVer]
vers -> do
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Also these GHC versions will be added: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (GhcVer -> Text) -> [GhcVer] -> Text
forall a. Text -> (a -> Text) -> [a] -> Text
intercalateMap " " GhcVer -> Text
showGhcVer [GhcVer]
'Final :- [GhcVer]
vers
[GhcVer] -> IO [GhcVer]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [GhcVer]
'Final :- [GhcVer]
vers
[TreeFs]
settingsFiles <- ConnectMode -> Map FilePath Source -> IO [TreeFs]
fetchSources ConnectMode
connectMode Map FilePath Source
cFiles
Settings -> IO ()
initializeProject $WSettings :: Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> LicenseName
-> License
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> [GhcVer]
-> Maybe CustomPrelude
-> [Text]
-> [Text]
-> [Text]
-> Bool
-> Bool
-> Bool
-> [TreeFs]
-> Settings
Settings{..}
where
decisionIf :: Bool -> YesNoPrompt -> Decision -> IO Bool
decisionIf :: Bool -> YesNoPrompt -> Decision -> IO Bool
decisionIf p :: Bool
p ynPrompt :: YesNoPrompt
ynPrompt decision :: Decision
decision = if Bool
p
then Decision -> YesNoPrompt -> IO Bool
promptDecisionToBool Decision
decision YesNoPrompt
ynPrompt
else Text -> IO Bool
falseMessage (YesNoPrompt -> Text
yesNoTarget YesNoPrompt
ynPrompt)
categoryText :: Text
categoryText :: Text
categoryText =
[text|
List of categories to choose from:
* Control * Concurrency
* Codec * Graphics
* Data * Sound
* Math * System
* Parsing * Network
* Text
* Application * Development
* Compilers/Interpreters * Testing
* Web
* Game
* Utility
|]
licenseText :: Text
licenseText :: Text
licenseText = "List of licenses to choose from:\n\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ((LicenseName -> Text) -> [LicenseName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map LicenseName -> Text
showShort ([LicenseName] -> [Text]) -> [LicenseName] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Bounded LicenseName, Enum LicenseName) => [LicenseName]
forall a. (Bounded a, Enum a) => [a]
universe @LicenseName)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"
where
showShort :: LicenseName -> Text
showShort :: LicenseName -> Text
showShort l :: LicenseName
l = " * " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LicenseName -> Text
forall b a. (Show a, IsString b) => a -> b
show LicenseName
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LicenseName -> Text
licenseShortDesc LicenseName
l
getPrelude :: IO (Maybe CustomPrelude)
getPrelude :: IO (Maybe CustomPrelude)
getPrelude = case Last CustomPrelude
cPrelude of
Last Nothing -> do
Text
p <- Text -> [Text] -> Text -> (Text -> Bool) -> IO Text
queryWithPredicate
"Custom prelude package (leave empty if no custom prelude is needed): "
[]
"Name can contain letters/numbers/'-'"
Text -> Bool
packageNameValid
if Text
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "" then Maybe CustomPrelude
forall a. Maybe a
Nothing Maybe CustomPrelude -> IO () -> IO (Maybe CustomPrelude)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> IO ()
skipMessage "No custom prelude will be used in the project"
else do
let defModule :: Text
defModule = Text -> Text
packageToModule Text
p
Text
input <- Text -> [Text] -> Text -> (Text -> Bool) -> IO Text
queryWithPredicate
"Custom prelude module: "
[Text
defModule]
"Name can contain dot-separated capitalized letter/numeral fragments. Ex: This.Is.Valid1"
Text -> Bool
moduleNameValid
let m :: Text
m = if Text
input Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "" then Text
defModule else Text
input
Text -> IO ()
successMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Custom prelude " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " will be used in the project"
Maybe CustomPrelude -> IO (Maybe CustomPrelude)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe CustomPrelude -> IO (Maybe CustomPrelude))
-> Maybe CustomPrelude -> IO (Maybe CustomPrelude)
forall a b. (a -> b) -> a -> b
$ CustomPrelude -> Maybe CustomPrelude
forall a. a -> Maybe a
Just (CustomPrelude -> Maybe CustomPrelude)
-> CustomPrelude -> Maybe CustomPrelude
forall a b. (a -> b) -> a -> b
$ Text -> Text -> CustomPrelude
CustomPrelude Text
p Text
m
Last prelude :: Maybe CustomPrelude
prelude@(Just (CustomPrelude p :: Text
p _)) ->
Maybe CustomPrelude
prelude Maybe CustomPrelude -> IO () -> IO (Maybe CustomPrelude)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> IO ()
successMessage ("Custom prelude " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " will be used in the project")
getCabalStack :: (Decision, Decision) -> IO (Bool, Bool)
getCabalStack :: (Decision, Decision) -> IO (Bool, Bool)
getCabalStack = \case
(Idk, Idk) -> Decision -> YesNoPrompt -> IO Bool
promptDecisionToBool Decision
cCabal (Text -> YesNoPrompt
mkDefaultYesNoPrompt "cabal") IO Bool -> (Bool -> IO (Bool, Bool)) -> IO (Bool, Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \c :: Bool
c ->
if Bool
c then Decision -> YesNoPrompt -> IO Bool
promptDecisionToBool Decision
cStack (Text -> YesNoPrompt
mkDefaultYesNoPrompt "stack") IO Bool -> (Bool -> IO (Bool, Bool)) -> IO (Bool, Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s :: Bool
s -> (Bool, Bool) -> IO (Bool, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
c, Bool
s)
else Bool -> IO Bool
stackMsg Bool
True IO Bool -> IO (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool, Bool) -> IO (Bool, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, Bool
True)
(Nop, Nop) -> Text -> IO ()
errorMessage "Neither cabal nor stack was chosen" IO () -> IO (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Bool, Bool)
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
(Yes, Yes) -> (Bool, Bool) -> IO (Bool, Bool)
output (Bool
True, Bool
True)
(Yes, _) -> (Bool, Bool) -> IO (Bool, Bool)
output (Bool
True, Bool
False)
(_, Yes) -> (Bool, Bool) -> IO (Bool, Bool)
output (Bool
False, Bool
True)
(Nop, Idk) -> (Bool, Bool) -> IO (Bool, Bool)
output (Bool
False, Bool
True)
(Idk, Nop) -> (Bool, Bool) -> IO (Bool, Bool)
output (Bool
True, Bool
False)
where
output :: (Bool, Bool) -> IO (Bool, Bool)
output :: (Bool, Bool) -> IO (Bool, Bool)
output x :: (Bool, Bool)
x@(c :: Bool
c, s :: Bool
s) = Bool -> IO Bool
cabalMsg Bool
c IO Bool -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
stackMsg Bool
s IO Bool -> IO (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool, Bool) -> IO (Bool, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool, Bool)
x
cabalMsg :: Bool -> IO Bool
cabalMsg c :: Bool
c = Bool -> Text -> Text -> IO Bool
targetMessageWithText Bool
c "Cabal" "used in this project"
stackMsg :: Bool -> IO Bool
stackMsg c :: Bool
c = Bool -> Text -> Text -> IO Bool
targetMessageWithText Bool
c "Stack" "used in this project"
generateProjectNonInteractive
:: ConnectMode
-> Text
-> Config
-> IO ()
generateProjectNonInteractive :: ConnectMode -> Text -> Config -> IO ()
generateProjectNonInteractive connectMode :: ConnectMode
connectMode projectName :: Text
projectName ConfigP{..} = do
Bool
isNonUnique <- Text -> IO Bool
doesExistProjectName Text
projectName
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isNonUnique (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Text -> IO ()
errorMessage "Project with this name is already exist. Please choose another one."
IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
let settingsRepo :: Text
settingsRepo = Text
projectName
let (settingsCabal :: Bool
settingsCabal, settingsStack :: Bool
settingsStack) = (Decision, Decision) -> (Bool, Bool)
decisionsToBools (Decision
cCabal, Decision
cStack)
let settingsOwner :: 'Final :- Text
settingsOwner = 'Final :- Text
cOwner
let settingsDescription :: Text
settingsDescription = Text
defaultDescription
let settingsFullName :: 'Final :- Text
settingsFullName = 'Final :- Text
cFullName
let settingsEmail :: 'Final :- Text
settingsEmail = 'Final :- Text
cEmail
let settingsCategories :: Text
settingsCategories = ""
let settingsLicenseName :: LicenseName
settingsLicenseName = if ConnectMode -> Bool
isOffline ConnectMode
connectMode then LicenseName
NONE else LicenseName
'Final :- LicenseName
cLicense
Text
settingsYear <- IO Text
currentYear
License
settingsLicenseText <- LicenseName -> Text -> Text -> IO License
fetchLicenseCustom
LicenseName
settingsLicenseName
Text
settingsFullName
Text
settingsYear
let settingsGitHub :: Bool
settingsGitHub = Decision -> Bool
decisionToBool Decision
cGitHub
let settingsNoUpload :: Bool
settingsNoUpload = Any -> Bool
getAny Any
cNoUpload Bool -> Bool -> Bool
|| ConnectMode -> Bool
isOffline ConnectMode
connectMode
let settingsPrivate :: Bool
settingsPrivate = Bool -> Decision -> Bool
decisionIf (Bool
settingsGitHub Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
settingsNoUpload) Decision
cPrivate
let settingsGhActions :: Bool
settingsGhActions = Bool -> Decision -> Bool
decisionIf (Bool
settingsCabal Bool -> Bool -> Bool
&& Bool
settingsGitHub) Decision
cGhActions
let settingsTravis :: Bool
settingsTravis = Bool -> Decision -> Bool
decisionIf Bool
settingsGitHub Decision
cTravis
let settingsAppVeyor :: Bool
settingsAppVeyor = Bool -> Decision -> Bool
decisionIf Bool
settingsGitHub Decision
cAppVey
let (settingsIsLib :: Bool
settingsIsLib, settingsIsExe :: Bool
settingsIsExe) = (Decision, Decision) -> (Bool, Bool)
decisionsToBools (Decision
cLib, Decision
cExe)
let settingsTest :: Bool
settingsTest = Decision -> Bool
decisionToBool Decision
cTest
let settingsBench :: Bool
settingsBench = Decision -> Bool
decisionToBool Decision
cBench
let settingsPrelude :: Maybe CustomPrelude
settingsPrelude = Last CustomPrelude -> Maybe CustomPrelude
forall a. Last a -> Maybe a
getLast Last CustomPrelude
cPrelude
let settingsExtensions :: [Text]
settingsExtensions = [Text]
cExtensions
let settingsGhcOptions :: [Text]
settingsGhcOptions = [Text]
cGhcOptions
let settingsGitignore :: [Text]
settingsGitignore = [Text]
cGitignore
let settingsTestedVersions :: [GhcVer]
settingsTestedVersions = [GhcVer] -> [GhcVer]
forall a. Ord a => [a] -> [a]
sortNub ([GhcVer] -> [GhcVer]) -> [GhcVer] -> [GhcVer]
forall a b. (a -> b) -> a -> b
$ GhcVer
defaultGHC GhcVer -> [GhcVer] -> [GhcVer]
forall a. a -> [a] -> [a]
: [GhcVer]
'Final :- [GhcVer]
cGhcVer
[TreeFs]
settingsFiles <- ConnectMode -> Map FilePath Source -> IO [TreeFs]
fetchSources ConnectMode
connectMode Map FilePath Source
cFiles
Settings -> IO ()
initializeProject $WSettings :: Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> LicenseName
-> License
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> [GhcVer]
-> Maybe CustomPrelude
-> [Text]
-> [Text]
-> [Text]
-> Bool
-> Bool
-> Bool
-> [TreeFs]
-> Settings
Settings{..}
where
decisionIf :: Bool -> Decision -> Bool
decisionIf :: Bool -> Decision -> Bool
decisionIf p :: Bool
p d :: Decision
d = Bool
p Bool -> Bool -> Bool
&& Decision -> Bool
decisionToBool Decision
d
initializeProject :: Settings -> IO ()
initializeProject :: Settings -> IO ()
initializeProject settings :: Settings
settings@Settings{..} = do
Settings -> IO ()
createProjectDirectory Settings
settings
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
settingsGitHub (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Settings -> IO ()
doGithubCommands Settings
settings
[Text] -> Text -> IO ()
formattedMessage [Text
forall str. IsString str => str
bold, Text
forall str. IsString str => str
green] "\nJob's done"
createProjectDirectory :: Settings -> IO ()
createProjectDirectory :: Settings -> IO ()
createProjectDirectory settings :: Settings
settings@Settings{..} = do
let tree :: TreeFs
tree = Settings -> TreeFs
createProjectTemplate Settings
settings
TreeFs -> IO ()
traverseTree TreeFs
tree
Text -> IO ()
successMessage "The project with the following structure has been created:"
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ TreeFs -> Text
showBoldTree TreeFs
tree
FilePath -> IO ()
setCurrentDirectory (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
settingsRepo)
doGithubCommands :: Settings -> IO ()
doGithubCommands :: Settings -> IO ()
doGithubCommands Settings{..} = do
"git" ["init"]
"git" ["add", "."]
"git" ["commit", "-m", "Create the project"]
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
settingsNoUpload (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let repo :: Text
repo = Text
settingsOwner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsRepo
Maybe FilePath
hubInstalled <- FilePath -> IO (Maybe FilePath)
findExecutable "hub"
case Maybe FilePath
hubInstalled of
Just _ -> do
Bool
isHubSuccess <- Text -> IO Bool
runHub Text
repo
if Bool
isHubSuccess
then "git" ["push", "-u", "origin", "master"]
else do
Text -> IO ()
warningMessage "Error running 'hub'. Possible reason: incorrect password."
Text -> IO ()
hubHelp Text
repo
Nothing -> do
Text -> IO ()
warningMessage "'hub' is not found at this machine. Cannot create the GitHub repository."
Text -> IO ()
warningMessage "Please install 'hub' for the proper work of Summoner."
Text -> IO ()
hubHelp Text
repo
where
runHub :: Text -> IO Bool
runHub :: Text -> IO Bool
runHub repo :: Text
repo =
Bool
True Bool -> IO () -> IO Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ "hub" (["create", "-d", Text
settingsDescription, Text
repo]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ["-p" | Bool
settingsPrivate])
IO Bool -> IO Bool -> IO Bool
forall a. IO a -> IO a -> IO a
$? Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
hubHelp :: Text -> IO ()
hubHelp :: Text -> IO ()
hubHelp repo :: Text
repo = do
Text -> IO ()
infoMessage "To finish the process manually you can run the following command:"
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ " $ hub create -d '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
settingsDescription Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
repo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse Bool
settingsPrivate " -p"