-- |
-- Module: Staversion.Internal.Command
-- Description: Command from the user.
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. End-users should not use it.__
module Staversion.Internal.Command
       ( Command(..),
         parseCommandArgs,
         defFormatConfig,
         _parseCommandStrings
       ) where

import Control.Applicative ((<$>), (<*>), optional, some, (<|>), many)
import Data.Function (on)
import Data.Monoid (mconcat, (<>))
import Data.Text (pack)
import qualified Options.Applicative as Opt
import qualified Paths_staversion as MyInfo
import System.Directory (getHomeDirectory)
import System.FilePath ((</>))
import qualified Text.PrettyPrint.ANSI.Leijen as Pretty

import Staversion.Internal.Aggregate (Aggregator)
import qualified Staversion.Internal.Aggregate as Agg
import Staversion.Internal.Format (FormatConfig(..), FormatVersion)
import qualified Staversion.Internal.Format as Format
import Staversion.Internal.Log
  ( LogLevel(..), Logger(loggerThreshold), defaultLogger
  )
import Staversion.Internal.Query
  ( Resolver,
    PackageName,
    Query(..),
    parseQuery,
    PackageSource(..)
  )
import Staversion.Internal.Version (showBaseVersion)

-- | Command from the user.
data Command =
  Command { Command -> FilePath
commBuildPlanDir :: FilePath,
            -- ^ path to the directory where build plan files are stored.
            Command -> FilePath
commStackCommand :: String,
            -- ^ shell command to invoke @stack@ tool.
            Command -> Logger
commLogger :: Logger,
            -- ^ the logger
            Command -> [PackageSource]
commSources :: [PackageSource],
            -- ^ package sources to search
            Command -> [Query]
commQueries :: [Query],
            -- ^ package queries
            Command -> Bool
commAllowNetwork :: Bool,
            -- ^ if 'True', it accesses the Internet to query build plans etc.
            Command -> Maybe Aggregator
commAggregator :: Maybe Aggregator,
            -- ^ if 'Just', do aggregation over the results.
            Command -> FormatConfig
commFormatConfig :: FormatConfig
            -- ^ config for the formatter
          }

-- | Default values for 'Command'.
data DefCommand = DefCommand { DefCommand -> FilePath
defBuildPlanDir :: FilePath
                             } deriving (Int -> DefCommand -> ShowS
[DefCommand] -> ShowS
DefCommand -> FilePath
(Int -> DefCommand -> ShowS)
-> (DefCommand -> FilePath)
-> ([DefCommand] -> ShowS)
-> Show DefCommand
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DefCommand] -> ShowS
$cshowList :: [DefCommand] -> ShowS
show :: DefCommand -> FilePath
$cshow :: DefCommand -> FilePath
showsPrec :: Int -> DefCommand -> ShowS
$cshowsPrec :: Int -> DefCommand -> ShowS
Show,DefCommand -> DefCommand -> Bool
(DefCommand -> DefCommand -> Bool)
-> (DefCommand -> DefCommand -> Bool) -> Eq DefCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefCommand -> DefCommand -> Bool
$c/= :: DefCommand -> DefCommand -> Bool
== :: DefCommand -> DefCommand -> Bool
$c== :: DefCommand -> DefCommand -> Bool
Eq,Eq DefCommand
Eq DefCommand
-> (DefCommand -> DefCommand -> Ordering)
-> (DefCommand -> DefCommand -> Bool)
-> (DefCommand -> DefCommand -> Bool)
-> (DefCommand -> DefCommand -> Bool)
-> (DefCommand -> DefCommand -> Bool)
-> (DefCommand -> DefCommand -> DefCommand)
-> (DefCommand -> DefCommand -> DefCommand)
-> Ord DefCommand
DefCommand -> DefCommand -> Bool
DefCommand -> DefCommand -> Ordering
DefCommand -> DefCommand -> DefCommand
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DefCommand -> DefCommand -> DefCommand
$cmin :: DefCommand -> DefCommand -> DefCommand
max :: DefCommand -> DefCommand -> DefCommand
$cmax :: DefCommand -> DefCommand -> DefCommand
>= :: DefCommand -> DefCommand -> Bool
$c>= :: DefCommand -> DefCommand -> Bool
> :: DefCommand -> DefCommand -> Bool
$c> :: DefCommand -> DefCommand -> Bool
<= :: DefCommand -> DefCommand -> Bool
$c<= :: DefCommand -> DefCommand -> Bool
< :: DefCommand -> DefCommand -> Bool
$c< :: DefCommand -> DefCommand -> Bool
compare :: DefCommand -> DefCommand -> Ordering
$ccompare :: DefCommand -> DefCommand -> Ordering
$cp1Ord :: Eq DefCommand
Ord)

