{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Rank2Types             #-}
{-# LANGUAGE TemplateHaskell        #-}

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

This module contains data types to work with application form. 'SummonKit' is
the data type containing the values manipulated by the fields in the form.
-}

module Summoner.Tui.Kit
       ( -- * Data types
         SummonKit (..)
       , User (..)
       , Project (..)
       , ProjectMeta (..)
       , GitHub (..)
       , renderWidgetTree
       , configToSummonKit
       , finalSettings

         -- * Lenses
         -- ** SummonKit
       , user
       , project
       , cabal
       , stack
       , projectMeta
       , gitHub
       , extensions
       , ghcOptions
       , connectMode
       , shouldSummon
       , configFile

         -- ** User
       , owner
       , fullName
       , email

         -- ** Project
       , repo
       , desc
       , category
       , license
       , maybeLicense

         -- ** ProjectMeta
       , lib
       , exe
       , test
       , bench
       , ghcs
       , preludeName
       , preludeModule

         -- ** GitHub
       , enabled
       , noUpload
       , private
       , actions
       , travis
       , appVeyor
       ) where

import Lens.Micro (Lens', lens, (.~), (^.))
import Lens.Micro.TH (makeFields)

import Summoner.Config (Config, ConfigP (..))
import Summoner.CustomPrelude (CustomPrelude (..))
import Summoner.Decision (Decision (..), decisionToBool, decisionsToBools)
import Summoner.Default (currentYear, defaultDescription, defaultGHC)
import Summoner.GhcVer (GhcVer)
import Summoner.License (LicenseName (..), fetchLicenseCustom)
import Summoner.Mode (ConnectMode (..), isOffline)
import Summoner.Settings (Settings (..))
import Summoner.Template (createProjectTemplate)
import Summoner.Tree (TreeFs, showTree)

import qualified Data.List as List (delete)
import qualified Data.Text as T


-- | Global TUI state.
data SummonKit = SummonKit
    { SummonKit -> User
summonKitUser         :: !User
    , SummonKit -> Project
summonKitProject      :: !Project
    , SummonKit -> Bool
summonKitCabal        :: !Bool
    , SummonKit -> Bool
summonKitStack        :: !Bool
    , SummonKit -> ProjectMeta
summonKitProjectMeta  :: !ProjectMeta
    , SummonKit -> GitHub
summonKitGitHub       :: !GitHub
    , SummonKit -> [Text]
summonKitExtensions   :: ![Text]  -- ^ Can be recieved from the config file.
    , SummonKit -> [Text]
summonKitGhcOptions   :: ![Text]  -- ^ Can be recieved from the config file.
    , SummonKit -> [Text]
summonKitGitignore    :: ![Text]  -- ^ Received from the config file.
    , SummonKit -> ConnectMode
summonKitConnectMode  :: !ConnectMode
    , SummonKit -> Decision
summonKitShouldSummon :: !Decision  -- ^ Check if project needs to be created.
    , SummonKit -> Maybe FilePath
summonKitConfigFile   :: !(Maybe FilePath)  -- ^ Just if configuration file was used.
    , SummonKit -> [TreeFs]
summonKitExtraFiles   :: ![TreeFs]  -- ^ Extra files
    } deriving stock (Int -> SummonKit -> ShowS
[SummonKit] -> ShowS
SummonKit -> FilePath
(Int -> SummonKit -> ShowS)
-> (SummonKit -> FilePath)
-> ([SummonKit] -> ShowS)
-> Show SummonKit
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SummonKit] -> ShowS
$cshowList :: [SummonKit] -> ShowS
show :: SummonKit -> FilePath
$cshow :: SummonKit -> FilePath
showsPrec :: Int -> SummonKit -> ShowS
$cshowsPrec :: Int -> SummonKit -> ShowS
Show)

-- | User information.
data User = User
    { User -> Text
userOwner    :: !Text  -- ^ GitHub user or organization name.
    , User -> Text
userFullName :: !Text
    , User -> Text
userEmail    :: !Text
    } deriving stock (Int -> User -> ShowS
[User] -> ShowS
User -> FilePath
(Int -> User -> ShowS)
-> (User -> FilePath) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> FilePath
$cshow :: User -> FilePath
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show)

-- | Project related information
data Project = Project
    { Project -> Text
projectRepo     :: !Text  -- ^ Project name.
    , Project -> Text
projectDesc     :: !Text  -- ^ Short project description.
    , Project -> Text
projectCategory :: !Text  -- ^ Comma-separated. See @Hackage@ for existing category list.
    , Project -> LicenseName
projectLicense  :: !LicenseName
    } deriving stock (Int -> Project -> ShowS
[Project] -> ShowS
Project -> FilePath
(Int -> Project -> ShowS)
-> (Project -> FilePath) -> ([Project] -> ShowS) -> Show Project
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Project] -> ShowS
$cshowList :: [Project] -> ShowS
show :: Project -> FilePath
$cshow :: Project -> FilePath
showsPrec :: Int -> Project -> ShowS
$cshowsPrec :: Int -> Project -> ShowS
Show)

