-- | Generates a skeletal file structure to start a new Cartel-based -- project. Similar to @cabal init@ or @stack new@. module Cartel.Init ( cartelInit , Github(..) , GitInit(..) , License(..) , TreeInitMode(..) , TreeInit(..) , InitMode(..) , Init(..) , cartelInitWithSettings ) where import Cartel.Types (NonEmptyString) import Control.Applicative (many, (<|>)) import qualified Control.Exception as Exception import Data.List (intersperse) import Data.List.Split (splitOn) import Data.Maybe (fromMaybe, catMaybes) import Data.Monoid ((<>)) import qualified Data.Time as Time import qualified Options.Applicative as O import qualified Options.Applicative.Types as OT import qualified System.Directory as Directory import System.FilePath (()) import qualified System.Process as Process import Text.Read (readMaybe) import Text.Show.Pretty (ppShow) -- # Data types -- | Configuration information for Github. data Github = Github { githubUsername :: NonEmptyString , noGithubIssues :: Bool -- ^ If you want to use the Github issue tracker, use 'True' here, -- and then the 'C.bugReports' field will give the Github issues -- URL. , createRemote :: String -- ^ If non-empty, creates a Git remote with the given name using -- the @git remote@ command. If empty, does not create a Git -- remote. } deriving Show data GitInit = GitInit { gitIgnorePatterns :: [NonEmptyString] -- ^ If there are any values here, a @.gitignore@ file will be -- created in your project's root directory, with one pattern for -- each element of this list. , trackCabal :: Bool -- ^ In addition to 'gitIgnorePatterns', if 'False' a pattern is -- added to ignore the project's generated .cabal file. , useGithub :: Maybe Github -- ^ If you want to use Github, pass an appropriate 'Just' value here. -- This will: -- -- * use the main Github project page for the 'C.homepage' field -- -- * create an appropriate @source-repository@ entry -- -- * 'noGithubIssues' if you wish } deriving Show -- | What kind of license you want to use. Currently the only choices -- are BSD3 or AllRightsReserved. data License = BSD3 | AllRightsReserved deriving (Read, Show) data TreeInitMode = MakeTreeOnly -- ^ Create a cabal file and write it with a skeleton of files. | MakeGit GitInit -- ^ Create a cabal file, write it with a skeleton of files, and -- initialize a Git repository. deriving Show data TreeInit = TreeInit { cartelResolver :: NonEmptyString -- ^ Use this resolver for the @stack.yaml@ for the Cabal file -- generator. , packageResolver :: NonEmptyString -- ^ Use this resolver for the @stack.yaml@ for the package. , treeInitMode :: TreeInitMode } deriving Show -- | What to do when running @cabal-init@. data InitMode = ShowCabalOnly -- ^ Only show a cabal file. | MakeTree TreeInit -- ^ Create a cabal file and write it with a skeleton of files. deriving Show -- | Configuration options. Some of these can be overridden on the -- command line. data Init = Init { author :: String -- ^ Used for original package author name. , maintainer :: String -- ^ Used for the current maintainer. This should be an email address. , initMode :: InitMode , ghcOptions :: [NonEmptyString] -- ^ Put any default GHC warnings you want here, e.g. @["-Wall", "-O0"]@. , license :: License -- ^ Default license type , baseLowerBound :: [Word] -- ^ The lower bounds for the dependency for the @base@ package. -- For example use @[4,8]@ for the lower bound to be @base-4.8@. , baseUpperBound :: [Word] -- ^ The upper bounds for the dependency for the @base@ package. -- For example use @[5]@ for the lower bound to be @base-5@. } deriving Show data ProjectInit = ProjectInit { piInit :: Init , projectName :: String -- ^ Name for the project. Will be used as the directory name, -- Github project name, and Cabal project name. } deriving Show -- # Data type manipulation gitInit :: Init -> Maybe GitInit gitInit ini = case initMode ini of MakeTree treeInit -> case treeInitMode treeInit of MakeTreeOnly -> Nothing MakeGit gi -> Just gi _ -> Nothing -- # File and directory utilities -- | Change to the given directory, carry out IO action, and return to -- the old directory after the IO action is complete. Exception safe. withDirectory :: FilePath -> IO a -> IO a withDirectory fp act = Exception.bracket get Directory.setCurrentDirectory (const act) where get = do current <- Directory.getCurrentDirectory Directory.setCurrentDirectory fp return current -- | Give the given file executable permission by the user. Uses the -- chmod program. makeFileExecutable :: FilePath -> IO () makeFileExecutable fp = Process.callProcess "chmod" ["u+x", fp] -- | Writes a particular file and then makes it executable. writeExecutableFile :: FilePath -> String -> IO () writeExecutableFile fp txt = do writeFile fp txt makeFileExecutable fp -- # Creating the text for result files -- | The text for the package home page, without any quotes. Only -- returns text if Github is being used. homepageText :: NonEmptyString -- ^ Package name -> Init -> String homepageText pkgName ini = fromMaybe "" $ do gi <- gitInit ini gh <- useGithub gi return $ "http://www.github.com/" ++ githubUsername gh ++ "/" ++ pkgName -- | The text for the Github issues page, without any quotes, if there -- is a Github issues page. bugReportsText :: NonEmptyString -- ^ Package name -> Init -> String bugReportsText pkgName ini = fromMaybe "" $ do gi <- gitInit ini gh <- useGithub gi return $ if not (noGithubIssues gh) then "http://www.github.com/" ++ githubUsername gh ++ "/" ++ pkgName ++ "/issues" else "" licenseName :: Init -> String licenseName ini = "Cartel." ++ case license ini of BSD3 -> "bsd3" AllRightsReserved -> "allRightsReserved" licenseFileName :: Init -> Maybe String licenseFileName ini = case license ini of BSD3 -> Just "LICENSE" AllRightsReserved -> Nothing propertiesText :: NonEmptyString -- ^ Package name -> String -- ^ Year -> Init -> String propertiesText packageName year ini = unlines [ "properties :: Cartel.Properties" , "properties = Cartel.Properties" , " { Cartel.name = " ++ quotes packageName , " , Cartel.version = version" , " , Cartel.cabalVersion = Just (1,10)" , " , Cartel.buildType = Just Cartel.simple" , " , Cartel.license = Just " ++ licenseName ini , " , Cartel.licenseFile = " ++ quotes (fromMaybe "" (licenseFileName ini)) , " , Cartel.licenseFiles = []" , " , Cartel.copyright = " ++ (quotes $ "Copyright (c) " ++ year ++ " " ++ author ini) , " , Cartel.author = " ++ quotes (author ini) , " , Cartel.maintainer = " ++ quotes (maintainer ini) , " , Cartel.stability = \"Experimental\"" , " , Cartel.homepage = " ++ quotes (homepageText packageName ini) , " , Cartel.bugReports = " ++ quotes (bugReportsText packageName ini) , " , Cartel.packageUrl = " ++ quotes "" , " , Cartel.synopsis = " ++ quotes "" , " , Cartel.description = []" , " , Cartel.category = " ++ quotes "" , " , Cartel.testedWith = []" , " , Cartel.dataFiles = []" , " , Cartel.dataDir = " ++ quotes "" , " , Cartel.extraSourceFiles = []" , " , Cartel.extraDocFiles = []" , " , Cartel.extraTmpFiles = []" , " }" ] ghcOptionsText :: [NonEmptyString] -> String ghcOptionsText options = unlines $ [ "ghcOptions :: Cartel.HasBuildInfo a => a" , "ghcOptions = Cartel.ghcOptions" ] ++ end where end = case options of [] -> [" [", " ]"] x:xs -> optLines ++ [" ]"] where optLines = (" [ " ++ quotes x) : fmap ((" , " ++) . quotes) xs commonOptionsText :: String commonOptionsText = unlines [ "commonOptions :: Cartel.HasBuildInfo a => [a]" , "commonOptions" , " = ghcOptions" , " : Cartel.haskell2010" , " : Cartel.hsSourceDirs [\"lib\"]" , " : []" ] libDependsText :: [Word] -- ^ Base lower bound -> [Word] -- ^ Base upper bound -> String libDependsText lower upper = unlines [ "libraryDepends :: [Cartel.Package]" , "libraryDepends =" , " [ Cartel.closedOpen \"base\" " ++ show lower ++ " " ++ show upper , " ]" ] libraryText :: String libraryText = unlines [ "library" , " :: [Cartel.NonEmptyString]" , " -- ^ List of library modules" , " -> [Cartel.LibraryField]" , "library libModules" , " = Cartel.buildDepends libraryDepends" , " : Cartel.exposedModules libModules" , " : commonOptions" ] githubHeadText :: NonEmptyString -- ^ Package name -> Init -> Maybe String githubHeadText pkgName ini = do gi <- gitInit ini gh <- useGithub gi return . unlines $ [ "github :: Cartel.Section" , "github = Cartel.githubHead " ++ quotes (githubUsername gh) ++ " " ++ quotes pkgName ] sectionsText :: Init -> String sectionsText ini = unlines [ "sections :: [Cartel.Section]" , "sections =" , " [" ++ section1 , " ]" ] where section1 = fromMaybe "" $ do gi <- gitInit ini _ <- useGithub gi return " github" mainText :: NonEmptyString -- ^ Package name -> String mainText pkgName = unlines [ "main :: IO ()" , "main = Cartel.defaultMain $ do" , " libModules <- Cartel.modules " ++ quotes ("../" ++ pkgName ++ "/lib") , " return (properties, library libModules, sections)" ] genCabalText :: NonEmptyString -- ^ Package name -> String -- ^ Year -> Init -> String genCabalText pkgName year ini = concat . intersperse "\n" . catMaybes $ [ Just heading , Just $ propertiesText pkgName year ini , Just $ ghcOptionsText (ghcOptions ini) , Just $ commonOptionsText , Just $ libDependsText (baseLowerBound ini) (baseUpperBound ini) , Just $ libraryText , githubHeadText pkgName ini , Just $ sectionsText ini , Just $ mainText pkgName ] where heading = unlines [ "module Main (main) where" , "" , "import qualified Cartel" , "" , "version :: [Word]" , "version = [0,1,0,0]" ] quotes :: String -> String quotes s = "\"" ++ s ++ "\"" cartelCabalText :: ProjectInit -> String cartelCabalText pinit = unlines [ "-- This Cabal file generated by the cartel-init program." , "" , "name: gen-" ++ projectName pinit ++ "-cabal" , "version: 0.1" , "build-type: Simple" , "synopsis: Generates a Cabal file for the " ++ projectName pinit ++ " package" , "cabal-version: >=1.10" , "" , "Executable " ++ exeName , " main-is: " ++ exeName ++ ".hs" , " default-language: Haskell2010" , " ghc-options: -W" , " build-depends: base, cartel" ] where exeName = "gen-" ++ projectName pinit ++ "-cabal" setupText :: String setupText = unlines [ "import Distribution.Simple" , "main = defaultMain" ] stackYamlText :: NonEmptyString -> String stackYamlText resolver = unlines [ "# This stack.yaml generated by the cartel-init program." , "" , "resolver: " ++ resolver ] buildprepHeader :: [String] buildprepHeader = [ "#!/bin/sh" , "# Generates the project's .cabal file." , "# Must be run with the containing directory as the current directory." ] genCabalBuildprepText :: ProjectInit -> String genCabalBuildprepText pini = unlines $ buildprepHeader ++ [ "stack build" , "stack exec gen-" ++ projectName pini ++ "-cabal > ../" ++ projectName pini ++ "/" ++ projectName pini ++ ".cabal" ] genRootBuildprepText :: ProjectInit -> String genRootBuildprepText pini = unlines $ buildprepHeader ++ [ "cd gen-" ++ projectName pini ++ "-cabal" , "sh buildprep" ] genPackageBuildprepText :: ProjectInit -> String genPackageBuildprepText pini = unlines $ buildprepHeader ++ [ "cd ../gen-" ++ projectName pini ++ "-cabal" , "sh buildprep" ] gitignoreText :: String -- ^ Project name -> GitInit -> String gitignoreText pname gi = unlines (headerLines ++ allLines) where headerLines = [ "# This .gitignore file generated by the cartel-init program." , "" , ".stack-work/" , "dist/" ] allLines = projectLines ++ extraLines projectLines | trackCabal gi = [] | otherwise = [ "# Do not track project's cabal file" , pname ++ ".cabal" ] extraLines | null . gitIgnorePatterns $ gi = [] | otherwise = "# Other specified ignored patterns" : gitIgnorePatterns gi writeGitignoreText :: ProjectInit -> IO () writeGitignoreText pini = case initMode . piInit $ pini of ShowCabalOnly -> return () MakeTree ti -> case treeInitMode ti of MakeTreeOnly -> return () MakeGit gi -> let txt = gitignoreText (projectName pini) gi in writeFile (projectName pini ".gitignore") txt bsd3LicenseText :: String -- ^ Year -> String -- ^ Owner -> String -- ^ License text bsd3LicenseText year owner = unlines [ "Copyright (c) " ++ year ++ " " ++ owner , "All rights reserved." , "" , "Redistribution and use in source and binary forms, with or without" , "modification, are permitted provided that the following conditions are" , "met:" , "" , "1. Redistributions of source code must retain the above copyright" , "notice, this list of conditions and the following disclaimer." , "" , "2. Redistributions in binary form must reproduce the above copyright" , "notice, this list of conditions and the following disclaimer in the" , "documentation and/or other materials provided with the distribution." , "" , "3. Neither the name of the copyright holder nor the names of its" , "contributors may be used to endorse or promote products derived from" , "this software without specific prior written permission." , "" , "THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS" , "\"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT" , "LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR" , "A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT" , "HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL," , "SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT" , "LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE," , "DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY" , "THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT" , "(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE" , "OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE." ] rootReadme :: ProjectInit -> String rootReadme pini = unlines $ [ "# " ++ projectName pini , "" ] ++ licenseLines ++ [ "## Building this project" , "" , "The Cabal file for this project is generated using the Cartel package." , "To generate the Cabal file, simply run `sh buildprep`." , "You must run this command from the project's main directory." , "You will need to have the `stack` program installed." , "" , "Stack is available at:" , "http://www.haskellstack.org" ] where licenseLines = case license . piInit $ pini of AllRightsReserved -> [] BSD3 -> [ "## License" , "" , "This package is released under the BSD3 license." ++ " Please see the LICENSE file." , "" ] packageReadme :: ProjectInit -> String packageReadme pini = unlines $ [ "# " ++ projectName pini , "" ] ++ licenseLines ++ [ "## Building this project" , "" , "If you are viewing the source code repository, a `.cabal` file might" , "not be included. Please see the README.md in the main project directory" , "for details on how to generate the `.cabal` file." ] where licenseLines = case license . piInit $ pini of AllRightsReserved -> [] BSD3 -> [ "## License" , "" , "This package is released under the BSD3 license." ++ " Please see the LICENSE file." , "" ] -- # Option parsing pAuthor :: O.Parser String pAuthor = O.strOption ( O.long "author" <> O.short 'a' <> O.metavar "NAME" <> O.help "Name of the package author (typically your full name)") pMaintainer :: O.Parser String pMaintainer = O.strOption ( O.long "maintainer" <> O.short 'm' <> O.metavar "EMAIL" <> O.help "Package maintainer's email address") pGhcOption :: O.Parser [String] pGhcOption = many $ O.strOption ( O.long "ghc-option" <> O.short 'g' <> O.metavar "OPTION" <> O.help ("A single GHC option, with the leading hyphen, e.g. \"-Wall\"." ++ " To get multiple GHC options, use this flag more than once.")) pCartelResolver :: O.Parser String pCartelResolver = O.strOption ( O.long "cartel-resolver" <> O.metavar "RESOLVER" <> O.help "Resolver to use for package that generates Cabal file" <> O.value "lts-6.4" <> O.showDefault ) pPackageResolver :: O.Parser String pPackageResolver = O.strOption ( O.long "package-resolver" <> O.metavar "RESOLVER" <> O.help "Resolver to use for the new package" <> O.value "lts-6.4" <> O.showDefault ) pLicense :: O.Parser License pLicense = flagBSD <|> pure AllRightsReserved where flagBSD = O.flag' BSD3 ( O.long "bsd3" <> O.help ("Use BSD3 license. (If this option is not used, license " ++ "will be \"All Rights Reserved\".)")) parseVersionString :: O.ReadM [Word] parseVersionString = do str <- OT.readerAsk let digitStrings = splitOn "." str case mapM readMaybe digitStrings of Nothing -> OT.readerError $ "invalid version number: " ++ str Just r -> return r pLowerBound :: O.Parser [Word] pLowerBound = O.option parseVersionString ( O.long "base-lower-bound" <> O.metavar "VERSION" <> O.help ("Lower bound for the 'base' package, e.g. \"4.8\"" ++ " (default: 4.8)") <> O.value [4,8] ) pUpperBound :: O.Parser [Word] pUpperBound = O.option parseVersionString ( O.long "base-upper-bound" <> O.metavar "VERSION" <> O.help ("Lower bound for the 'base' package, e.g. \"5\"" ++ " (default: 5)") <> O.value [5] ) pInit :: O.Parser (InitMode -> Init) pInit = f <$> pAuthor <*> pMaintainer <*> pGhcOption <*> pLicense <*> pLowerBound <*> pUpperBound where f a m g l low up gi = Init a m gi g l low up pTreeInit :: O.Parser (TreeInitMode -> TreeInit) pTreeInit = TreeInit <$> pCartelResolver <*> pPackageResolver pInitTreeOnly :: O.Parser Init pInitTreeOnly = f <$> pInit <*> pTreeInit where f mkIni mkTreeIni = mkIni (MakeTree (mkTreeIni MakeTreeOnly)) pInitNoGithub :: O.Parser Init pInitNoGithub = f <$> pInit <*> pTreeInit <*> pGitInit where f getInit getTreeInit getGitInit = getInit (MakeTree (getTreeInit (MakeGit (getGitInit Nothing)))) pInitWithGithub :: O.Parser Init pInitWithGithub = f <$> pInit <*> pTreeInit <*> pGitInit <*> pGithub where f getInit getTreeInit getGitInit gh = getInit (MakeTree (getTreeInit (MakeGit (getGitInit (Just gh))))) pInitCabalOnly :: O.Parser Init pInitCabalOnly = ($ ShowCabalOnly) <$> pInit pGitInit :: O.Parser (Maybe Github -> GitInit) pGitInit = GitInit <$> pGitIgnore <*> pTrackCabal where pGitIgnore = many $ O.strOption (O.long "git-ignore" <> O.short 'g' <> O.metavar "PATTERN" <> O.help ("A single pattern to add to the project-wide \".gitignore\"" ++ " file. To add multiple patterns, use this flag multiple times.")) pTrackCabal = O.switch (O.long "track-cabal" <> O.short 't' <> O.help ("By default an entry is added to \".gitignore\" so that the" ++ " generated \".cabal\" file is NOT tracked in git. If you DO want" ++ " to track the \".cabal\" file in git, use this option.")) pGithub :: O.Parser Github pGithub = Github <$> pUser <*> pIssues <*> pRemote where pUser = O.strOption (O.long "username" <> O.short 'u' <> O.metavar "USERNAME" <> O.help "Github username") pIssues = O.flag False True (O.long "no-issues" <> O.help "Whether to use Github issue tracker" <> O.help ("By default the Github issues tracker is used. If you do" ++ " NOT want to use it, use this flag.")) pRemote = O.strOption (O.long "remote" <> O.short 'r' <> O.metavar "REMOTE" <> O.value "github" <> O.showDefault <> O.help ("Name for local Git remote to interact with Github " ++ "(use empty string to create no remote)")) pProjectName :: O.Parser String pProjectName = O.strArgument (O.metavar "NAME" <> O.help ( "Name for project. Used for directory name, Github project name," ++ " and Cabal project name.")) pTreeCommand :: O.Parser ProjectInit pTreeCommand = O.helper <*> (ProjectInit <$> pInitTreeOnly <*> pProjectName) pCabalCommand :: O.Parser ProjectInit pCabalCommand = O.helper <*> (ProjectInit <$> pInitCabalOnly <*> pProjectName) modTreeCommand :: O.Mod O.CommandFields ProjectInit modTreeCommand = O.command "tree" infTreeOnly where infTreeOnly = O.info pTreeCommand (O.progDesc "create file tree only" <> O.footer ("Creates a skeleton file tree.")) pGitCommand :: O.Parser ProjectInit pGitCommand = O.helper <*> (f <$> pInitNoGithub <*> pProjectName) where f i pName = ProjectInit i pName modGitCommand :: O.Mod O.CommandFields ProjectInit modGitCommand = O.command "git" infGit where infGit = O.info pGitCommand (O.progDesc "create file tree and Git repository" <> O.footer ("Creates a skeleton file tree and initializes a Git" ++ " repository.")) pGithubCommand :: O.Parser ProjectInit pGithubCommand = O.helper <*> (f <$> pInitWithGithub <*> pProjectName) where f i pName = ProjectInit i pName modGithubCommand :: O.Mod O.CommandFields ProjectInit modGithubCommand = O.command "github" infGithub where infGithub = O.info pGithubCommand (O.progDesc "create file tree, Git repository, and Github remotes" <> O.footer ("Creates a skeleton file tree and initializes a Git" ++ " repository with a Github remote.")) modCabalCommand :: O.Mod O.CommandFields ProjectInit modCabalCommand = O.command "cabal" infCabal where infCabal = O.info (O.helper <*> pCabalCommand) ( O.progDesc "only show Cabal file program" <> O.footer ("Creates a program that generates a Cabal file and " ++ "prints this program to standard output.")) pCommands :: O.ParserInfo ProjectInit pCommands = O.info (O.helper <*> O.subparser (modCabalCommand <> modTreeCommand <> modGitCommand <> modGithubCommand)) (O.footer ("Cartel skeleton generator. Sets up a skeleton file tree " ++ "to start a new package based on Cartel. Optionally, also sets up " ++ "Git repository and Github information. Some command line flags are " ++ "required; in the help, these are shown in parentheses. Optional flags " ++ "are shown in square brackets.")) -- | Retrieves the 'ProjectInit' by parsing the command line arguments. parseCommands :: IO ProjectInit parseCommands = O.execParser pCommands pSettings :: Init -> O.Parser (a -> a) pSettings ini = O.infoOption (ppShow ini) ( O.short 's' <> O.long "settings" <> O.help "show compiled-in settings and exit") pWithSettingsName :: Init -> O.Parser String pWithSettingsName ini = O.helper <*> pSettings ini <*> pProjectName parseCartelInitWithSettings :: Init -> IO ProjectInit parseCartelInitWithSettings ini = O.execParser parseInfo where parseInfo = O.info (O.helper <*> parser) (O.footer ("Cartel skeleton generator, with custom" ++ " compiled-in settings. To see the settings you compiled in," ++ " use the \"--settings\" option.")) parser = ProjectInit <$> pure ini <*> pWithSettingsName ini -- | Runs @cartel-init@, but with the settings you compile in. -- Retrieves the project name from the command line. Has a -- command-line option, @--settings@, that displays the built-in -- settings and then exits. cartelInitWithSettings :: Init -> IO () cartelInitWithSettings ini = parseCartelInitWithSettings ini >>= runCartelInit printCabalText :: ProjectInit -> String -> IO () printCabalText pinit cabalTxt = case initMode . piInit $ pinit of ShowCabalOnly -> putStrLn cabalTxt _ -> return () -- # Writing text to disk writeLicenseText :: String -- ^ Year -> ProjectInit -> IO () writeLicenseText yr pini = case license . piInit $ pini of AllRightsReserved -> return () BSD3 -> do writeFile (projectName pini "LICENSE") txt writeFile (projectName pini projectName pini "LICENSE") txt where txt = bsd3LicenseText yr (author . piInit $ pini) writeReadmes :: ProjectInit -> IO () writeReadmes pini = do writeFile (name "README.md") (rootReadme pini) writeFile (name name "README.md") (packageReadme pini) where name = projectName pini writeSetupFiles :: ProjectInit -> IO () writeSetupFiles pini = do writeFile (name ("gen-" ++ name ++ "-cabal") "Setup.hs") setupText writeFile (name name "Setup.hs") setupText where name = projectName pini writeStackYamls :: ProjectInit -> IO () writeStackYamls pini = case initMode . piInit $ pini of ShowCabalOnly -> return () MakeTree ti -> do writeFile (name ("gen-" ++ name ++ "-cabal") "stack.yaml") (stackYamlText (cartelResolver ti)) writeFile (name name "stack.yaml") (stackYamlText (packageResolver ti)) where name = projectName pini writeBuildpreps :: ProjectInit -> IO () writeBuildpreps pini = do let fnRoot = (name ("gen-" ++ name ++ "-cabal") bp) writeExecutableFile fnRoot (genCabalBuildprepText pini) let fnPackage = (name bp) writeExecutableFile fnPackage (genRootBuildprepText pini) let fnLib = name name bp writeExecutableFile fnLib (genPackageBuildprepText pini) where name = projectName pini bp = "buildprep" createSkeleton :: String -- ^ Year -> ProjectInit -> String -- ^ Cabal text -> IO () createSkeleton yr pini cabalText = do -- Make directories Directory.createDirectory name Directory.createDirectory (name cartelProject) Directory.createDirectory (name name) Directory.createDirectory (name name "lib") -- Write files writeLicenseText yr pini writeFile (name cartelProject (cartelProject ++ ".hs")) cabalText writeFile (name cartelProject (cartelProject ++ ".cabal")) (cartelCabalText pini) writeReadmes pini writeGitignoreText pini writeSetupFiles pini writeStackYamls pini writeBuildpreps pini where name = projectName pini cartelProject = "gen-" ++ name ++ "-cabal" -- # Git addGitRemote :: ProjectInit -> IO () addGitRemote pini = case initMode . piInit $ pini of ShowCabalOnly -> return () MakeTree ti -> case treeInitMode ti of MakeTreeOnly -> return () MakeGit gi -> case useGithub gi of Nothing -> return () Just gh | null (createRemote gh) -> return () | otherwise -> withDirectory (projectName pini) $ Process.callProcess "git" ["remote", "add", createRemote gh, url] where url = "git@github.com:" ++ githubUsername gh ++ "/" ++ projectName pini ++ ".git" runGitInit :: ProjectInit -> IO () runGitInit pini = withDirectory (projectName pini) $ Process.callProcess "git" ["init"] initializeGit :: ProjectInit -> IO () initializeGit pini = runGitInit pini >> addGitRemote pini runCartelInit :: ProjectInit -> IO () runCartelInit ini = do zt <- Time.getZonedTime let (yr, _, _) = Time.toGregorian . Time.localDay . Time.zonedTimeToLocalTime $ zt cabalText = genCabalText (projectName ini) (show yr) (piInit ini) printCabalText ini cabalText createSkeleton (show yr) ini cabalText initializeGit ini -- | Runs @cartel-init@, retrieving all configuration information from -- the command line. cartelInit :: IO () cartelInit = parseCommands >>= runCartelInit