defCommand :: IO DefCommand
defCommand :: IO DefCommand
defCommand = FilePath -> DefCommand
DefCommand (FilePath -> DefCommand) -> IO FilePath -> IO DefCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
def_build_plan_dir where
  def_build_plan_dir :: IO FilePath
def_build_plan_dir = do
    FilePath
home <- IO FilePath
getHomeDirectory
    FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
home FilePath -> ShowS
</> FilePath
".stack" FilePath -> ShowS
</> FilePath
"build-plan"

commandParser :: DefCommand -> Opt.Parser Command
commandParser :: DefCommand -> Parser Command
commandParser DefCommand
def_comm = FilePath
-> FilePath
-> Logger
-> [PackageSource]
-> [Query]
-> Bool
-> Maybe Aggregator
-> FormatConfig
-> Command
Command (FilePath
 -> FilePath
 -> Logger
 -> [PackageSource]
 -> [Query]
 -> Bool
 -> Maybe Aggregator
 -> FormatConfig
 -> Command)
-> Parser FilePath
-> Parser
     (FilePath
      -> Logger
      -> [PackageSource]
      -> [Query]
      -> Bool
      -> Maybe Aggregator
      -> FormatConfig
      -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
build_plan_dir Parser
  (FilePath
   -> Logger
   -> [PackageSource]
   -> [Query]
   -> Bool
   -> Maybe Aggregator
   -> FormatConfig
   -> Command)
-> Parser FilePath
-> Parser
     (Logger
      -> [PackageSource]
      -> [Query]
      -> Bool
      -> Maybe Aggregator
      -> FormatConfig
      -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath
stack_command Parser
  (Logger
   -> [PackageSource]
   -> [Query]
   -> Bool
   -> Maybe Aggregator
   -> FormatConfig
   -> Command)
-> Parser Logger
-> Parser
     ([PackageSource]
      -> [Query] -> Bool -> Maybe Aggregator -> FormatConfig -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Logger
logger Parser
  ([PackageSource]
   -> [Query] -> Bool -> Maybe Aggregator -> FormatConfig -> Command)
-> Parser [PackageSource]
-> Parser
     ([Query] -> Bool -> Maybe Aggregator -> FormatConfig -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [PackageSource]
sources
                         Parser
  ([Query] -> Bool -> Maybe Aggregator -> FormatConfig -> Command)
-> Parser [Query]
-> Parser (Bool -> Maybe Aggregator -> FormatConfig -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Query]
queries Parser (Bool -> Maybe Aggregator -> FormatConfig -> Command)
-> Parser Bool
-> Parser (Maybe Aggregator -> FormatConfig -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
network Parser (Maybe Aggregator -> FormatConfig -> Command)
-> Parser (Maybe Aggregator) -> Parser (FormatConfig -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Aggregator)
aggregate Parser (FormatConfig -> Command)
-> Parser FormatConfig -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FormatConfig
format_config where
  logger :: Parser Logger
logger = Bool -> Logger
makeLogger (Bool -> Logger) -> Parser Bool -> Parser Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
is_verbose
  makeLogger :: Bool -> Logger
makeLogger Bool
True = Logger
defaultLogger { loggerThreshold :: Maybe LogLevel
loggerThreshold = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LogDebug }
  makeLogger Bool
False = Logger
defaultLogger
  is_verbose :: Parser Bool
is_verbose = Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"verbose",
                                      Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'v',
                                      FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Verbose messages."
                                    ]
  build_plan_dir :: Parser FilePath
build_plan_dir = Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
                   (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"build-plan-dir",
                               FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Directory where build plan YAML files are stored.",
                               FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"DIR",
                               FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value (DefCommand -> FilePath
defBuildPlanDir DefCommand
def_comm),
                               Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
                             ]
  withDefault :: Functor m => [a] -> m [a] -> m [a]
  withDefault :: [a] -> m [a] -> m [a]
withDefault [a]
def_vals = ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
applyDef
    where
      applyDef :: [a] -> [a]
applyDef [] = [a]
def_vals
      applyDef [a]
vs = [a]
vs
  sources :: Parser [PackageSource]
sources = [PackageSource] -> Parser [PackageSource] -> Parser [PackageSource]
forall (m :: * -> *) a. Functor m => [a] -> m [a] -> m [a]
withDefault [PackageSource
SourceStackDefault] (Parser [PackageSource] -> Parser [PackageSource])
-> Parser [PackageSource] -> Parser [PackageSource]
forall a b. (a -> b) -> a -> b
$ Parser PackageSource -> Parser [PackageSource]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser PackageSource -> Parser [PackageSource])
-> Parser PackageSource -> Parser [PackageSource]
forall a b. (a -> b) -> a -> b
$ Parser PackageSource
resolver Parser PackageSource
-> Parser PackageSource -> Parser PackageSource
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser PackageSource
hackage Parser PackageSource
-> Parser PackageSource -> Parser PackageSource
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser PackageSource
stack_explicit Parser PackageSource
-> Parser PackageSource -> Parser PackageSource
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser PackageSource
stack_default
  resolver :: Parser PackageSource
resolver = (FilePath -> PackageSource)
-> Parser FilePath -> Parser PackageSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> PackageSource
SourceStackage (Parser FilePath -> Parser PackageSource)
-> Parser FilePath -> Parser PackageSource
forall a b. (a -> b) -> a -> b
$ Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
             (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"resolver",
                         Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'r',
                         FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Stackage resolver to search. e.g. \"lts-6.15\"",
                         FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"RESOLVER_NAME"
                       ]
  hackage :: Parser PackageSource
hackage = PackageSource
-> Mod FlagFields PackageSource -> Parser PackageSource
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' PackageSource
SourceHackage
            (Mod FlagFields PackageSource -> Parser PackageSource)
-> Mod FlagFields PackageSource -> Parser PackageSource
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields PackageSource] -> Mod FlagFields PackageSource
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod FlagFields PackageSource
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"hackage",
                        Char -> Mod FlagFields PackageSource
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'H',
                        FilePath -> Mod FlagFields PackageSource
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Search hackage.org for the latest version."
                      ]
  stack_explicit :: Parser PackageSource
stack_explicit = (FilePath -> PackageSource)
-> Parser FilePath -> Parser PackageSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> PackageSource
SourceStackYaml (Parser FilePath -> Parser PackageSource)
-> Parser FilePath -> Parser PackageSource
forall a b. (a -> b) -> a -> b
$ Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
                   (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"stack",
                               FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help ( FilePath
"Path to stack.yaml file."
                                          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" It searches for package versions of the resolver of the specified stack.yaml file."
                                        ),
                               FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"FILE"
                             ]
  stack_default :: Parser PackageSource
stack_default = PackageSource
-> Mod FlagFields PackageSource -> Parser PackageSource
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' PackageSource
SourceStackDefault
                  (Mod FlagFields PackageSource -> Parser PackageSource)
-> Mod FlagFields PackageSource -> Parser PackageSource
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields PackageSource] -> Mod FlagFields PackageSource
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod FlagFields PackageSource
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"stack-default",
                              Char -> Mod FlagFields PackageSource
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'S',
                              FilePath -> Mod FlagFields PackageSource
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help ( FilePath
"Search the resolver that 'stack' command would use by default."
                                         FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" This option is implied if there is no options about package source (e.g. -r and -H)."
                                       )
                            ]
  queries :: Parser [Query]