-- | Project meta information.
data ProjectMeta = ProjectMeta
    { ProjectMeta -> Bool
projectMetaLib           :: !Bool
    , ProjectMeta -> Bool
projectMetaExe           :: !Bool
    , ProjectMeta -> Bool
projectMetaTest          :: !Bool
    , ProjectMeta -> Bool
projectMetaBench         :: !Bool
    , ProjectMeta -> [GhcVer]
projectMetaGhcs          :: ![GhcVer]  -- ^ Default GHC version is always added.
    , ProjectMeta -> Text
projectMetaPreludeName   :: !Text
    , ProjectMeta -> Text
projectMetaPreludeModule :: !Text
    } deriving stock (Int -> ProjectMeta -> ShowS
[ProjectMeta] -> ShowS
ProjectMeta -> FilePath
(Int -> ProjectMeta -> ShowS)
-> (ProjectMeta -> FilePath)
-> ([ProjectMeta] -> ShowS)
-> Show ProjectMeta
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectMeta] -> ShowS
$cshowList :: [ProjectMeta] -> ShowS
show :: ProjectMeta -> FilePath
$cshow :: ProjectMeta -> FilePath
showsPrec :: Int -> ProjectMeta -> ShowS
$cshowsPrec :: Int -> ProjectMeta -> ShowS
Show)

-- | Github specific information.
data GitHub = GitHub
    { GitHub -> Bool
gitHubEnabled  :: !Bool
    , GitHub -> Bool
gitHubNoUpload :: !Bool  -- ^ Do not upload to GitHub, only local initialization.
    , GitHub -> Bool
gitHubPrivate  :: !Bool
    , GitHub -> Bool
gitHubActions  :: !Bool
    , GitHub -> Bool
gitHubTravis   :: !Bool
    , GitHub -> Bool
gitHubAppVeyor :: !Bool
    } deriving stock (Int -> GitHub -> ShowS
[GitHub] -> ShowS
GitHub -> FilePath
(Int -> GitHub -> ShowS)
-> (GitHub -> FilePath) -> ([GitHub] -> ShowS) -> Show GitHub
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GitHub] -> ShowS
$cshowList :: [GitHub] -> ShowS
show :: GitHub -> FilePath
$cshow :: GitHub -> FilePath
showsPrec :: Int -> GitHub -> ShowS
$cshowsPrec :: Int -> GitHub -> ShowS
Show)

makeFields ''SummonKit
makeFields ''User
makeFields ''Project
makeFields ''ProjectMeta
makeFields ''GitHub

-- | Lens for 'Maybe' 'LicenseName' in 'SummonKit'.
maybeLicense :: Lens' SummonKit (Maybe LicenseName)
maybeLicense :: (Maybe LicenseName -> f (Maybe LicenseName))
-> SummonKit -> f SummonKit
maybeLicense = (SummonKit -> Maybe LicenseName)
-> (SummonKit -> Maybe LicenseName -> SummonKit)
-> Lens SummonKit SummonKit (Maybe LicenseName) (Maybe LicenseName)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SummonKit -> Maybe LicenseName
getL SummonKit -> Maybe LicenseName -> SummonKit
setL
  where
    getL :: SummonKit -> Maybe LicenseName
    getL :: SummonKit -> Maybe LicenseName
