-- | Types and functions related to HIndent's commandline options.
module HIndent.CommandlineOptions
  ( Action(..)
  , RunMode(..)
  , options
  ) where

import Data.Maybe
import HIndent.Config
import HIndent.LanguageExtension
import HIndent.LanguageExtension.Types
import Options.Applicative hiding (action, style)

-- | HIndent actions.
data Action
  = Validate -- ^ Validate if the code is formatted.
  | Reformat -- ^ Format the code.

-- | HIndent running mode.
data RunMode
  = ShowVersion -- ^ Show HIndent's version.
  | Run Config [Extension] Action [FilePath] -- ^ Format or validate the code.

-- | Program options.
options :: Config -> Parser RunMode
options :: Config -> Parser RunMode
options Config
config =
  RunMode -> Mod FlagFields RunMode -> Parser RunMode
forall a. a -> Mod FlagFields a -> Parser a
flag' RunMode
ShowVersion (String -> Mod FlagFields RunMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" Mod FlagFields RunMode
-> Mod FlagFields RunMode -> Mod FlagFields RunMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields RunMode
forall (f :: * -> *) a. String -> Mod f a
help String
"Print the version")
    Parser RunMode -> Parser RunMode -> Parser RunMode
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Config -> [Extension] -> Action -> [String] -> RunMode
Run (Config -> [Extension] -> Action -> [String] -> RunMode)
-> Parser Config
-> Parser ([Extension] -> Action -> [String] -> RunMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Config
style Parser ([Extension] -> Action -> [String] -> RunMode)
-> Parser [Extension] -> Parser (Action -> [String] -> RunMode)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Extension]
exts Parser (Action -> [String] -> RunMode)
-> Parser Action -> Parser ([String] -> RunMode)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Action
action Parser ([String] -> RunMode) -> Parser [String] -> Parser RunMode
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [String]
files)
  where
    style :: Parser Config
style =
      (Config -> Int64 -> Int64 -> Bool -> Maybe Bool -> Config
makeStyle Config
config
         (Int64 -> Int64 -> Bool -> Maybe Bool -> Config)
-> Parser Int64 -> Parser (Int64 -> Bool -> Maybe Bool -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int64
lineLen
         Parser (Int64 -> Bool -> Maybe Bool -> Config)
-> Parser Int64 -> Parser (Bool -> Maybe Bool -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int64
indentSpaces
         Parser (Bool -> Maybe Bool -> Config)
-> Parser Bool -> Parser (Maybe Bool -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
trailingNewline
         Parser (Maybe Bool -> Config)
-> Parser (Maybe Bool) -> Parser Config
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Bool)
sortImports)
        Parser Config -> Parser (Maybe String) -> Parser Config
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
             (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"style"
                   Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Style to print with (historical, now ignored)"
                   Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STYLE") :: Parser String)
    exts :: Parser [Extension]
exts =
      ([String] -> [Extension]) -> Parser [String] -> Parser [Extension]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        [String] -> [Extension]
getExtensions
        (Parser String -> Parser [String]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
           (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              (Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'X' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Language extension" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"GHCEXT")))
    indentSpaces :: Parser Int64
indentSpaces =
      ReadM Int64 -> Mod OptionFields Int64 -> Parser Int64
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
        ReadM Int64
forall a. Read a => ReadM a
auto
        (String -> Mod OptionFields Int64
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"indent-size"
           Mod OptionFields Int64
-> Mod OptionFields Int64 -> Mod OptionFields Int64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int64
forall (f :: * -> *) a. String -> Mod f a
help String
"Indentation size in spaces"
           Mod OptionFields Int64
-> Mod OptionFields Int64 -> Mod OptionFields Int64
forall a. Semigroup a => a -> a -> a
<> Int64 -> Mod OptionFields Int64
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (Config -> Int64
configIndentSpaces Config
config)
           Mod OptionFields Int64
-> Mod OptionFields Int64 -> Mod OptionFields Int64
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int64
forall a (f :: * -> *). Show a => Mod f a
showDefault)
        Parser Int64 -> Parser Int64 -> Parser Int64
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadM Int64 -> Mod OptionFields Int64 -> Parser Int64
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
              ReadM Int64
forall a. Read a => ReadM a
auto
              (String -> Mod OptionFields Int64
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"tab-size"
                 Mod OptionFields Int64
-> Mod OptionFields Int64 -> Mod OptionFields Int64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int64
forall (f :: * -> *) a. String -> Mod f a
help String
"Same as --indent-size, for compatibility")
    lineLen :: Parser Int64
lineLen =
      ReadM Int64 -> Mod OptionFields Int64 -> Parser Int64
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
        ReadM Int64
forall a. Read a => ReadM a
auto
        (String -> Mod OptionFields Int64
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"line-length"
           Mod OptionFields Int64
-> Mod OptionFields Int64 -> Mod OptionFields Int64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int64
forall (f :: * -> *) a. String -> Mod f a
help String
"Desired length of lines"
           Mod OptionFields Int64
-> Mod OptionFields Int64 -> Mod OptionFields Int64
forall a. Semigroup a => a -> a -> a
<> Int64 -> Mod OptionFields Int64
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (Config -> Int64
configMaxColumns Config
config)
           Mod OptionFields Int64
-> Mod OptionFields Int64 -> Mod OptionFields Int64
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int64
forall a (f :: * -> *). Show a => Mod f a
showDefault)
    trailingNewline :: Parser Bool
trailingNewline =
      Bool -> Bool
not
        (Bool -> Bool) -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
              (Bool -> Bool
not (Config -> Bool
configTrailingNewline Config
config))
              (Config -> Bool
configTrailingNewline Config
config)
              (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-force-newline"
                 Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Don't force a trailing newline"
                 Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall a (f :: * -> *). Show a => Mod f a
showDefault)
    sortImports :: Parser (Maybe Bool)
sortImports =
      Maybe Bool
-> Maybe Bool -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
        Maybe Bool
forall a. Maybe a
Nothing
        (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
        (String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"sort-imports" Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Sort imports in groups" Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields (Maybe Bool)
forall a (f :: * -> *). Show a => Mod f a
showDefault)
        Parser (Maybe Bool) -> Parser (Maybe Bool) -> Parser (Maybe Bool)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
-> Maybe Bool -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
              Maybe Bool
forall a. Maybe a
Nothing
              (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
              (String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-sort-imports" Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Don't sort imports")
    action :: Parser Action
action =
      Action -> Action -> Mod FlagFields Action -> Parser Action
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
        Action
Reformat
        Action
Validate
        (String -> Mod FlagFields Action
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"validate"
           Mod FlagFields Action
-> Mod FlagFields Action -> Mod FlagFields Action
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Action
forall (f :: * -> *) a. String -> Mod f a
help String
"Check if files are formatted without changing them")
    makeStyle :: Config -> Int64 -> Int64 -> Bool -> Maybe Bool -> Config
makeStyle Config
s Int64
mlen Int64
tabs Bool
trailing Maybe Bool
imports =
      Config
s
        { configMaxColumns = mlen
        , configIndentSpaces = tabs
        , configTrailingNewline = trailing
        , configSortImports = fromMaybe (configSortImports s) imports
        }
    files :: Parser [String]
files = Parser String -> Parser [String]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILENAMES"))