{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
module Distribution.Client.ProjectFlags (
    ProjectFlags(..),
    defaultProjectFlags,
    projectFlagsOptions,
    removeIgnoreProjectOption,
) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.ReadE          (succeedReadE)
import Distribution.Simple.Command
    ( MkOptDescr, OptionField(optionName), ShowOrParseArgs (..), boolOpt', option
    , reqArg )
import Distribution.Simple.Setup   (Flag (..), flagToList, flagToMaybe, toFlag, trueArg)

data ProjectFlags = ProjectFlags
    { ProjectFlags -> Flag FilePath
flagProjectFileName :: Flag FilePath
      -- ^ The cabal project file name; defaults to @cabal.project@.
      -- The name itself denotes the cabal project file name, but it also
      -- is the base of auxiliary project files, such as
      -- @cabal.project.local@ and @cabal.project.freeze@ which are also
      -- read and written out in some cases.  If the path is not found
      -- in the current working directory, we will successively probe
      -- relative to parent directories until this name is found.

    , ProjectFlags -> Flag Bool
flagIgnoreProject   :: Flag Bool
      -- ^ Whether to ignore the local project (i.e. don't search for cabal.project)
      -- The exact interpretation might be slightly different per command.
    }
  deriving (Int -> ProjectFlags -> ShowS
[ProjectFlags] -> ShowS
ProjectFlags -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectFlags] -> ShowS
$cshowList :: [ProjectFlags] -> ShowS
show :: ProjectFlags -> FilePath
$cshow :: ProjectFlags -> FilePath
showsPrec :: Int -> ProjectFlags -> ShowS
$cshowsPrec :: Int -> ProjectFlags -> ShowS
Show, forall x. Rep ProjectFlags x -> ProjectFlags
forall x. ProjectFlags -> Rep ProjectFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectFlags x -> ProjectFlags
$cfrom :: forall x. ProjectFlags -> Rep ProjectFlags x
Generic)

defaultProjectFlags :: ProjectFlags
defaultProjectFlags :: ProjectFlags
defaultProjectFlags = ProjectFlags
    { flagProjectFileName :: Flag FilePath
flagProjectFileName = forall a. Monoid a => a
mempty
    , flagIgnoreProject :: Flag Bool
flagIgnoreProject   = forall a. a -> Flag a
toFlag Bool
False
      -- Should we use 'Last' here?
    }

projectFlagsOptions :: ShowOrParseArgs -> [OptionField ProjectFlags]
projectFlagsOptions :: ShowOrParseArgs -> [OptionField ProjectFlags]
projectFlagsOptions ShowOrParseArgs
showOrParseArgs =
    [ forall get set a.
FilePath
-> LFlags
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [FilePath
"project-file"]
        FilePath
"Set the name of the cabal.project file to search for in parent directories"
        ProjectFlags -> Flag FilePath
flagProjectFileName (\Flag FilePath
pf ProjectFlags
flags -> ProjectFlags
flags { flagProjectFileName :: Flag FilePath
flagProjectFileName = Flag FilePath
pf })
        (forall b a.
Monoid b =>
FilePath
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg FilePath
"FILE" (forall a. (FilePath -> a) -> ReadE a
succeedReadE forall a. a -> Flag a
Flag) forall a. Flag a -> [a]
flagToList)
    , forall get set a.
FilePath
-> LFlags
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [Char
'z'] [FilePath
"ignore-project"]
        FilePath
"Ignore local project configuration"
        -- Flag True: --ignore-project is given and --project-file is not given
        -- Flag False: --ignore-project and --project-file is given
        -- NoFlag: neither --ignore-project or --project-file is given
        ProjectFlags -> Flag Bool
flagIgnoreProject (\Flag Bool
v ProjectFlags
flags -> ProjectFlags
flags { flagIgnoreProject :: Flag Bool
flagIgnoreProject = if Flag Bool
v forall a. Eq a => a -> a -> Bool
== forall a. Flag a
NoFlag then forall a. Flag a
NoFlag else forall a. a -> Flag a
toFlag ((ProjectFlags -> Flag FilePath
flagProjectFileName ProjectFlags
flags) forall a. Eq a => a -> a -> Bool
== forall a. Flag a
NoFlag Bool -> Bool -> Bool
&& Flag Bool
v forall a. Eq a => a -> a -> Bool
== forall a. a -> Flag a
Flag Bool
True) })
        (forall b.
ShowOrParseArgs
-> MkOptDescr (b -> Flag Bool) (Flag Bool -> b -> b) b
yesNoOpt ShowOrParseArgs
showOrParseArgs)
    ]

-- | As almost all commands use 'ProjectFlags' but not all can honour
-- "ignore-project" flag, provide this utility to remove the flag
-- parsing from the help message.
removeIgnoreProjectOption :: [OptionField a] -> [OptionField a]
removeIgnoreProjectOption :: forall a. [OptionField a] -> [OptionField a]
removeIgnoreProjectOption = forall a. (a -> Bool) -> [a] -> [a]
filter (\OptionField a
o -> forall a. OptionField a -> FilePath
optionName OptionField a
o forall a. Eq a => a -> a -> Bool
/= FilePath
"ignore-project")

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

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

yesNoOpt :: ShowOrParseArgs -> MkOptDescr (b -> Flag Bool) (Flag Bool -> b -> b) b
yesNoOpt :: forall b.
ShowOrParseArgs
-> MkOptDescr (b -> Flag Bool) (Flag Bool -> b -> b) b
yesNoOpt ShowOrParseArgs
ShowArgs FilePath
sf LFlags
lf = forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg FilePath
sf LFlags
lf
yesNoOpt ShowOrParseArgs
_        FilePath
sf LFlags
lf = forall b a.
(b -> Maybe Bool)
-> (Bool -> b)
-> OptFlags
-> OptFlags
-> MkOptDescr (a -> b) (b -> a -> a) a
boolOpt' forall a. Flag a -> Maybe a
flagToMaybe forall a. a -> Flag a
Flag (FilePath
sf, LFlags
lf) ([], forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"no-" forall a. [a] -> [a] -> [a]
++) LFlags
lf) FilePath
sf LFlags
lf