getL = LicenseName -> Maybe LicenseName
forall a. a -> Maybe a
Just (LicenseName -> Maybe LicenseName)
-> (SummonKit -> LicenseName) -> SummonKit -> Maybe LicenseName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> LicenseName
projectLicense (Project -> LicenseName)
-> (SummonKit -> Project) -> SummonKit -> LicenseName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SummonKit -> Project
summonKitProject

    setL :: SummonKit -> Maybe LicenseName -> SummonKit
    setL :: SummonKit -> Maybe LicenseName -> SummonKit
setL sk :: SummonKit
sk mbL :: Maybe LicenseName
mbL = case Maybe LicenseName
mbL of
        Just l :: LicenseName
l  -> SummonKit
sk SummonKit -> (SummonKit -> SummonKit) -> SummonKit
forall a b. a -> (a -> b) -> b
& (Project -> Identity Project) -> SummonKit -> Identity SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> Identity Project) -> SummonKit -> Identity SummonKit)
-> ((LicenseName -> Identity LicenseName)
    -> Project -> Identity Project)
-> (LicenseName -> Identity LicenseName)
-> SummonKit
-> Identity SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LicenseName -> Identity LicenseName)
-> Project -> Identity Project
forall s a. HasLicense s a => Lens' s a
license ((LicenseName -> Identity LicenseName)
 -> SummonKit -> Identity SummonKit)
-> LicenseName -> SummonKit -> SummonKit
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LicenseName
l
        Nothing -> SummonKit
sk

-- | Converts 'SummonKit' to main 'Settings' data type.
summonKitToSettings :: SummonKit -> Settings
summonKitToSettings :: SummonKit -> Settings
summonKitToSettings sk :: SummonKit
sk = $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
    { settingsRepo :: Text
settingsRepo           = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SummonKit
sk SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (Project -> Const Text Project)
-> SummonKit -> Const Text SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> Const Text Project)
 -> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text) -> Project -> Const Text Project)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> Project -> Const Text Project
forall s a. HasRepo s a => Lens' s a
repo
    , settingsOwner :: Text
settingsOwner          = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SummonKit
sk SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (User -> Const Text User) -> SummonKit -> Const Text SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> Const Text User) -> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text) -> User -> Const Text User)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> User -> Const Text User
forall s a. HasOwner s a => Lens' s a
owner
    , settingsDescription :: Text
settingsDescription    = Text -> Text
T.strip (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall t. IsText t "unwords" => [t] -> t
unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall t. IsText t "lines" => t -> [t]
lines (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SummonKit
sk SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (Project -> Const Text Project)
-> SummonKit -> Const Text SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> Const Text Project)
 -> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text) -> Project -> Const Text Project)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> Project -> Const Text Project
forall s a. HasDesc s a => Lens' s a
desc
    , settingsFullName :: Text
settingsFullName       = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SummonKit
sk SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (User -> Const Text User) -> SummonKit -> Const Text SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> Const Text User) -> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text) -> User -> Const Text User)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> User -> Const Text User
forall s a. HasFullName s a => Lens' s a
fullName
    , settingsEmail :: Text
settingsEmail          = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SummonKit
sk SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (User -> Const Text User) -> SummonKit -> Const Text SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> Const Text User) -> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text) -> User -> Const Text User)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> User -> Const Text User
forall s a. HasEmail s a => Lens' s a
email
    , settingsYear :: Text
settingsYear           = "20!8"
    , settingsCategories :: Text
settingsCategories     = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SummonKit
sk SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (Project -> Const Text Project)
-> SummonKit -> Const Text SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> Const Text Project)
 -> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text) -> Project -> Const Text Project)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> Project -> Const Text Project
forall s a. HasCategory s a => Lens' s a
category
    , settingsLicenseName :: LicenseName