queries = [Query] -> Parser [Query] -> Parser [Query]
forall (m :: * -> *) a. Functor m => [a] -> m [a] -> m [a]
withDefault [Query
QueryStackYamlDefault] (Parser [Query] -> Parser [Query])
-> Parser [Query] -> Parser [Query]
forall a b. (a -> b) -> a -> b
$ Parser Query -> Parser [Query]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Query -> Parser [Query]) -> Parser Query -> Parser [Query]
forall a b. (a -> b) -> a -> b
$ FilePath -> Query
parseQuery (FilePath -> Query) -> Parser FilePath -> Parser Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser FilePath
query_package Parser FilePath -> Parser FilePath -> Parser FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser FilePath
query_cabal Parser FilePath -> Parser FilePath -> Parser FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser FilePath
query_stack_yaml)
  query_package :: Parser FilePath
query_package = Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
Opt.strArgument
                  (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod ArgumentFields FilePath] -> Mod ArgumentFields FilePath
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Name of package whose version you want to check.",
                              FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"PACKAGE_NAME"
                            ]
  query_cabal :: Parser FilePath
query_cabal = Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
Opt.strArgument
                (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod ArgumentFields FilePath] -> Mod ArgumentFields FilePath
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
".cabal file name. It checks versions of packages in build-deps lists.",
                            FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"CABAL_FILEPATH"
                          ]
  query_stack_yaml :: Parser FilePath
