{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Distribution.Client.Init.FileCreators
(
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)
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
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."
[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
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]
-> 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
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
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
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"
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)
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
[Char] -> m ()
forall (m :: * -> *). Interactive m => [Char] -> m ()
removeExistingFile [Char]
fileName
[Char] -> [Char] -> m ()
forall (m :: * -> *). Interactive m => [Char] -> [Char] -> m ()
writeFile [Char]
fileName [Char]
content
| 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
[Char] -> m ()
forall (m :: * -> *). Interactive m => [Char] -> m ()
createDirectory [Char]
dir
| 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