settingsLicenseName    = SummonKit
sk SummonKit
-> Getting LicenseName SummonKit LicenseName -> LicenseName
forall s a. s -> Getting a s a -> a
^. (Project -> Const LicenseName Project)
-> SummonKit -> Const LicenseName SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> Const LicenseName Project)
 -> SummonKit -> Const LicenseName SummonKit)
-> ((LicenseName -> Const LicenseName LicenseName)
    -> Project -> Const LicenseName Project)
-> Getting LicenseName SummonKit LicenseName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LicenseName -> Const LicenseName LicenseName)
-> Project -> Const LicenseName Project
forall s a. HasLicense s a => Lens' s a
license
    , settingsLicenseText :: License
settingsLicenseText    = ""
    , settingsGitHub :: Bool
settingsGitHub         = Bool
isGitHub
    , settingsGhActions :: Bool
settingsGhActions      = Bool
isGitHub Bool -> Bool -> Bool
&& SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GitHub -> Const Bool GitHub) -> SummonKit -> Const Bool SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> Const Bool GitHub)
 -> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub
forall s a. HasActions s a => Lens' s a
actions Bool -> Bool -> Bool
&& SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool SummonKit Bool
forall s a. HasCabal s a => Lens' s a
cabal
    , settingsPrivate :: Bool
settingsPrivate        = Bool
isGitHub Bool -> Bool -> Bool
&& SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GitHub -> Const Bool GitHub) -> SummonKit -> Const Bool SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> Const Bool GitHub)
 -> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub
forall s a. HasPrivate s a => Lens' s a
private
    , settingsTravis :: Bool
settingsTravis         = Bool
isGitHub Bool -> Bool -> Bool
&& SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GitHub -> Const Bool GitHub) -> SummonKit -> Const Bool SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> Const Bool GitHub)
 -> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub
forall s a. HasTravis s a => Lens' s a
travis
    , settingsAppVeyor :: Bool
settingsAppVeyor       = Bool
isGitHub Bool -> Bool -> Bool
&& SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GitHub -> Const Bool GitHub) -> SummonKit -> Const Bool SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> Const Bool GitHub)
 -> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub
forall s a. HasAppVeyor s a => Lens' s a
appVeyor
    , settingsIsLib :: Bool
settingsIsLib          = SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Bool ProjectMeta)
-> SummonKit -> Const Bool SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Bool ProjectMeta)
 -> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool)
    -> ProjectMeta -> Const Bool ProjectMeta)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> ProjectMeta -> Const Bool ProjectMeta
forall s a. HasLib s a => Lens' s a
lib
    , settingsIsExe :: Bool
settingsIsExe          = SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Bool ProjectMeta)
-> SummonKit -> Const Bool SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Bool ProjectMeta)
 -> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool)
    -> ProjectMeta -> Const Bool ProjectMeta)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> ProjectMeta -> Const Bool ProjectMeta
forall s a. HasExe s a => Lens' s a
exe
    , settingsTest :: Bool
settingsTest           = SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Bool ProjectMeta)
-> SummonKit -> Const Bool SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Bool ProjectMeta)
 -> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool)
    -> ProjectMeta -> Const Bool ProjectMeta)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> ProjectMeta -> Const Bool ProjectMeta
forall s a. HasTest s a => Lens' s a
test
    , settingsBench :: Bool
settingsBench          = SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Bool ProjectMeta)
-> SummonKit -> Const Bool SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Bool ProjectMeta)
 -> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool)
    -> ProjectMeta -> Const Bool ProjectMeta)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> ProjectMeta -> Const Bool ProjectMeta
forall s a. HasBench s a => Lens' s a
bench
    , 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]
: (SummonKit
sk SummonKit -> Getting [GhcVer] SummonKit [GhcVer] -> [GhcVer]
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const [GhcVer] ProjectMeta)
-> SummonKit -> Const [GhcVer] SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const [GhcVer] ProjectMeta)
 -> SummonKit -> Const [GhcVer] SummonKit)
-> (([GhcVer] -> Const [GhcVer] [GhcVer])
    -> ProjectMeta -> Const [GhcVer] ProjectMeta)
