{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.Init.FileCreators
-- Copyright   :  (c) Brent Yorgey 2009
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Functions to create files during 'cabal init'.
--
-----------------------------------------------------------------------------
module Distribution.Client.Init.FileCreators
( -- * Commands
  writeProject
, writeLicense
, writeChangeLog
, prepareLibTarget
, prepareExeTarget
, prepareTestTarget
) where

import Prelude hiding (writeFile, readFile)
import Distribution.Client.Compat.Prelude hiding (head, empty, writeFile, readFile)

import qualified Data.Set as Set (member)

import Distribution.Client.Init.Defaults
import Distribution.Client.Init.Licenses
  ( bsd2, bsd3, gplv2, gplv3, lgpl21, lgpl3, agplv3, apache20, mit, mpl20, isc )
import Distribution.Client.Init.Types hiding (putStrLn, putStr, message)
import qualified Distribution.Client.Init.Types as T
import Distribution.Fields.Pretty (PrettyField(..), showFields')
import qualified Distribution.SPDX as SPDX
import Distribution.Types.PackageName
import Distribution.Client.Init.Format
import Distribution.CabalSpecVersion (showCabalSpecVersion)

import System.FilePath ((</>), (<.>))
import Distribution.FieldGrammar.Newtypes
import Distribution.License (licenseToSPDX)

-- -------------------------------------------------------------------- --
--  File generation

writeProject :: Interactive m => ProjectSettings -> m ()
writeProject :: ProjectSettings -> m ()
writeProject (ProjectSettings WriteOpts
opts PkgDescription
pkgDesc Maybe LibTarget
libTarget Maybe ExeTarget
exeTarget Maybe TestTarget
testTarget)
    | [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
pkgName = do
      WriteOpts -> Severity -> [Char] -> m ()
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Error [Char]
"no package name given, so no .cabal file can be generated\n"
    | Bool
otherwise = do

      -- clear prompt history a bit"
      WriteOpts -> Severity -> [Char] -> m ()
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Log
        ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Using cabal specification: "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CabalSpecVersion -> [Char]
showCabalSpecVersion (WriteOpts -> CabalSpecVersion
_optCabalSpec WriteOpts
opts)

      WriteOpts -> PkgDescription -> m ()
forall (m :: * -> *).
Interactive m =>
WriteOpts -> PkgDescription -> m ()
writeLicense WriteOpts
opts PkgDescription
pkgDesc
      WriteOpts -> PkgDescription -> m ()
forall (m :: * -> *).
Interactive m =>
WriteOpts -> PkgDescription -> m ()
writeChangeLog WriteOpts
opts PkgDescription
pkgDesc

      let pkgFields :: [PrettyField FieldAnnotation]
pkgFields = WriteOpts -> PkgDescription -> [PrettyField FieldAnnotation]
mkPkgDescription WriteOpts
opts PkgDescription
pkgDesc
          commonStanza :: PrettyField FieldAnnotation
commonStanza = WriteOpts -> PrettyField FieldAnnotation
mkCommonStanza WriteOpts
opts

      PrettyField FieldAnnotation
libStanza <- WriteOpts -> Maybe LibTarget -> m (PrettyField FieldAnnotation)
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Maybe LibTarget -> m (PrettyField FieldAnnotation)
prepareLibTarget WriteOpts
opts Maybe LibTarget
libTarget
      PrettyField FieldAnnotation
exeStanza <- WriteOpts -> Maybe ExeTarget -> m (PrettyField FieldAnnotation)
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Maybe ExeTarget -> m (PrettyField FieldAnnotation)
prepareExeTarget WriteOpts
opts Maybe ExeTarget
exeTarget
      PrettyField FieldAnnotation
testStanza <- WriteOpts -> Maybe TestTarget -> m (PrettyField FieldAnnotation)
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Maybe TestTarget -> m (PrettyField FieldAnnotation)
prepareTestTarget WriteOpts
opts Maybe TestTarget
testTarget

      (Bool
reusedCabal, [Char]
cabalContents) <- WriteOpts -> [PrettyField FieldAnnotation] -> m (Bool, [Char])
forall (m :: * -> *).
Interactive m =>
WriteOpts -> [PrettyField FieldAnnotation] -> m (Bool, [Char])
writeCabalFile WriteOpts
opts ([PrettyField FieldAnnotation] -> m (Bool, [Char]))
-> [PrettyField FieldAnnotation] -> m (Bool, [Char])
forall a b. (a -> b) -> a -> b
$
        [PrettyField FieldAnnotation]
pkgFields [PrettyField FieldAnnotation]
-> [PrettyField FieldAnnotation] -> [PrettyField FieldAnnotation]
forall a. [a] -> [a] -> [a]
++ [PrettyField FieldAnnotation
commonStanza, PrettyField FieldAnnotation
libStanza, PrettyField FieldAnnotation
exeStanza, PrettyField FieldAnnotation
testStanza]

      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ PkgDescription -> [Char]
_pkgSynopsis PkgDescription
pkgDesc) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        WriteOpts -> Severity -> [Char] -> m ()
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Warning [Char]
"No synopsis given. You should edit the .cabal file and add one."

      WriteOpts -> Severity -> [Char] -> m ()
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Info [Char]
"You may want to edit the .cabal file and add a Description field."

      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
reusedCabal (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        [Char]
existingCabal <- [Char] -> m [Char]
forall (m :: * -> *). Interactive m => [Char] -> m [Char]
readFile ([Char] -> m [Char]) -> [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ PackageName -> [Char]
unPackageName (WriteOpts -> PackageName
_optPkgName WriteOpts
opts) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".cabal"
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
existingCabal [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
cabalContents) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          WriteOpts -> Severity -> [Char] -> m ()
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Warning [Char]
"A .cabal file was found and not updated, if updating is desired please use the '--overwrite' option."

      -- clear out last line for presentation.
      [Char] -> m ()
forall (m :: * -> *). Interactive m => [Char] -> m ()
T.putStrLn [Char]
""
  where
    pkgName :: [Char]
pkgName = PackageName -> [Char]
unPackageName (PackageName -> [Char]) -> PackageName -> [Char]
forall a b. (a -> b) -> a -> b
$ WriteOpts -> PackageName
_optPkgName WriteOpts
opts


prepareLibTarget
    :: Interactive m
    => WriteOpts
    -> Maybe LibTarget
    -> m (PrettyField FieldAnnotation)
prepareLibTarget :: WriteOpts -> Maybe LibTarget -> m (PrettyField FieldAnnotation)
prepareLibTarget WriteOpts
_ Maybe LibTarget
Nothing = PrettyField FieldAnnotation -> m (PrettyField FieldAnnotation)
forall (m :: * -> *) a. Monad m => a -> m a
return PrettyField FieldAnnotation
forall ann. PrettyField ann
PrettyEmpty
prepareLibTarget WriteOpts
opts (Just LibTarget
libTarget) = do
    m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ WriteOpts -> [[Char]] -> m Bool
forall (m :: * -> *).
Interactive m =>
WriteOpts -> [[Char]] -> m Bool
writeDirectoriesSafe WriteOpts
opts ([[Char]] -> m Bool) -> [[Char]] -> m Bool
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
".") [[Char]]
srcDirs
    -- avoid writing when conflicting exposed paths may
    -- exist.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NonEmpty ModuleName
expMods NonEmpty ModuleName -> NonEmpty ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== (ModuleName
myLibModule ModuleName -> [ModuleName] -> NonEmpty ModuleName
forall a. a -> [a] -> NonEmpty a
:| [])) (m () -> m ()) -> (m Bool -> m ()) -> m Bool -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$
      WriteOpts -> [Char] -> [Char] -> m Bool
forall (m :: * -> *).
Interactive m =>
WriteOpts -> [Char] -> [Char] -> m Bool
writeFileSafe WriteOpts
opts [Char]
libPath [Char]
myLibHs

    PrettyField FieldAnnotation -> m (PrettyField FieldAnnotation)
forall (m :: * -> *) a. Monad m => a -> m a
return (PrettyField FieldAnnotation -> m (PrettyField FieldAnnotation))
-> PrettyField FieldAnnotation -> m (PrettyField FieldAnnotation)
forall a b. (a -> b) -> a -> b
$ WriteOpts -> LibTarget -> PrettyField FieldAnnotation
mkLibStanza WriteOpts
opts LibTarget
libTarget
  where
    expMods :: NonEmpty ModuleName
expMods = LibTarget -> NonEmpty ModuleName
_libExposedModules LibTarget
libTarget
    srcDirs :: [[Char]]
srcDirs = LibTarget -> [[Char]]
_libSourceDirs LibTarget
libTarget
    libPath :: [Char]
libPath = case [[Char]]
srcDirs of
      [Char]
path:[[Char]]
_ -> [Char]
path [Char] -> [Char] -> [Char]
</> HsFilePath -> [Char]
_hsFilePath HsFilePath
myLibFile
      [[Char]]
_ -> HsFilePath -> [Char]
_hsFilePath HsFilePath
myLibFile

prepareExeTarget
    :: Interactive m
    => WriteOpts
    -> Maybe ExeTarget
    -> m (PrettyField FieldAnnotation)
prepareExeTarget :: WriteOpts -> Maybe ExeTarget -> m (PrettyField FieldAnnotation)
prepareExeTarget WriteOpts
_ Maybe ExeTarget
Nothing = PrettyField FieldAnnotation -> m (PrettyField FieldAnnotation)
forall (m :: * -> *) a. Monad m => a -> m a
return PrettyField FieldAnnotation
forall ann. PrettyField ann
PrettyEmpty
prepareExeTarget WriteOpts
opts (Just ExeTarget
exeTarget) = do
    m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ WriteOpts -> [[Char]] -> m Bool
forall (m :: * -> *).
Interactive m =>
WriteOpts -> [[Char]] -> m Bool
writeDirectoriesSafe WriteOpts
opts [[Char]]
appDirs
    m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ WriteOpts -> [Char] -> [Char] -> m Bool
forall (m :: * -> *).
Interactive m =>
WriteOpts -> [Char] -> [Char] -> m Bool
writeFileSafe WriteOpts
opts [Char]
mainPath [Char]
mainHs
    PrettyField FieldAnnotation -> m (PrettyField FieldAnnotation)
forall (m :: * -> *) a. Monad m => a -> m a
return (PrettyField FieldAnnotation -> m (PrettyField FieldAnnotation))
-> PrettyField FieldAnnotation -> m (PrettyField FieldAnnotation)
forall a b. (a -> b) -> a -> b
$ WriteOpts -> ExeTarget -> PrettyField FieldAnnotation
mkExeStanza WriteOpts
opts ExeTarget
exeTarget
  where
    exeMainIs :: HsFilePath
exeMainIs = ExeTarget -> HsFilePath
_exeMainIs ExeTarget
exeTarget
    pkgType :: PackageType
pkgType = WriteOpts -> PackageType
_optPkgType WriteOpts
opts
    appDirs :: [[Char]]
appDirs = ExeTarget -> [[Char]]
_exeApplicationDirs ExeTarget
exeTarget
    mainFile :: [Char]
mainFile = HsFilePath -> [Char]
_hsFilePath HsFilePath
exeMainIs
    mainPath :: [Char]
mainPath = case [[Char]]
appDirs of
      [Char]
appPath:[[Char]]
_ -> [Char]
appPath [Char] -> [Char] -> [Char]
</> [Char]
mainFile
      [[Char]]
_ -> [Char]
mainFile

    mainHs :: [Char]
mainHs = [[Char]] -> [Char]
unlines ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFilePath -> [[Char]] -> [[Char]]
mkLiterate HsFilePath
exeMainIs ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
      if PackageType
pkgType PackageType -> PackageType -> Bool
forall a. Eq a => a -> a -> Bool
== PackageType
LibraryAndExecutable
      then [[Char]]
myLibExeHs
      else [[Char]]
myExeHs

prepareTestTarget
    :: Interactive m
    => WriteOpts
    -> Maybe TestTarget
    -> m (PrettyField FieldAnnotation)
prepareTestTarget :: WriteOpts -> Maybe TestTarget -> m (PrettyField FieldAnnotation)
prepareTestTarget WriteOpts
_ Maybe TestTarget
Nothing = PrettyField FieldAnnotation -> m (PrettyField FieldAnnotation)
forall (m :: * -> *) a. Monad m => a -> m a
return PrettyField FieldAnnotation
forall ann. PrettyField ann
PrettyEmpty
prepareTestTarget WriteOpts
opts (Just TestTarget
testTarget) = do
    m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ WriteOpts -> [[Char]] -> m Bool
forall (m :: * -> *).
Interactive m =>
WriteOpts -> [[Char]] -> m Bool
writeDirectoriesSafe WriteOpts
opts [[Char]]
testDirs'
    m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ WriteOpts -> [Char] -> [Char] -> m Bool
forall (m :: * -> *).
Interactive m =>
WriteOpts -> [Char] -> [Char] -> m Bool
writeFileSafe WriteOpts
opts [Char]
testPath [Char]
myTestHs
    PrettyField FieldAnnotation -> m (PrettyField FieldAnnotation)
forall (m :: * -> *) a. Monad m => a -> m a
return (PrettyField FieldAnnotation -> m (PrettyField FieldAnnotation))
-> PrettyField FieldAnnotation -> m (PrettyField FieldAnnotation)
forall a b. (a -> b) -> a -> b
$ WriteOpts -> TestTarget -> PrettyField FieldAnnotation
mkTestStanza WriteOpts
opts TestTarget
testTarget
  where
    testDirs' :: [[Char]]
testDirs' = TestTarget -> [[Char]]
_testDirs TestTarget
testTarget
    testMainIs :: [Char]
testMainIs = HsFilePath -> [Char]
_hsFilePath (HsFilePath -> [Char]) -> HsFilePath -> [Char]
forall a b. (a -> b) -> a -> b
$ TestTarget -> HsFilePath
_testMainIs TestTarget
testTarget
    testPath :: [Char]
testPath = case [[Char]]
testDirs' of
      [Char]
p:[[Char]]
_ -> [Char]
p [Char] -> [Char] -> [Char]
</> [Char]
testMainIs
      [[Char]]
_ -> [Char]
testMainIs

writeCabalFile
    :: Interactive m
    => WriteOpts
    -> [PrettyField FieldAnnotation]
      -- ^ .cabal fields
    -> m (Bool, String)
writeCabalFile :: WriteOpts -> [PrettyField FieldAnnotation] -> m (Bool, [Char])
writeCabalFile WriteOpts
opts [PrettyField FieldAnnotation]
fields = do
    let cabalContents :: [Char]
cabalContents = (FieldAnnotation -> CommentPosition)
-> (FieldAnnotation -> [[Char]] -> [[Char]])
-> Int
-> [PrettyField FieldAnnotation]
-> [Char]
forall ann.
(ann -> CommentPosition)
-> (ann -> [[Char]] -> [[Char]])
-> Int
-> [PrettyField ann]
-> [Char]
showFields'
          FieldAnnotation -> CommentPosition
annCommentLines
          FieldAnnotation -> [[Char]] -> [[Char]]
postProcessFieldLines
          Int
4 [PrettyField FieldAnnotation]
fields

    Bool
reusedCabal <- WriteOpts -> [Char] -> [Char] -> m Bool
forall (m :: * -> *).
Interactive m =>
WriteOpts -> [Char] -> [Char] -> m Bool
writeFileSafe WriteOpts
opts [Char]
cabalFileName [Char]
cabalContents
    (Bool, [Char]) -> m (Bool, [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
reusedCabal, [Char]
cabalContents)
  where
    cabalFileName :: [Char]
cabalFileName = [Char]
pkgName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".cabal"
    pkgName :: [Char]
pkgName = PackageName -> [Char]
unPackageName (PackageName -> [Char]) -> PackageName -> [Char]
forall a b. (a -> b) -> a -> b
$ WriteOpts -> PackageName
_optPkgName WriteOpts
opts

-- | Write the LICENSE file.
--
-- For licenses that contain the author's name(s), the values are taken
-- from the 'authors' field of 'InitFlags', and if not specified will
-- be the string "???".
--
-- If the license type is unknown no license file will be prepared and
-- a warning will be raised.
--
writeLicense :: Interactive m => WriteOpts -> PkgDescription -> m ()
writeLicense :: WriteOpts -> PkgDescription -> m ()
writeLicense WriteOpts
writeOpts PkgDescription
pkgDesc = do
  [Char]
year <- Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> [Char]) -> m Integer -> m [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Integer
forall (m :: * -> *). Interactive m => m Integer
getCurrentYear
  case [Char] -> [Char] -> Maybe [Char]
licenseFile [Char]
year (PkgDescription -> [Char]
_pkgAuthor PkgDescription
pkgDesc) of
    Just [Char]
licenseText ->
      m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ WriteOpts -> [Char] -> [Char] -> m Bool
forall (m :: * -> *).
Interactive m =>
WriteOpts -> [Char] -> [Char] -> m Bool
writeFileSafe WriteOpts
writeOpts [Char]
"LICENSE" [Char]
licenseText
    Maybe [Char]
Nothing -> WriteOpts -> Severity -> [Char] -> m ()
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
writeOpts Severity
T.Warning [Char]
"unknown license type, you must put a copy in LICENSE yourself."
  where
    getLid :: Either License License -> Maybe LicenseId
getLid (Left (SPDX.License (SPDX.ELicense (SPDX.ELicenseId LicenseId
lid) Maybe LicenseExceptionId
Nothing))) = LicenseId -> Maybe LicenseId
forall a. a -> Maybe a
Just LicenseId
lid
    getLid (Right License
l) = Either License License -> Maybe LicenseId
getLid (Either License License -> Maybe LicenseId)
-> (License -> Either License License)
-> License
-> Maybe LicenseId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. License -> Either License License
forall a b. a -> Either a b
Left (License -> Maybe LicenseId) -> License -> Maybe LicenseId
forall a b. (a -> b) -> a -> b
$ License -> License
licenseToSPDX License
l
    getLid Either License License
_ = Maybe LicenseId
forall a. Maybe a
Nothing

    licenseFile :: [Char] -> [Char] -> Maybe [Char]
licenseFile [Char]
year [Char]
auth = case Either License License -> Maybe LicenseId
getLid (Either License License -> Maybe LicenseId)
-> (SpecLicense -> Either License License)
-> SpecLicense
-> Maybe LicenseId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpecLicense -> Either License License
getSpecLicense (SpecLicense -> Maybe LicenseId) -> SpecLicense -> Maybe LicenseId
forall a b. (a -> b) -> a -> b
$ PkgDescription -> SpecLicense
_pkgLicense PkgDescription
pkgDesc of
      Just LicenseId
SPDX.BSD_2_Clause -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
bsd2 [Char]
auth [Char]
year
      Just LicenseId
SPDX.BSD_3_Clause -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
bsd3 [Char]
auth [Char]
year
      Just LicenseId
SPDX.Apache_2_0 -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
apache20
      Just LicenseId
SPDX.MIT -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
mit [Char]
auth [Char]
year
      Just LicenseId
SPDX.MPL_2_0 -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
mpl20
      Just LicenseId
SPDX.ISC -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
isc [Char]
auth [Char]
year
      Just LicenseId
SPDX.GPL_2_0_only -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
gplv2
      Just LicenseId
SPDX.GPL_3_0_only -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
gplv3
      Just LicenseId
SPDX.LGPL_2_1_only -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
lgpl21
      Just LicenseId
SPDX.LGPL_3_0_only -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
lgpl3
      Just LicenseId
SPDX.AGPL_3_0_only -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
agplv3
      Just LicenseId
SPDX.GPL_2_0_or_later -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
gplv2
      Just LicenseId
SPDX.GPL_3_0_or_later -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
gplv3
      Just LicenseId
SPDX.LGPL_2_1_or_later -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
lgpl21
      Just LicenseId
SPDX.LGPL_3_0_or_later -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
lgpl3
      Just LicenseId
SPDX.AGPL_3_0_or_later -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
agplv3
      Maybe LicenseId
_ -> Maybe [Char]
forall a. Maybe a
Nothing

-- | Writes the changelog to the current directory.
--
writeChangeLog :: Interactive m => WriteOpts -> PkgDescription -> m ()
writeChangeLog :: WriteOpts -> PkgDescription -> m ()
writeChangeLog WriteOpts
opts PkgDescription
pkgDesc
  | Just Set [Char]
docs <- PkgDescription -> Maybe (Set [Char])
_pkgExtraDocFiles PkgDescription
pkgDesc
  , [Char]
defaultChangelog [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set [Char]
docs = m ()
go
  | [Char]
defaultChangelog [Char] -> Set [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` PkgDescription -> Set [Char]
_pkgExtraSrcFiles PkgDescription
pkgDesc = m ()
go
  | Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
  changeLog :: [Char]
changeLog = [[Char]] -> [Char]
unlines
    [ [Char]
"# Revision history for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PackageName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (PkgDescription -> PackageName
_pkgName PkgDescription
pkgDesc)
    , [Char]
""
    , [Char]
"## " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (PkgDescription -> Version
_pkgVersion PkgDescription
pkgDesc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -- YYYY-mm-dd"
    , [Char]
""
    , [Char]
"* First version. Released on an unsuspecting world."
    ]

  go :: m ()
go =
    m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ WriteOpts -> [Char] -> [Char] -> m Bool
forall (m :: * -> *).
Interactive m =>
WriteOpts -> [Char] -> [Char] -> m Bool
writeFileSafe WriteOpts
opts [Char]
defaultChangelog [Char]
changeLog

-- -------------------------------------------------------------------- --
-- Utilities

data WriteAction = Overwrite | Fresh | Existing deriving WriteAction -> WriteAction -> Bool
(WriteAction -> WriteAction -> Bool)
-> (WriteAction -> WriteAction -> Bool) -> Eq WriteAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteAction -> WriteAction -> Bool
$c/= :: WriteAction -> WriteAction -> Bool
== :: WriteAction -> WriteAction -> Bool
$c== :: WriteAction -> WriteAction -> Bool
Eq

instance Show WriteAction where
  show :: WriteAction -> [Char]
show WriteAction
Overwrite = [Char]
"Overwriting"
  show WriteAction
Fresh     = [Char]
"Creating fresh"
  show WriteAction
Existing  = [Char]
"Using existing"

-- | Possibly generate a message to stdout, taking into account the
--   --quiet flag.
message :: Interactive m => WriteOpts -> T.Severity -> String -> m ()
message :: WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts = Verbosity -> Severity -> [Char] -> m ()
forall (m :: * -> *).
Interactive m =>
Verbosity -> Severity -> [Char] -> m ()
T.message (WriteOpts -> Verbosity
_optVerbosity WriteOpts
opts)

-- | Write a file \"safely\" if it doesn't exist, backing up any existing version when
--   the overwrite flag is set.
writeFileSafe :: Interactive m => WriteOpts -> FilePath -> String -> m Bool
writeFileSafe :: WriteOpts -> [Char] -> [Char] -> m Bool
writeFileSafe WriteOpts
opts [Char]
fileName [Char]
content = do
    Bool
exists <- [Char] -> m Bool
forall (m :: * -> *). Interactive m => [Char] -> m Bool
doesFileExist [Char]
fileName

    let action :: WriteAction
action
          | Bool
exists Bool -> Bool -> Bool
&& Bool
doOverwrite = WriteAction
Overwrite
          | Bool -> Bool
not Bool
exists = WriteAction
Fresh
          | Bool
otherwise = WriteAction
Existing

    Bool -> m ()
forall (m :: * -> *). Interactive m => Bool -> m ()
go Bool
exists

    WriteOpts -> Severity -> [Char] -> m ()
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Log ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ WriteAction -> [Char]
forall a. Show a => a -> [Char]
show WriteAction
action [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" file " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fileName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"..."
    Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ WriteAction
action WriteAction -> WriteAction -> Bool
forall a. Eq a => a -> a -> Bool
== WriteAction
Existing
  where
    doOverwrite :: Bool
doOverwrite = WriteOpts -> Bool
_optOverwrite WriteOpts
opts

    go :: Bool -> m ()
go Bool
exists
      | Bool -> Bool
not Bool
exists = do
        [Char] -> [Char] -> m ()
forall (m :: * -> *). Interactive m => [Char] -> [Char] -> m ()
writeFile [Char]
fileName [Char]
content
      | Bool
exists Bool -> Bool -> Bool
&& Bool
doOverwrite = do
        [Char]
newName <- [Char] -> m [Char]
forall (m :: * -> *). Interactive m => [Char] -> m [Char]
findNewPath [Char]
fileName
        WriteOpts -> Severity -> [Char] -> m ()
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Log ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [Char]
fileName
          , [Char]
" already exists. Backing up old version in "
          , [Char]
newName
          ]

        [Char] -> [Char] -> m ()
forall (m :: * -> *). Interactive m => [Char] -> [Char] -> m ()
copyFile [Char]
fileName [Char]
newName   -- backups the old file
        [Char] -> m ()
forall (m :: * -> *). Interactive m => [Char] -> m ()
removeExistingFile [Char]
fileName -- removes the original old file
        [Char] -> [Char] -> m ()
forall (m :: * -> *). Interactive m => [Char] -> [Char] -> m ()
writeFile [Char]
fileName [Char]
content  -- writes the new file
      | Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

writeDirectoriesSafe :: Interactive m => WriteOpts -> [String] -> m Bool
writeDirectoriesSafe :: WriteOpts -> [[Char]] -> m Bool
writeDirectoriesSafe WriteOpts
opts [[Char]]
dirs = ([Bool] -> Bool) -> m [Bool] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (m [Bool] -> m Bool) -> m [Bool] -> m Bool
forall a b. (a -> b) -> a -> b
$ [[Char]] -> ([Char] -> m Bool) -> m [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [[Char]]
dirs (([Char] -> m Bool) -> m [Bool]) -> ([Char] -> m Bool) -> m [Bool]
forall a b. (a -> b) -> a -> b
$ \[Char]
dir -> do
    Bool
exists <- [Char] -> m Bool
forall (m :: * -> *). Interactive m => [Char] -> m Bool
doesDirectoryExist [Char]
dir

    let action :: WriteAction
action
          | Bool
exists Bool -> Bool -> Bool
&& Bool
doOverwrite = WriteAction
Overwrite
          | Bool -> Bool
not Bool
exists = WriteAction
Fresh
          | Bool
otherwise = WriteAction
Existing

    [Char] -> Bool -> m ()
forall (m :: * -> *). Interactive m => [Char] -> Bool -> m ()
go [Char]
dir Bool
exists

    WriteOpts -> Severity -> [Char] -> m ()
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Log ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ WriteAction -> [Char]
forall a. Show a => a -> [Char]
show WriteAction
action [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" directory ./" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"..."
    Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ WriteAction
action WriteAction -> WriteAction -> Bool
forall a. Eq a => a -> a -> Bool
== WriteAction
Existing
  where
    doOverwrite :: Bool
doOverwrite = WriteOpts -> Bool
_optOverwrite WriteOpts
opts

    go :: [Char] -> Bool -> m ()
go [Char]
dir Bool
exists
      | Bool -> Bool
not Bool
exists = do
        [Char] -> m ()
forall (m :: * -> *). Interactive m => [Char] -> m ()
createDirectory [Char]
dir
      | Bool
exists Bool -> Bool -> Bool
&& Bool
doOverwrite = do
        [Char]
newDir <- [Char] -> m [Char]
forall (m :: * -> *). Interactive m => [Char] -> m [Char]
findNewPath [Char]
dir
        WriteOpts -> Severity -> [Char] -> m ()
forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Log ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [Char]
dir
          , [Char]
" already exists. Backing up old version in "
          , [Char]
newDir
          ]

        [Char] -> [Char] -> m ()
forall (m :: * -> *). Interactive m => [Char] -> [Char] -> m ()
renameDirectory [Char]
dir [Char]
newDir -- backups the old directory
        [Char] -> m ()
forall (m :: * -> *). Interactive m => [Char] -> m ()
createDirectory [Char]
dir        -- creates the new directory
      | Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

findNewPath :: Interactive m => FilePath -> m FilePath
findNewPath :: [Char] -> m [Char]
findNewPath [Char]
dir = Int -> m [Char]
forall (m :: * -> *) a.
(Interactive m, Enum a, Show a) =>
a -> m [Char]
go (Int
0 :: Int)
  where
    go :: a -> m [Char]
go a
n = do
      let newDir :: [Char]
newDir = [Char]
dir [Char] -> [Char] -> [Char]
<.> ([Char]
"save" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
n)
      Bool
e <- [Char] -> m Bool
forall (m :: * -> *). Interactive m => [Char] -> m Bool
doesDirectoryExist [Char]
newDir
      if Bool
e then a -> m [Char]
go (a -> a
forall a. Enum a => a -> a
succ a
n) else [Char] -> m [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
newDir