-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Client.Init.Defaults
-- Copyright   :  (c) Brent Yorgey 2009
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Default values to use in cabal init (if not specified in config/flags).
module Distribution.Client.Init.Defaults
  ( -- * default init values
    defaultApplicationDir
  , defaultSourceDir
  , defaultCabalVersion
  , defaultCabalVersions
  , defaultPackageType
  , defaultLicense
  , defaultLicenseIds
  , defaultMainIs
  , defaultChangelog
  , defaultCategories
  , defaultInitFlags
  , defaultLanguage
  , defaultVersion
  , defaultTestDir

    -- * MyLib defaults
  , myLibModule
  , myLibTestFile
  , myLibFile
  , myLibHs
  , myExeHs
  , myLibExeHs
  , myTestHs
  ) where

import Distribution.CabalSpecVersion (CabalSpecVersion (..))
import Distribution.Client.Init.Types (HsFilePath, InitFlags (..), PackageType (..), toHsFilePath)
import Distribution.FieldGrammar.Newtypes
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName (fromString)
import qualified Distribution.SPDX.License as SPDX
import qualified Distribution.SPDX.LicenseId as SPDX
import Distribution.Simple (Language (..), License (..))
import Distribution.Simple.Flag (toFlag)
import Distribution.Types.Version
import Distribution.Verbosity (normal)

-- -------------------------------------------------------------------- --
-- Default flag and init values

defaultVersion :: Version
defaultVersion :: Version
defaultVersion = [Int] -> Version
mkVersion [Int
0, Int
1, Int
0, Int
0]

defaultApplicationDir :: String
defaultApplicationDir :: String
defaultApplicationDir = String
"app"

defaultSourceDir :: String
defaultSourceDir :: String
defaultSourceDir = String
"src"

defaultTestDir :: String
defaultTestDir :: String
defaultTestDir = String
"test"

defaultCabalVersion :: CabalSpecVersion
defaultCabalVersion :: CabalSpecVersion
defaultCabalVersion = CabalSpecVersion
CabalSpecV3_0

defaultPackageType :: PackageType
defaultPackageType :: PackageType
defaultPackageType = PackageType
Executable

defaultChangelog :: FilePath
defaultChangelog :: String
defaultChangelog = String
"CHANGELOG.md"

defaultLicense :: CabalSpecVersion -> SpecLicense
defaultLicense :: CabalSpecVersion -> SpecLicense
defaultLicense CabalSpecVersion
csv
  | CabalSpecVersion
csv CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV2_2 = Either License License -> SpecLicense
SpecLicense (Either License License -> SpecLicense)
-> Either License License -> SpecLicense
forall a b. (a -> b) -> a -> b
$ License -> Either License License
forall a b. b -> Either a b
Right License
AllRightsReserved
  | Bool
otherwise = Either License License -> SpecLicense
SpecLicense (Either License License -> SpecLicense)
-> Either License License -> SpecLicense
forall a b. (a -> b) -> a -> b
$ License -> Either License License
forall a b. a -> Either a b
Left License
SPDX.NONE

defaultMainIs :: HsFilePath
defaultMainIs :: HsFilePath
defaultMainIs = String -> HsFilePath
toHsFilePath String
"Main.hs"

defaultLanguage :: Language
defaultLanguage :: Language
defaultLanguage = Language
Haskell2010

defaultLicenseIds :: [SPDX.LicenseId]
defaultLicenseIds :: [LicenseId]
defaultLicenseIds =
  [ LicenseId
SPDX.BSD_2_Clause
  , LicenseId
SPDX.BSD_3_Clause
  , LicenseId
SPDX.Apache_2_0
  , LicenseId
SPDX.MIT
  , LicenseId
SPDX.MPL_2_0
  , LicenseId
SPDX.ISC
  , LicenseId
SPDX.GPL_2_0_only
  , LicenseId
SPDX.GPL_3_0_only
  , LicenseId
SPDX.LGPL_2_1_only
  , LicenseId
SPDX.LGPL_3_0_only
  , LicenseId
SPDX.AGPL_3_0_only
  , LicenseId
SPDX.GPL_2_0_or_later
  , LicenseId
SPDX.GPL_3_0_or_later
  , LicenseId
SPDX.LGPL_2_1_or_later
  , LicenseId
SPDX.LGPL_3_0_or_later
  , LicenseId
SPDX.AGPL_3_0_or_later
  ]

defaultCategories :: [String]
defaultCategories :: [String]
defaultCategories =
  [ String
"Codec"
  , String
"Concurrency"
  , String
"Control"
  , String
"Data"
  , String
"Database"
  , String
"Development"
  , String
"Distribution"
  , String
"Game"
  , String
"Graphics"
  , String
"Language"
  , String
"Math"
  , String
"Network"
  , String
"Sound"
  , String
"System"
  , String
"Testing"
  , String
"Text"
  , String
"Web"
  ]

defaultCabalVersions :: [CabalSpecVersion]
defaultCabalVersions :: [CabalSpecVersion]
defaultCabalVersions =
  [ CabalSpecVersion
CabalSpecV1_24
  , CabalSpecVersion
CabalSpecV2_0
  , CabalSpecVersion
CabalSpecV2_2
  , CabalSpecVersion
CabalSpecV2_4
  , CabalSpecVersion
CabalSpecV3_0
  , CabalSpecVersion
CabalSpecV3_4
  , CabalSpecVersion
CabalSpecV3_14
  ]

defaultInitFlags :: InitFlags
defaultInitFlags :: InitFlags
defaultInitFlags = InitFlags
forall a. Monoid a => a
mempty{initVerbosity = toFlag normal}

-- -------------------------------------------------------------------- --
-- MyLib defaults

myLibModule :: ModuleName
myLibModule :: ModuleName
myLibModule = String -> ModuleName
forall a. IsString a => String -> a
ModuleName.fromString String
"MyLib"

myLibTestFile :: HsFilePath
myLibTestFile :: HsFilePath
myLibTestFile = String -> HsFilePath
toHsFilePath String
"MyLibTest.hs"

myLibFile :: HsFilePath
myLibFile :: HsFilePath
myLibFile = String -> HsFilePath
toHsFilePath String
"MyLib.hs"

-- | Default MyLib.hs file.  Used when no Lib.hs exists.
myLibHs :: String
myLibHs :: String
myLibHs =
  [String] -> String
unlines
    [ String
"module MyLib (someFunc) where"
    , String
""
    , String
"someFunc :: IO ()"
    , String
"someFunc = putStrLn \"someFunc\""
    ]

myExeHs :: [String]
myExeHs :: [String]
myExeHs =
  [ String
"module Main where"
  , String
""
  , String
"main :: IO ()"
  , String
"main = putStrLn \"Hello, Haskell!\""
  ]

myLibExeHs :: [String]
myLibExeHs :: [String]
myLibExeHs =
  [ String
"module Main where"
  , String
""
  , String
"import qualified MyLib (someFunc)"
  , String
""
  , String
"main :: IO ()"
  , String
"main = do"
  , String
"  putStrLn \"Hello, Haskell!\""
  , String
"  MyLib.someFunc"
  ]

-- | Default MyLibTest.hs file.
myTestHs :: String
myTestHs :: String
myTestHs =
  [String] -> String
unlines
    [ String
"module Main (main) where"
    , String
""
    , String
"main :: IO ()"
    , String
"main = putStrLn \"Test suite not yet implemented.\""
    ]