-> Getting [GhcVer] SummonKit [GhcVer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([GhcVer] -> Const [GhcVer] [GhcVer])
-> ProjectMeta -> Const [GhcVer] ProjectMeta
forall s a. HasGhcs s a => Lens' s a
ghcs)
    , settingsPrelude :: Maybe CustomPrelude
settingsPrelude        = Maybe CustomPrelude
cP
    , settingsExtensions :: [Text]
settingsExtensions     = SummonKit
sk SummonKit -> Getting [Text] SummonKit [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. Getting [Text] SummonKit [Text]
forall s a. HasExtensions s a => Lens' s a
extensions
    , settingsGhcOptions :: [Text]
settingsGhcOptions     = SummonKit
sk SummonKit -> Getting [Text] SummonKit [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. Getting [Text] SummonKit [Text]
forall s a. HasGhcOptions s a => Lens' s a
ghcOptions
    , settingsGitignore :: [Text]
settingsGitignore      = SummonKit
sk SummonKit -> Getting [Text] SummonKit [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. Getting [Text] SummonKit [Text]
forall s a. HasGitignore s a => Lens' s a
gitignore
    , settingsCabal :: Bool
settingsCabal          = SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool SummonKit Bool
forall s a. HasCabal s a => Lens' s a
cabal
    , settingsStack :: Bool
settingsStack          = SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool SummonKit Bool
forall s a. HasStack s a => Lens' s a
stack
    , settingsNoUpload :: Bool
settingsNoUpload       = SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GitHub -> Const Bool GitHub) -> SummonKit -> Const Bool SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> Const Bool GitHub)
 -> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub
forall s a. HasNoUpload s a => Lens' s a
noUpload
    , settingsFiles :: [TreeFs]
settingsFiles          = SummonKit
sk SummonKit -> Getting [TreeFs] SummonKit [TreeFs] -> [TreeFs]
forall s a. s -> Getting a s a -> a
^. Getting [TreeFs] SummonKit [TreeFs]
forall s a. HasExtraFiles s a => Lens' s a
extraFiles
    }
  where
    isGitHub :: Bool
    isGitHub :: Bool
isGitHub = SummonKit
sk SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GitHub -> Const Bool GitHub) -> SummonKit -> Const Bool SummonKit
forall s a. HasGitHub s a => Lens' s a
gitHub ((GitHub -> Const Bool GitHub)
 -> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> GitHub -> Const Bool GitHub
forall s a. HasEnabled s a => Lens' s a
enabled

    cP ::  Maybe CustomPrelude
    cP :: Maybe CustomPrelude
cP =
        let cpPackage :: Text
cpPackage = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SummonKit
sk SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Text ProjectMeta)
-> SummonKit -> Const Text SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Text ProjectMeta)
 -> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text)
    -> ProjectMeta -> Const Text ProjectMeta)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> ProjectMeta -> Const Text ProjectMeta
forall s a. HasPreludeName s a => Lens' s a
preludeName
            cpModule :: Text
cpModule  = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SummonKit
sk SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Text ProjectMeta)
-> SummonKit -> Const Text SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Text ProjectMeta)
 -> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text)
    -> ProjectMeta -> Const Text ProjectMeta)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> ProjectMeta -> Const Text ProjectMeta
forall s a. HasPreludeModule s a => Lens' s a
preludeModule
        in if ("" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
cpPackage) Bool -> Bool -> Bool
&& ("" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
cpModule)
           then CustomPrelude -> Maybe CustomPrelude
forall a. a -> Maybe a
Just $WCustomPrelude :: Text -> Text -> CustomPrelude
CustomPrelude{..}
           else Maybe CustomPrelude
forall a. Maybe a
Nothing

-- | Gets 'Settings' on successful application complition.
finalSettings :: SummonKit -> IO Settings
finalSettings :: SummonKit -> IO Settings
finalSettings sk :: SummonKit
sk = do
    Text
year <- IO Text
currentYear
    let licenseName :: LicenseName