query_stack_yaml = Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
Opt.strArgument
                     (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod ArgumentFields FilePath] -> Mod ArgumentFields FilePath
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help ( FilePath
"Path to stack.yaml file."
                                            FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" It checks versions of packages in build-deps of all cabal projects listed in the stack.yaml."
                                            FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" If you just type 'stack.yaml',"
                                            FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" it means the default configuration that 'stack' command would use by default."
                                            FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" 'stack.yaml' is implied if there is no query argument."
                                          ),
                                 FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"STACK_YAML_FILEPATH"
                               ]
  network :: Parser Bool
network = Bool -> Bool
not (Bool -> Bool) -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
no_network
  no_network :: Parser Bool
no_network = Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"no-network",
                                      FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Forbid network access."
                                    ]
  aggregate :: Parser (Maybe Aggregator)
aggregate = Parser Aggregator -> Parser (Maybe Aggregator)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Aggregator -> Parser (Maybe Aggregator))
-> Parser Aggregator -> Parser (Maybe Aggregator)
forall a b. (a -> b) -> a -> b
$ ReadM Aggregator
-> Mod OptionFields Aggregator -> Parser Aggregator
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (FilePath -> (FilePath -> Maybe Aggregator) -> ReadM Aggregator
forall a. FilePath -> (FilePath -> Maybe a) -> ReadM a
maybeReader FilePath
"AGGREGATOR" FilePath -> Maybe Aggregator
parseAggregator)
              (Mod OptionFields Aggregator -> Parser Aggregator)
-> Mod OptionFields Aggregator -> Parser Aggregator
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields Aggregator] -> Mod OptionFields Aggregator
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod OptionFields Aggregator
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"aggregate",
                          Char -> Mod OptionFields Aggregator
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'a',
                          FilePath -> Mod OptionFields Aggregator
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"AGGREGATOR",
                          Maybe Doc -> Mod OptionFields Aggregator
forall (f :: * -> *) a. Maybe Doc -> Mod f a
Opt.helpDoc (Maybe Doc -> Mod OptionFields Aggregator)
-> Maybe Doc -> Mod OptionFields Aggregator
forall a b. (a -> b) -> a -> b
$ Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
docAggregators FilePath
"AGGREGATOR"
                        ]
  format_config :: Parser FormatConfig
format_config = FormatVersion -> FormatConfig
FormatConfig (FormatVersion -> FormatConfig)
-> Parser FormatVersion -> Parser FormatConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FormatVersion
format_version
  format_version :: Parser FormatVersion
format_version = ReadM FormatVersion
-> Mod OptionFields FormatVersion -> Parser FormatVersion
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (FilePath
-> (FilePath -> Maybe FormatVersion) -> ReadM FormatVersion
forall a. FilePath -> (FilePath -> Maybe a) -> ReadM a
maybeReader FilePath
"FORMAT" ((FilePath -> Maybe FormatVersion) -> ReadM FormatVersion)
-> (FilePath -> Maybe FormatVersion) -> ReadM FormatVersion
forall a b. (a -> b) -> a -> b
$ [SelectSpec FormatVersion] -> FilePath -> Maybe FormatVersion
forall a. [SelectSpec a] -> FilePath -> Maybe a
parseSelect [SelectSpec FormatVersion]
formatVersions)
                   (Mod OptionFields FormatVersion -> Parser FormatVersion)
-> Mod OptionFields FormatVersion -> Parser FormatVersion
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FormatVersion] -> Mod OptionFields FormatVersion
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod OptionFields FormatVersion
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"format-version",
                               FilePath -> Mod OptionFields FormatVersion
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"FORMAT",
                               Maybe Doc -> Mod OptionFields FormatVersion
