{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Setup.SDist
-- Copyright   :  Isaac Jones 2003-2004
--                Duncan Coutts 2007
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Definition of the sdist command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.SDist
  ( SDistFlags
      ( SDistCommonFlags
      , sDistVerbosity
      , sDistDistPref
      , sDistCabalFilePath
      , sDistWorkingDir
      , sDistTargets
      , ..
      )
  , emptySDistFlags
  , defaultSDistFlags
  , sdistCommand
  ) where

import Distribution.Compat.Prelude hiding (get)
import Prelude ()

import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
import Distribution.Simple.Setup.Common
import Distribution.Utils.Path
import Distribution.Verbosity

-- ------------------------------------------------------------

-- * SDist flags

-- ------------------------------------------------------------

-- | Flags to @sdist@: (snapshot, verbosity)
data SDistFlags = SDistFlags
  { SDistFlags -> CommonSetupFlags
sDistCommonFlags :: !CommonSetupFlags
  , SDistFlags -> Flag Bool
sDistSnapshot :: Flag Bool
  , SDistFlags -> Flag FilePath
sDistDirectory :: Flag FilePath
  , SDistFlags -> Flag FilePath
sDistListSources :: Flag FilePath
  }
  deriving (Int -> SDistFlags -> ShowS
[SDistFlags] -> ShowS
SDistFlags -> FilePath
(Int -> SDistFlags -> ShowS)
-> (SDistFlags -> FilePath)
-> ([SDistFlags] -> ShowS)
-> Show SDistFlags
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SDistFlags -> ShowS
showsPrec :: Int -> SDistFlags -> ShowS
$cshow :: SDistFlags -> FilePath
show :: SDistFlags -> FilePath
$cshowList :: [SDistFlags] -> ShowS
showList :: [SDistFlags] -> ShowS
Show, (forall x. SDistFlags -> Rep SDistFlags x)
-> (forall x. Rep SDistFlags x -> SDistFlags) -> Generic SDistFlags
forall x. Rep SDistFlags x -> SDistFlags
forall x. SDistFlags -> Rep SDistFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SDistFlags -> Rep SDistFlags x
from :: forall x. SDistFlags -> Rep SDistFlags x
$cto :: forall x. Rep SDistFlags x -> SDistFlags
to :: forall x. Rep SDistFlags x -> SDistFlags
Generic, Typeable)

pattern SDistCommonFlags
  :: Flag Verbosity
  -> Flag (SymbolicPath Pkg (Dir Dist))
  -> Flag (SymbolicPath CWD (Dir Pkg))
  -> Flag (SymbolicPath Pkg File)
  -> [String]
  -> SDistFlags
pattern $mSDistCommonFlags :: forall {r}.
SDistFlags
-> (Flag Verbosity
    -> Flag (SymbolicPath Pkg ('Dir Dist))
    -> Flag (SymbolicPath CWD ('Dir Pkg))
    -> Flag (SymbolicPath Pkg 'File)
    -> [FilePath]
    -> r)
-> ((# #) -> r)
-> r
SDistCommonFlags
  { SDistFlags -> Flag Verbosity
sDistVerbosity
  , SDistFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
sDistDistPref
  , SDistFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
sDistWorkingDir
  , SDistFlags -> Flag (SymbolicPath Pkg 'File)
sDistCabalFilePath
  , SDistFlags -> [FilePath]
sDistTargets
  } <-
  ( sDistCommonFlags ->
      CommonSetupFlags
        { setupVerbosity = sDistVerbosity
        , setupDistPref = sDistDistPref
        , setupWorkingDir = sDistWorkingDir
        , setupCabalFilePath = sDistCabalFilePath
        , setupTargets = sDistTargets
        }
    )

defaultSDistFlags :: SDistFlags
defaultSDistFlags :: SDistFlags
defaultSDistFlags =
  SDistFlags
    { sDistCommonFlags :: CommonSetupFlags
sDistCommonFlags = CommonSetupFlags
defaultCommonSetupFlags
    , sDistSnapshot :: Flag Bool
sDistSnapshot = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
False
    , sDistDirectory :: Flag FilePath
sDistDirectory = Flag FilePath
forall a. Monoid a => a
mempty
    , sDistListSources :: Flag FilePath
sDistListSources = Flag FilePath
forall a. Monoid a => a
mempty
    }

sdistCommand :: CommandUI SDistFlags
sdistCommand :: CommandUI SDistFlags
sdistCommand =
  CommandUI
    { commandName :: FilePath
commandName = FilePath
"sdist"
    , commandSynopsis :: FilePath
commandSynopsis =
        FilePath
"Generate a source distribution file (.tar.gz)."
    , commandDescription :: Maybe ShowS
commandDescription = Maybe ShowS
forall a. Maybe a
Nothing
    , commandNotes :: Maybe ShowS
commandNotes = Maybe ShowS
forall a. Maybe a
Nothing
    , commandUsage :: ShowS
commandUsage = \FilePath
pname ->
        FilePath
"Usage: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
pname FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" sdist [FLAGS]\n"
    , commandDefaultFlags :: SDistFlags
commandDefaultFlags = SDistFlags
defaultSDistFlags
    , commandOptions :: ShowOrParseArgs -> [OptionField SDistFlags]
commandOptions = \ShowOrParseArgs
showOrParseArgs ->
        (SDistFlags -> CommonSetupFlags)
-> (CommonSetupFlags -> SDistFlags -> SDistFlags)
-> ShowOrParseArgs
-> [OptionField SDistFlags]
-> [OptionField SDistFlags]
forall flags.
(flags -> CommonSetupFlags)
-> (CommonSetupFlags -> flags -> flags)
-> ShowOrParseArgs
-> [OptionField flags]
-> [OptionField flags]
withCommonSetupOptions
          SDistFlags -> CommonSetupFlags
sDistCommonFlags
          (\CommonSetupFlags
c SDistFlags
f -> SDistFlags
f{sDistCommonFlags = c})
          ShowOrParseArgs
showOrParseArgs
          [ FilePath
-> [FilePath]
-> FilePath
-> (SDistFlags -> Flag FilePath)
-> (Flag FilePath -> SDistFlags -> SDistFlags)
-> MkOptDescr
     (SDistFlags -> Flag FilePath)
     (Flag FilePath -> SDistFlags -> SDistFlags)
     SDistFlags
-> OptionField SDistFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
              FilePath
""
              [FilePath
"list-sources"]
              FilePath
"Just write a list of the package's sources to a file"
              SDistFlags -> Flag FilePath
sDistListSources
              (\Flag FilePath
v SDistFlags
flags -> SDistFlags
flags{sDistListSources = v})
              (FilePath
-> MkOptDescr
     (SDistFlags -> Flag FilePath)
     (Flag FilePath -> SDistFlags -> SDistFlags)
     SDistFlags
forall b.
FilePath
-> FilePath
-> [FilePath]
-> FilePath
-> (b -> Flag FilePath)
-> (Flag FilePath -> b -> b)
-> OptDescr b
reqArgFlag FilePath
"FILE")
          , FilePath
-> [FilePath]
-> FilePath
-> (SDistFlags -> Flag Bool)
-> (Flag Bool -> SDistFlags -> SDistFlags)
-> MkOptDescr
     (SDistFlags -> Flag Bool)
     (Flag Bool -> SDistFlags -> SDistFlags)
     SDistFlags
-> OptionField SDistFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
              FilePath
""
              [FilePath
"snapshot"]
              FilePath
"Produce a snapshot source distribution"
              SDistFlags -> Flag Bool
sDistSnapshot
              (\Flag Bool
v SDistFlags
flags -> SDistFlags
flags{sDistSnapshot = v})
              MkOptDescr
  (SDistFlags -> Flag Bool)
  (Flag Bool -> SDistFlags -> SDistFlags)
  SDistFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
          , FilePath
-> [FilePath]
-> FilePath
-> (SDistFlags -> Flag FilePath)
-> (Flag FilePath -> SDistFlags -> SDistFlags)
-> MkOptDescr
     (SDistFlags -> Flag FilePath)
     (Flag FilePath -> SDistFlags -> SDistFlags)
     SDistFlags
-> OptionField SDistFlags
forall get set a.
FilePath
-> [FilePath]
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
              FilePath
""
              [FilePath
"output-directory"]
              ( FilePath
"Generate a source distribution in the given directory, "
                  FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"without creating a tarball"
              )
              SDistFlags -> Flag FilePath
sDistDirectory
              (\Flag FilePath
v SDistFlags
flags -> SDistFlags
flags{sDistDirectory = v})
              (FilePath
-> MkOptDescr
     (SDistFlags -> Flag FilePath)
     (Flag FilePath -> SDistFlags -> SDistFlags)
     SDistFlags
forall b.
FilePath
-> FilePath
-> [FilePath]
-> FilePath
-> (b -> Flag FilePath)
-> (Flag FilePath -> b -> b)
-> OptDescr b
reqArgFlag FilePath
"DIR")
          ]
    }

emptySDistFlags :: SDistFlags
emptySDistFlags :: SDistFlags
emptySDistFlags = SDistFlags
forall a. Monoid a => a
mempty

instance Monoid SDistFlags where
  mempty :: SDistFlags
mempty = SDistFlags
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: SDistFlags -> SDistFlags -> SDistFlags
mappend = SDistFlags -> SDistFlags -> SDistFlags
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup SDistFlags where
  <> :: SDistFlags -> SDistFlags -> SDistFlags
(<>) = SDistFlags -> SDistFlags -> SDistFlags
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend