{-# 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 :: forall (m :: * -> *). Interactive m => ProjectSettings -> m ()
writeProject (ProjectSettings WriteOpts
opts PkgDescription
pkgDesc Maybe LibTarget
libTarget Maybe ExeTarget
exeTarget Maybe TestTarget
testTarget)
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
pkgName = do
      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"
      forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Log
        forall a b. (a -> b) -> a -> b
$ [Char]
"Using cabal specification: "
        forall a. [a] -> [a] -> [a]
++ CabalSpecVersion -> [Char]
showCabalSpecVersion (WriteOpts -> CabalSpecVersion
_optCabalSpec WriteOpts
opts)

      forall (m :: * -> *).
Interactive m =>
WriteOpts -> PkgDescription -> m ()
writeLicense WriteOpts
opts PkgDescription
pkgDesc
      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 <- forall (m :: * -> *).
Interactive m =>
WriteOpts -> Maybe LibTarget -> m (PrettyField FieldAnnotation)
prepareLibTarget WriteOpts
opts Maybe LibTarget
libTarget
      PrettyField FieldAnnotation
exeStanza <- forall (m :: * -> *).
Interactive m =>
WriteOpts -> Maybe ExeTarget -> m (PrettyField FieldAnnotation)
prepareExeTarget WriteOpts
opts Maybe ExeTarget
exeTarget
      PrettyField FieldAnnotation
testStanza <- forall (m :: * -> *).
Interactive m =>
WriteOpts -> Maybe TestTarget -> m (PrettyField FieldAnnotation)
prepareTestTarget WriteOpts
opts Maybe TestTarget
testTarget

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

      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ PkgDescription -> [Char]
_pkgSynopsis PkgDescription
pkgDesc) forall a b. (a -> b) -> a -> b
$
        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."

      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."

      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
reusedCabal forall a b. (a -> b) -> a -> b
$ do
        [Char]
existingCabal <- forall (m :: * -> *). Interactive m => [Char] -> m [Char]
readFile forall a b. (a -> b) -> a -> b
$ PackageName -> [Char]
unPackageName (WriteOpts -> PackageName
_optPkgName WriteOpts
opts) forall a. [a] -> [a] -> [a]
++ [Char]
".cabal"
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
existingCabal forall a. Eq a => a -> a -> Bool
/= [Char]
cabalContents) forall a b. (a -> b) -> a -> b
$
          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.
      forall (m :: * -> *). Interactive m => [Char] -> m ()
T.putStrLn [Char]
""
  where
    pkgName :: [Char]
pkgName = PackageName -> [Char]
unPackageName forall a b. (a -> b) -> a -> b
$ WriteOpts -> PackageName
_optPkgName WriteOpts
opts


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

    forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall (m :: * -> *).
Interactive m =>
WriteOpts -> Maybe ExeTarget -> m (PrettyField FieldAnnotation)
prepareExeTarget WriteOpts
_ Maybe ExeTarget
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall ann. PrettyField ann
PrettyEmpty
prepareExeTarget WriteOpts
opts (Just ExeTarget
exeTarget) = do
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Interactive m =>
WriteOpts -> [[Char]] -> m Bool
writeDirectoriesSafe WriteOpts
opts [[Char]]
appDirs
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Interactive m =>
WriteOpts -> [Char] -> [Char] -> m Bool
writeFileSafe WriteOpts
opts [Char]
mainPath [Char]
mainHs
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFilePath -> [[Char]] -> [[Char]]
mkLiterate HsFilePath
exeMainIs forall a b. (a -> b) -> a -> b
$
      if PackageType
