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

Complete settings required for the project creation.
-}

module Summoner.Settings
       ( Settings (..)

       , Tool (..)
       , showTool
       , parseTool
       ) where

import Relude.Extra.Enum (inverseMap)

import Summoner.CustomPrelude (CustomPrelude)
import Summoner.GhcVer (GhcVer)
import Summoner.License (License, LicenseName)
import Summoner.Tree (TreeFs)


-- | Data needed for project creation.
data Settings = Settings
    { Settings -> Text
settingsRepo           :: !Text   -- ^ repository name
    , Settings -> Text
settingsOwner          :: !Text   -- ^ github username
    , Settings -> Text
settingsDescription    :: !Text   -- ^ project description
    , Settings -> Text
settingsFullName       :: !Text   -- ^ full name
    , Settings -> Text
settingsEmail          :: !Text   -- ^ e-mail
    , Settings -> Text
settingsYear           :: !Text   -- ^ year
    , Settings -> Text
settingsCategories     :: !Text   -- ^ project category
    , Settings -> LicenseName
settingsLicenseName    :: !LicenseName -- ^ type of license
    , Settings -> License
settingsLicenseText    :: !License -- ^ license text
    , Settings -> Bool
settingsGitHub         :: !Bool   -- ^ GitHub repository
    , Settings -> Bool
settingsPrivate        :: !Bool   -- ^ private repository
    , Settings -> Bool
settingsGhActions      :: !Bool   -- ^ GitHub Actions CI integration
    , Settings -> Bool
settingsTravis         :: !Bool   -- ^ Travis CI integration
    , Settings -> Bool
settingsAppVeyor       :: !Bool   -- ^ AppVeyor CI integration
    , Settings -> Bool
settingsIsLib          :: !Bool   -- ^ is library
    , Settings -> Bool
settingsIsExe          :: !Bool   -- ^ is executable
    , Settings -> Bool
settingsTest           :: !Bool   -- ^ add tests
    , Settings -> Bool
settingsBench          :: !Bool   -- ^ add benchmarks
    , Settings -> [GhcVer]
settingsTestedVersions :: ![GhcVer]  -- ^ GHC versions
    , Settings -> Maybe CustomPrelude
settingsPrelude        :: !(Maybe CustomPrelude)  -- ^ custom prelude to be used
    , Settings -> [Text]
settingsExtensions     :: ![Text] -- ^ default extensions
    , Settings -> [Text]
settingsGhcOptions     :: ![Text] -- ^ default GHC options
    , Settings -> [Text]
settingsGitignore      :: ![Text] -- ^ .gitignore file
    , Settings -> Bool
settingsCabal          :: !Bool
    , Settings -> Bool
settingsStack          :: !Bool
    , Settings -> Bool
settingsNoUpload       :: !Bool  -- ^ do not upload to GitHub
    , Settings -> [TreeFs]
settingsFiles          :: ![TreeFs]  -- ^ Tree nodes of extra files
    } deriving stock (Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
(Int -> Settings -> ShowS)
-> (Settings -> String) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Settings] -> ShowS
$cshowList :: [Settings] -> ShowS
show :: Settings -> String
$cshow :: Settings -> String
showsPrec :: Int -> Settings -> ShowS
$cshowsPrec :: Int -> Settings -> ShowS
Show)

-- | Enum for supported build tools.
data Tool
    = Cabal
    | Stack
    deriving stock (Int -> Tool -> ShowS
[Tool] -> ShowS
Tool -> String
(Int -> Tool -> ShowS)
-> (Tool -> String) -> ([Tool] -> ShowS) -> Show Tool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tool] -> ShowS
$cshowList :: [Tool] -> ShowS
show :: Tool -> String
$cshow :: Tool -> String
showsPrec :: Int -> Tool -> ShowS
$cshowsPrec :: Int -> Tool -> ShowS
Show, Tool -> Tool -> Bool
(Tool -> Tool -> Bool) -> (Tool -> Tool -> Bool) -> Eq Tool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tool -> Tool -> Bool
$c/= :: Tool -> Tool -> Bool
== :: Tool -> Tool -> Bool
$c== :: Tool -> Tool -> Bool
Eq, Int -> Tool
Tool -> Int
Tool -> [Tool]
Tool -> Tool
Tool -> Tool -> [Tool]
Tool -> Tool -> Tool -> [Tool]
(Tool -> Tool)
-> (Tool -> Tool)
-> (Int -> Tool)
-> (Tool -> Int)
-> (Tool -> [Tool])
-> (Tool -> Tool -> [Tool])
-> (Tool -> Tool -> [Tool])
-> (Tool -> Tool -> Tool -> [Tool])
-> Enum Tool
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Tool -> Tool -> Tool -> [Tool]
$cenumFromThenTo :: Tool -> Tool -> Tool -> [Tool]
enumFromTo :: Tool -> Tool -> [Tool]
$cenumFromTo :: Tool -> Tool -> [Tool]
enumFromThen :: Tool -> Tool -> [Tool]
$cenumFromThen :: Tool -> Tool -> [Tool]
enumFrom :: Tool -> [Tool]
$cenumFrom :: Tool -> [Tool]
fromEnum :: Tool -> Int
$cfromEnum :: Tool -> Int
toEnum :: Int -> Tool
$ctoEnum :: Int -> Tool
pred :: Tool -> Tool
$cpred :: Tool -> Tool
succ :: Tool -> Tool
$csucc :: Tool -> Tool
Enum, Tool
Tool -> Tool -> Bounded Tool
forall a. a -> a -> Bounded a
maxBound :: Tool
$cmaxBound :: Tool
minBound :: Tool
$cminBound :: Tool
Bounded)

-- | Show 'Tool' in lowercase.
showTool :: Tool -> Text
showTool :: Tool -> Text
showTool = \case
    Cabal -> "cabal"
    Stack -> "stack"

-- | Parse 'Tool' from string. Inverse of 'showTool'.
parseTool :: Text -> Maybe Tool
parseTool :: Text -> Maybe Tool
parseTool = (Tool -> Text) -> Text -> Maybe Tool
forall a k. (Bounded a, Enum a, Ord k) => (a -> k) -> k -> Maybe a
inverseMap Tool -> Text
showTool