{-# 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
(Int -> ProjectFlags -> ShowS)
-> (ProjectFlags -> FilePath)
-> ([ProjectFlags] -> ShowS)
-> Show ProjectFlags
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. ProjectFlags -> Rep ProjectFlags x)
-> (forall x. Rep ProjectFlags x -> ProjectFlags)
-> Generic ProjectFlags
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 :: Flag FilePath -> Flag Bool -> ProjectFlags
ProjectFlags
    { flagProjectFileName :: Flag FilePath
flagProjectFileName = Flag FilePath
forall a. Monoid a => a
mempty
    , flagIgnoreProject :: Flag Bool
flagIgnoreProject   = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
False
      -- Should we use 'Last' here?
    }

projectFlagsOptions :: ShowOrParseArgs -> [OptionField ProjectFlags]
projectFlagsOptions :: ShowOrParseArgs -> [OptionField ProjectFlags]
projectFlagsOptions ShowOrParseArgs
showOrParseArgs =
    [ FilePath
-> LFlags
-> FilePath
-> (ProjectFlags -> Flag FilePath)
-> (Flag FilePath -> ProjectFlags -> ProjectFlags)
-> MkOptDescr
     (ProjectFlags -> Flag FilePath)
     (Flag FilePath -> ProjectFlags -> ProjectFlags)
     ProjectFlags
-> OptionField ProjectFlags
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 })
        (FilePath
-> ReadE (Flag FilePath)
-> (Flag FilePath -> LFlags)
-> MkOptDescr
     (ProjectFlags -> Flag FilePath)
     (Flag FilePath -> ProjectFlags -> ProjectFlags)
     ProjectFlags
forall b a.
Monoid b =>
FilePath
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg FilePath
"FILE" ((FilePath -> Flag FilePath) -> ReadE (Flag FilePath)
forall a. (FilePath -> a) -> ReadE a
succeedReadE FilePath -> Flag FilePath
forall a. a -> Flag a
Flag) Flag FilePath -> LFlags
forall a. Flag a -> [a]
flagToList)
    , FilePath
-> LFlags
-> FilePath
-> (ProjectFlags -> Flag Bool)
-> (Flag Bool -> ProjectFlags -> ProjectFlags)
-> MkOptDescr
     (ProjectFlags -> Flag Bool)
     (Flag Bool -> ProjectFlags -> ProjectFlags)
     ProjectFlags
-> OptionField ProjectFlags
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 Flag Bool -> Flag Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Flag Bool
forall a. Flag a
NoFlag then Flag Bool
forall a. Flag a
NoFlag else Bool -> Flag Bool
forall a. a -> Flag a
toFlag ((ProjectFlags -> Flag FilePath
flagProjectFileName ProjectFlags
flags) Flag FilePath -> Flag FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Flag FilePath
forall a. Flag a
NoFlag Bool -> Bool -> Bool
&& Flag Bool
v Flag Bool -> Flag Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
True) })
        (ShowOrParseArgs
-> MkOptDescr
     (ProjectFlags -> Flag Bool)
     (Flag Bool -> ProjectFlags -> ProjectFlags)
     ProjectFlags
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 :: [OptionField a] -> [OptionField a]
removeIgnoreProjectOption = (OptionField a -> Bool) -> [OptionField a] -> [OptionField a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\OptionField a
o -> OptionField a -> FilePath
forall a. OptionField a -> FilePath
optionName OptionField a
o FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"ignore-project")

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

instance Semigroup ProjectFlags where
    <> :: ProjectFlags -> ProjectFlags -> ProjectFlags
(<>) = 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 :: ShowOrParseArgs
-> MkOptDescr (b -> Flag Bool) (Flag Bool -> b -> b) b
yesNoOpt ShowOrParseArgs
ShowArgs FilePath
sf LFlags
lf = MkOptDescr (b -> Flag Bool) (Flag Bool -> b -> b) b
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg FilePath
sf LFlags
lf
yesNoOpt ShowOrParseArgs
_        FilePath
sf LFlags
lf = (Flag Bool -> Maybe Bool)
-> (Bool -> Flag Bool)
-> OptFlags
-> OptFlags
-> MkOptDescr (b -> Flag Bool) (Flag Bool -> b -> b) b
forall b a.
(b -> Maybe Bool)
-> (Bool -> b)
-> OptFlags
-> OptFlags
-> MkOptDescr (a -> b) (b -> a -> a) a
boolOpt' Flag Bool -> Maybe Bool
forall a. Flag a -> Maybe a
flagToMaybe Bool -> Flag Bool
forall a. a -> Flag a
Flag (FilePath
sf, LFlags
lf) ([], ShowS -> LFlags -> LFlags
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"no-" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++) LFlags
lf) FilePath
sf LFlags
lf