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