forall (f :: * -> *) a. Maybe Doc -> Mod f a
Opt.helpDoc (Maybe Doc -> Mod OptionFields FormatVersion)
-> Maybe Doc -> Mod OptionFields FormatVersion
forall a b. (a -> b) -> a -> b
$ Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
docFormatVersions FilePath
"FORMAT",
                               FormatVersion -> Mod OptionFields FormatVersion
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value (FormatVersion -> Mod OptionFields FormatVersion)
-> FormatVersion -> Mod OptionFields FormatVersion
forall a b. (a -> b) -> a -> b
$ FormatConfig -> FormatVersion
fconfFormatVersion FormatConfig
defFormatConfig
                             ]
  stack_command :: Parser FilePath
stack_command = Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
                  (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"stack-command",
                              FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Shell command for stack tool.",
                              FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"COMMAND",
                              FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value FilePath
"stack",
                              Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
                            ]

maybeReader :: String -> (String -> Maybe a) -> Opt.ReadM a
maybeReader :: FilePath -> (FilePath -> Maybe a) -> ReadM a
maybeReader FilePath
metavar FilePath -> Maybe a
mfunc = do
  FilePath
got <- ReadM FilePath
forall s. IsString s => ReadM s
Opt.str
  case FilePath -> Maybe a
mfunc FilePath
got of
   Maybe a
Nothing -> FilePath -> ReadM a
forall a. FilePath -> ReadM a
Opt.readerError (FilePath
"Unknown " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
metavar FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
got)
   Just a
v -> a -> ReadM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v


data SelectSpec a = SelectSpec { SelectSpec a -> a
selectResult :: a,
                                 SelectSpec a -> FilePath
selectSymbol :: String,
                                 SelectSpec a -> FilePath
selectDesc :: String
                               }

type AggregatorSpec = SelectSpec Aggregator

aggregators :: [AggregatorSpec]
aggregators :: [AggregatorSpec]
aggregators = [ Aggregator -> FilePath -> FilePath -> AggregatorSpec
forall a. a -> FilePath -> FilePath -> SelectSpec a
SelectSpec Aggregator
Agg.aggOr FilePath
"or" FilePath
"concatenate versions with (||).",
                Aggregator -> FilePath -> FilePath -> AggregatorSpec
forall a. a -> FilePath -> FilePath -> SelectSpec a
SelectSpec Aggregator
Agg.aggPvpMajor FilePath
"pvp-major"
                ( FilePath
"aggregate versions to a range that is supposed to be "
                  FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"compatible with the given versions "
                  FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"in terms of PVP (Package Versioning Policy.) "
                  FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"Major versions are used for upper bounds."
                ),
                Aggregator -> FilePath -> FilePath -> AggregatorSpec
forall a. a -> FilePath -> FilePath -> SelectSpec a
SelectSpec Aggregator
Agg.aggPvpMajor FilePath
"pvp" FilePath
"alias for 'pvp-major'",
                Aggregator -> FilePath -> FilePath -> AggregatorSpec
forall a. a -> FilePath -> FilePath -> SelectSpec a
SelectSpec Aggregator
Agg.aggPvpMinor FilePath
"pvp-minor"
                ( FilePath
"aggregate versions to a range that is supposed to be "
                  FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"compatible with the given versions "
                  FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"in terms of PVP. "
                  FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"Minor versions are used for upper bounds, i.e. this is stricter than 'pvp-major'."
                )
              ]