pkgType 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 :: forall (m :: * -> *).
Interactive m =>
WriteOpts -> Maybe TestTarget -> m (PrettyField FieldAnnotation)
prepareTestTarget WriteOpts
_ Maybe TestTarget
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall ann. PrettyField ann
PrettyEmpty
prepareTestTarget WriteOpts
opts (Just TestTarget
testTarget) = do
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Interactive m =>
WriteOpts -> [[Char]] -> m Bool
writeDirectoriesSafe WriteOpts
opts [[Char]]
testDirs'
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Interactive m =>
WriteOpts -> [Char] -> [Char] -> m Bool
writeFileSafe WriteOpts
opts [Char]
testPath [Char]
myTestHs
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 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 :: forall (m :: * -> *).
Interactive m =>
WriteOpts -> [PrettyField FieldAnnotation] -> m (Bool, [Char])
writeCabalFile WriteOpts
opts [PrettyField FieldAnnotation]
fields = do
    let cabalContents :: [Char]
cabalContents = 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 <- forall (m :: * -> *).
Interactive m =>
WriteOpts -> [Char] -> [Char] -> m Bool
writeFileSafe WriteOpts
opts [Char]
cabalFileName [Char]
cabalContents
    forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
reusedCabal, [Char]
cabalContents)
  where
    cabalFileName :: [Char]
cabalFileName = [Char]
pkgName forall a. [a] -> [a] -> [a]
++ [Char]
".cabal"
    pkgName :: [Char]
pkgName = PackageName -> [Char]
unPackageName 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 :: forall (m :: * -> *).
Interactive m =>
WriteOpts -> PkgDescription -> m ()
writeLicense WriteOpts
writeOpts PkgDescription
pkgDesc = do
  [Char]
year <- forall a. Show a => a -> [Char]
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Interactive m => m Integer
getCurrentYear
  case [Char] -> [Char] -> Maybe [Char]
licenseFile [Char]
year (PkgDescription -> [Char]
_pkgAuthor PkgDescription
pkgDesc) of
    Just [Char]
licenseText ->
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Interactive m =>
WriteOpts -> [Char] -> [Char] -> m Bool
writeFileSafe WriteOpts
writeOpts [Char]
"LICENSE" [Char]
licenseText
    Maybe [Char]
Nothing -> 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))) = forall a. a -> Maybe a
Just LicenseId
lid
    getLid (Right License
l) = Either License License -> Maybe LicenseId
getLid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ License -> License
licenseToSPDX License
l
    getLid Either License License
_ = forall a. Maybe a
Nothing

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

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

  go :: m ()
go =
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ 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
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 :: forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts = 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 :: forall (m :: * -> *).
Interactive m =>
WriteOpts -> [Char] -> [Char] -> m Bool
writeFileSafe WriteOpts
opts [Char]
fileName [Char]
content = do
    Bool
exists <- 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

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

    forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Log forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show WriteAction
action forall a. [a] -> [a] -> [a]
++ [Char]
" file " forall a. [a] -> [a] -> [a]
++ [Char]
fileName forall a. [a] -> [a] -> [a]
++ [Char]
"..."
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WriteAction
action 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
        forall (m :: * -> *). Interactive m => [Char] -> [Char] -> m ()
writeFile [Char]
fileName [Char]
content
      | Bool
exists Bool -> Bool -> Bool
&& Bool
doOverwrite = do
        [Char]
newName <- forall (m :: * -> *). Interactive m => [Char] -> m [Char]
findNewPath [Char]
fileName
        forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Log forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [Char]
fileName
          , [Char]
" already exists. Backing up old version in "
          , [Char]
newName
          ]

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

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

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

    forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Log forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show WriteAction
action forall a. [a] -> [a] -> [a]
++ [Char]
" directory ./" forall a. [a] -> [a] -> [a]
++ [Char]
dir forall a. [a] -> [a] -> [a]
++ [Char]
"..."
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WriteAction
action 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
        forall (m :: * -> *). Interactive m => [Char] -> m ()
createDirectory [Char]
dir
      | Bool
exists Bool -> Bool -> Bool
&& Bool
doOverwrite = do
        [Char]
newDir <- forall (m :: * -> *). Interactive m => [Char] -> m [Char]
findNewPath [Char]
dir
        forall (m :: * -> *).
Interactive m =>
WriteOpts -> Severity -> [Char] -> m ()
message WriteOpts
opts Severity
T.Log forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [Char]
dir
          , [Char]
" already exists. Backing up old version in "
          , [Char]
newDir
          ]

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

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