licenseName = SummonKit
sk SummonKit
-> Getting LicenseName SummonKit LicenseName -> LicenseName
forall s a. s -> Getting a s a -> a
^. (Project -> Const LicenseName Project)
-> SummonKit -> Const LicenseName SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> Const LicenseName Project)
 -> SummonKit -> Const LicenseName SummonKit)
-> ((LicenseName -> Const LicenseName LicenseName)
    -> Project -> Const LicenseName Project)
-> Getting LicenseName SummonKit LicenseName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LicenseName -> Const LicenseName LicenseName)
-> Project -> Const LicenseName Project
forall s a. HasLicense s a => Lens' s a
license
    License
licenseText <- LicenseName -> Text -> Text -> IO License
fetchLicenseCustom
        LicenseName
licenseName
        (SummonKit
sk SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (User -> Const Text User) -> SummonKit -> Const Text SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> Const Text User) -> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text) -> User -> Const Text User)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> User -> Const Text User
forall s a. HasFullName s a => Lens' s a
fullName)
        Text
year

    Settings -> IO Settings
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SummonKit -> Settings
summonKitToSettings SummonKit
sk)
        { settingsYear :: Text
settingsYear = Text
year
        , settingsLicenseText :: License
settingsLicenseText = License
licenseText
        }

-- | Gets the initial 'SummonKit' from the given 'Config'.
configToSummonKit
    :: Text  -- ^ Given project name
    -> ConnectMode  -- ^  @offline@ mode option
    -> Maybe FilePath  -- ^ Configuration file used
    -> [TreeFs]  -- ^ Extra files
    -> Config  -- ^ Given configurations.
    -> SummonKit