parseSelect :: [SelectSpec a] -> String -> Maybe a
parseSelect :: [SelectSpec a] -> FilePath -> Maybe a
parseSelect [SelectSpec a]
specs FilePath
symbol = [SelectSpec a] -> Maybe a
forall a. [SelectSpec a] -> Maybe a
toMaybe ([SelectSpec a] -> Maybe a) -> [SelectSpec a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ (SelectSpec a -> Bool) -> [SelectSpec a] -> [SelectSpec a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SelectSpec a
spec -> SelectSpec a -> FilePath
forall a. SelectSpec a -> FilePath
selectSymbol SelectSpec a
spec FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
symbol) [SelectSpec a]
specs where
  toMaybe :: [SelectSpec a] -> Maybe a
toMaybe [] = Maybe a
forall a. Maybe a
Nothing
  toMaybe (SelectSpec a
spec : [SelectSpec a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ SelectSpec a -> a
forall a. SelectSpec a -> a
selectResult SelectSpec a
spec

parseAggregator :: String -> Maybe Aggregator
parseAggregator :: FilePath -> Maybe Aggregator
parseAggregator = [AggregatorSpec] -> FilePath -> Maybe Aggregator
forall a. [SelectSpec a] -> FilePath -> Maybe a
parseSelect [AggregatorSpec]
aggregators

wrapped :: String -> Pretty.Doc
wrapped :: FilePath -> Doc
wrapped = [Doc] -> Doc
Pretty.fillSep ([Doc] -> Doc) -> (FilePath -> [Doc]) -> FilePath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Doc) -> [FilePath] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Doc
Pretty.text ([FilePath] -> [Doc])
-> (FilePath -> [FilePath]) -> FilePath -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words

docSelect :: [SelectSpec a] -> String -> String -> Pretty.Doc
docSelect :: [SelectSpec a] -> FilePath -> FilePath -> Doc
docSelect [SelectSpec a]
specs FilePath
foreword_str FilePath
metavar = [Doc] -> Doc
Pretty.vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc
foreword  Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:) ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (SelectSpec a -> Doc) -> [SelectSpec a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SelectSpec a -> Doc
forall a. SelectSpec a -> Doc
docSpec [SelectSpec a]
specs where
  foreword :: Doc
foreword = FilePath -> Doc
wrapped ( FilePath
foreword_str FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" Possible " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
metavar FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" is:" )
  docSpec :: SelectSpec a -> Doc
docSpec SelectSpec {selectSymbol :: forall a. SelectSpec a -> FilePath
selectSymbol = FilePath
symbol, selectDesc :: forall a. SelectSpec a -> FilePath
selectDesc = FilePath
desc} =
    Int -> Doc -> Doc
Pretty.hang Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
wrapped (FilePath
symbol FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
": " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
desc)

docSelectWithDefault :: [SelectSpec a] -> String -> String -> Pretty.Doc
docSelectWithDefault :: [SelectSpec a] -> FilePath -> FilePath -> Doc
docSelectWithDefault [] FilePath
foreword FilePath
metavar = [SelectSpec Any] -> FilePath -> FilePath -> Doc
forall a. [SelectSpec a] -> FilePath -> FilePath -> Doc
docSelect [] FilePath
foreword FilePath
metavar where
docSelectWithDefault (SelectSpec a
def_spec : [SelectSpec a]
rest) FilePath
foreword FilePath
metavar = [SelectSpec a] -> FilePath -> FilePath -> Doc
forall a. [SelectSpec a] -> FilePath -> FilePath -> Doc
docSelect (SelectSpec a
def_spec' SelectSpec a -> [SelectSpec a] -> [SelectSpec a]
forall a. a -> [a] -> [a]
: [SelectSpec a]
rest) FilePath
foreword FilePath
metavar where
  def_spec' :: SelectSpec a
def_spec' = SelectSpec a
def_spec { selectSymbol :: FilePath
selectSymbol = SelectSpec a -> FilePath
forall a. SelectSpec a -> FilePath
selectSymbol SelectSpec a
def_spec FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" [DEFAULT]" }
  

docAggregators :: String -> Pretty.Doc
docAggregators :: FilePath -> Doc
docAggregators = [AggregatorSpec] -> FilePath -> FilePath -> Doc
forall a. [SelectSpec a] -> FilePath -> FilePath -> Doc
docSelect [AggregatorSpec]
aggregators FilePath
"Aggregate version results over different resolvers."


defFormatConfig :: FormatConfig
defFormatConfig :: FormatConfig
defFormatConfig = FormatConfig :: FormatVersion -> FormatConfig
FormatConfig { fconfFormatVersion :: FormatVersion
fconfFormatVersion = SelectSpec FormatVersion -> FormatVersion
forall a. SelectSpec a -> a
selectResult (SelectSpec FormatVersion -> FormatVersion)
-> SelectSpec FormatVersion -> FormatVersion
forall a b. (a -> b) -> a -> b
$ [SelectSpec FormatVersion] -> SelectSpec FormatVersion
forall a. [a] -> a
head [SelectSpec FormatVersion]
formatVersions
                               }

formatVersions :: [SelectSpec FormatVersion]
formatVersions :: [SelectSpec FormatVersion]
formatVersions = [ FormatVersion -> FilePath -> FilePath -> SelectSpec FormatVersion
forall a. a -> FilePath -> FilePath -> SelectSpec a
SelectSpec FormatVersion
Format.formatVersionCabal FilePath
"cabal"
                   ( FilePath
"Let Cabal format VersionRanges"
                   ),
                   FormatVersion -> FilePath -> FilePath -> SelectSpec FormatVersion
forall a. a -> FilePath -> FilePath -> SelectSpec a
SelectSpec FormatVersion
Format.formatVersionCabalCaret FilePath
"cabal-caret"
                   ( FilePath
"Similar to 'cabal', but it uses the caret operator (^>=) if possible"
                   )
                 ]


docFormatVersions :: String -> Pretty.Doc
docFormatVersions :: FilePath -> Doc
docFormatVersions = [SelectSpec FormatVersion] -> FilePath -> FilePath -> Doc
forall a. [SelectSpec a] -> FilePath -> FilePath -> Doc
docSelectWithDefault [SelectSpec FormatVersion]
formatVersions FilePath
"Format for package version ranges."

programDescription :: Opt.Parser a -> Opt.ParserInfo a
programDescription :: Parser a -> ParserInfo a
programDescription Parser a
parser =
  Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (Parser (a -> a)
forall a. Parser (a -> a)
Opt.helper Parser (a -> a) -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
parser)
  (InfoMod a -> ParserInfo a) -> InfoMod a -> ParserInfo a
forall a b. (a -> b) -> a -> b
$ [InfoMod a] -> InfoMod a
forall a. Monoid a => [a] -> a
mconcat [ InfoMod a
forall a. InfoMod a
Opt.fullDesc,
              FilePath -> InfoMod a
forall a. FilePath -> InfoMod a
Opt.progDesc ( FilePath
"Look for version numbers for Haskell packages in specific stackage resolvers"
                             FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" (or possibly other package sources)"
                           ),
              FilePath -> InfoMod a
forall a. FilePath -> InfoMod a
Opt.footer (FilePath
"Version: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (BaseVersion -> FilePath
showBaseVersion BaseVersion
MyInfo.version))
            ]

parseCommandArgs :: IO Command
parseCommandArgs :: IO Command
parseCommandArgs = ParserInfo Command -> IO Command
forall a. ParserInfo a -> IO a
Opt.execParser (ParserInfo Command -> IO Command)
-> (DefCommand -> ParserInfo Command) -> DefCommand -> IO Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Command -> ParserInfo Command
forall a. Parser a -> ParserInfo a
programDescription (Parser Command -> ParserInfo Command)
-> (DefCommand -> Parser Command)
-> DefCommand
-> ParserInfo Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefCommand -> Parser Command
commandParser (DefCommand -> IO Command) -> IO DefCommand -> IO Command
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO DefCommand
defCommand

-- | Just for testing.
_parseCommandStrings :: [String] -> IO (Maybe Command)
_parseCommandStrings :: [FilePath] -> IO (Maybe Command)
_parseCommandStrings [FilePath]
args = (DefCommand -> Maybe Command)
-> IO DefCommand -> IO (Maybe Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParserInfo Command -> Maybe Command
forall a. ParserInfo a -> Maybe a
doParse (ParserInfo Command -> Maybe Command)
-> (DefCommand -> ParserInfo Command)
-> DefCommand
-> Maybe Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Command -> ParserInfo Command
forall a. Parser a -> ParserInfo a
programDescription (Parser Command -> ParserInfo Command)
-> (DefCommand -> Parser Command)
-> DefCommand
-> ParserInfo Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefCommand -> Parser Command
commandParser) IO DefCommand
defCommand
  where
    doParse :: ParserInfo a -> Maybe a
doParse ParserInfo a
pinfo = ParserResult a -> Maybe a
forall a. ParserResult a -> Maybe a
Opt.getParseResult (ParserResult a -> Maybe a) -> ParserResult a -> Maybe a
forall a b. (a -> b) -> a -> b
$ ParserPrefs -> ParserInfo a -> [FilePath] -> ParserResult a
forall a.
ParserPrefs -> ParserInfo a -> [FilePath] -> ParserResult a
Opt.execParserPure ParserPrefs
prefs ParserInfo a
pinfo [FilePath]
args
    prefs :: ParserPrefs
prefs = PrefsMod -> ParserPrefs
Opt.prefs PrefsMod
forall a. Monoid a => a
mempty