{-# LANGUAGE QuasiQuotes #-}

{- HLINT ignore "Reduce duplication" -}

{- |
Copyright: (c) 2017-2019 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

This module introduces functions for the project creation.
-}

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


-- | Generate the project.
generateProject
    :: Interactivity  -- ^ Is it interactive or non-interactive mode?
    -> ConnectMode    -- ^ @offline@ mode option.
    -> Text           -- ^ Given project name.
    -> Config         -- ^ Given configurations.
    -> IO ()
generateProject :: Interactivity -> ConnectMode -> Text -> Config -> IO ()
generateProject Interactive    = ConnectMode -> Text -> Config -> IO ()
generateProjectInteractive
generateProject NonInteractive = ConnectMode -> Text -> Config -> IO ()
generateProjectNonInteractive


-- | Generate the project.
generateProjectInteractive
    :: ConnectMode    -- ^ @offline@ mode option.
    -> Text           -- ^ Given project name.
    -> Config         -- ^ Given configurations.
    -> IO ()
generateProjectInteractive :: ConnectMode -> Text -> Config -> IO ()
generateProjectInteractive connectMode :: ConnectMode
connectMode projectName :: Text
projectName ConfigP{..} = do
    Text
settingsRepo <- Text -> IO Text
checkUniqueName Text
projectName
    -- decide cabal stack or both
    (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)

    -- License creation
    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

    -- Create project data from all variables in scope
    -- and make a project from it.
    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")

    -- get what build tool to use in the project
    -- If user chose only one during CLI, we assume to use only that one.
    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"

----------------------------------------------------------------------------
-- Non-interactive
----------------------------------------------------------------------------

generateProjectNonInteractive
    :: ConnectMode    -- ^ @offline@ mode option.
    -> Text           -- ^ Given project name.
    -> Config         -- ^ Given configurations.
    -> 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
    -- decide cabal stack or both
    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

    -- License creation
    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

    -- Create project data from all variables in scope
    -- and make a project from it.
    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

----------------------------------------------------------------------------
-- Initialize
----------------------------------------------------------------------------

-- | Creates the directory and run GitHub commands.
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"

-- | From the given 'Settings' creates the project.
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)

-- | Init, commit and push repository to GitHub.
doGithubCommands :: Settings -> IO ()
doGithubCommands :: Settings -> IO ()
doGithubCommands Settings{..} = do
    -- Create git repostitory and do a commit.
    "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
    -- Create repo on GitHub and return 'True' in case of sucsess
    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])  -- Create private repository if asked so
             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"