configToSummonKit :: Text
-> ConnectMode -> Maybe FilePath -> [TreeFs] -> Config -> SummonKit
configToSummonKit cRepo :: Text
cRepo cConnectMode :: ConnectMode
cConnectMode cConfigFile :: Maybe FilePath
cConfigFile files :: [TreeFs]
files ConfigP{..} = $WSummonKit :: User
-> Project
-> Bool
-> Bool
-> ProjectMeta
-> GitHub
-> [Text]
-> [Text]
-> [Text]
-> ConnectMode
-> Decision
-> Maybe FilePath
-> [TreeFs]
-> SummonKit
SummonKit
    { summonKitUser :: User
summonKitUser  = $WUser :: Text -> Text -> Text -> User
User
        { userOwner :: Text
userOwner    = Text
'Final :- Text
cOwner
        , userFullName :: Text
userFullName = Text
'Final :- Text
cFullName
        , userEmail :: Text
userEmail    = Text
'Final :- Text
cEmail
        }
    , summonKitProject :: Project
summonKitProject = $WProject :: Text -> Text -> Text -> LicenseName -> Project
Project
        { projectRepo :: Text
projectRepo     = Text
cRepo
        , projectDesc :: Text
projectDesc     = Text
defaultDescription
        , projectCategory :: Text
projectCategory = ""
        , projectLicense :: LicenseName
projectLicense  = if ConnectMode -> Bool
isOffline ConnectMode
cConnectMode then LicenseName
NONE else 'Final :- LicenseName
LicenseName
cLicense
        }
    , summonKitProjectMeta :: ProjectMeta
summonKitProjectMeta = $WProjectMeta :: Bool
-> Bool -> Bool -> Bool -> [GhcVer] -> Text -> Text -> ProjectMeta
ProjectMeta
        { projectMetaLib :: Bool
projectMetaLib = Bool
kitLib
        , projectMetaExe :: Bool
projectMetaExe = Bool
kitExe
        , projectMetaTest :: Bool
projectMetaTest  = Decision -> Bool
decisionToBool Decision
cTest
        , projectMetaBench :: Bool
projectMetaBench = Decision -> Bool
decisionToBool Decision
cBench
        , projectMetaGhcs :: [GhcVer]
projectMetaGhcs = GhcVer -> [GhcVer] -> [GhcVer]
forall a. Eq a => a -> [a] -> [a]
List.delete GhcVer
defaultGHC [GhcVer]
'Final :- [GhcVer]
cGhcVer
        , projectMetaPreludeName :: Text
projectMetaPreludeName = Text
kitPreludeName
        , projectMetaPreludeModule :: Text
projectMetaPreludeModule = Text
kitPreludeModule
        }
    , summonKitCabal :: Bool
summonKitCabal = Bool
kitCabal
    , summonKitStack :: Bool
summonKitStack = Bool
kitStack
    , summonKitGitHub :: GitHub
summonKitGitHub = $WGitHub :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> GitHub
GitHub
        { gitHubEnabled :: Bool
gitHubEnabled  = Decision
cGitHub Decision -> Decision -> Bool
forall a. Eq a => a -> a -> Bool
/= Decision
Nop
        , gitHubNoUpload :: Bool
gitHubNoUpload = Any -> Bool
getAny Any
cNoUpload Bool -> Bool -> Bool
|| ConnectMode -> Bool
isOffline ConnectMode
cConnectMode
        , gitHubPrivate :: Bool
gitHubPrivate  = Decision -> Bool
decisionToBool Decision
cPrivate
        , gitHubActions :: Bool
gitHubActions  = (Decision
cGitHub Decision -> Decision -> Bool
forall a. Eq a => a -> a -> Bool
/= Decision
Nop) Bool -> Bool -> Bool
&& (Decision
cGhActions Decision -> Decision -> Bool
forall a. Eq a => a -> a -> Bool
/= Decision
Nop) Bool -> Bool -> Bool
&& Bool
kitCabal
        , gitHubTravis :: Bool
gitHubTravis   = (Decision
cGitHub Decision -> Decision -> Bool
forall a. Eq a => a -> a -> Bool
/= Decision
Nop) Bool -> Bool -> Bool
&& (Decision
cTravis Decision -> Decision -> Bool
forall a. Eq a => a -> a -> Bool
/= Decision
Nop)
        , gitHubAppVeyor :: Bool
gitHubAppVeyor = Decision -> Bool
decisionToBool Decision
cAppVey
        }
    , summonKitExtensions :: [Text]
summonKitExtensions   = [Text]
cExtensions
    , summonKitGhcOptions :: [Text]
summonKitGhcOptions   = [Text]
cGhcOptions
    , summonKitGitignore :: [Text]
summonKitGitignore    = [Text]
cGitignore
    , summonKitConnectMode :: ConnectMode
summonKitConnectMode  = ConnectMode
cConnectMode
    , summonKitShouldSummon :: Decision
summonKitShouldSummon = Decision
Nop
    , summonKitConfigFile :: Maybe FilePath
summonKitConfigFile   = Maybe FilePath
cConfigFile
    , summonKitExtraFiles :: [TreeFs]
summonKitExtraFiles   = [TreeFs]
files
    }
  where
    kitCabal, kitStack, kitLib, kitExe :: Bool
    (kitCabal :: Bool
kitCabal, kitStack :: Bool
kitStack) = (Decision, Decision) -> (Bool, Bool)
decisionsToBools (Decision
cCabal, Decision
cStack)
    (kitLib :: Bool
kitLib, kitExe :: Bool
kitExe) = (Decision, Decision) -> (Bool, Bool)
decisionsToBools (Decision
cLib, Decision
cExe)

    kitPreludeName, kitPreludeModule :: Text
    (kitPreludeName :: Text
kitPreludeName, kitPreludeModule :: Text
kitPreludeModule) = case Last CustomPrelude -> Maybe CustomPrelude
forall a. Last a -> Maybe a
getLast Last CustomPrelude
cPrelude of
        Nothing                -> ("", "")
        Just CustomPrelude{..} -> (Text
cpPackage, Text
cpModule)

-- | Shows the Widget with the generated project structure tree.
renderWidgetTree :: SummonKit -> Text
renderWidgetTree :: SummonKit -> Text
renderWidgetTree = Bool -> TreeFs -> Text
showTree Bool
False (TreeFs -> Text) -> (SummonKit -> TreeFs) -> SummonKit -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> TreeFs
createProjectTemplate (Settings -> TreeFs)
-> (SummonKit -> Settings) -> SummonKit -> TreeFs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SummonKit -> Settings
summonKitToSettings