{-# LANGUAGE LambdaCase #-}

module Restyler.Options
    ( Options(..)
    , HasOptions(..)
    , parseOptions
    )
where

import Restyler.Prelude

import qualified Env
import GitHub.Data (IssueNumber, Owner, Repo)
import Options.Applicative
import Restyler.PullRequestSpec
import System.Console.ANSI (hSupportsANSI)

data ColorOption
    = AlwaysColor
    | NeverColor
    | AutoColor

data EnvOptions = EnvOptions
    { EnvOptions -> Text
eoAccessToken :: Text
    , EnvOptions -> LogLevel
eoLogLevel :: LogLevel
    , EnvOptions -> Bool
eoUnrestricted :: Bool
    }

data CLIOptions = CLIOptions
    { CLIOptions -> ColorOption
coColor :: ColorOption
    , CLIOptions -> Maybe URL
coJobUrl :: Maybe URL
    , CLIOptions -> Maybe FilePath
coHostDirectory :: Maybe FilePath
    , CLIOptions -> PullRequestSpec
coPullRequestSpec :: PullRequestSpec
    }

data Options = Options
    { Options -> Text
oAccessToken :: Text
    -- ^ Personal or Installation access token
    , Options -> LogLevel
oLogLevel :: LogLevel
    , Options -> Bool
oLogColor :: Bool
    , Options -> Name Owner
oOwner :: Name Owner
    , Options -> Name Repo
oRepo :: Name Repo
    , Options -> IssueNumber
oPullRequest :: IssueNumber
    , Options -> Maybe URL
oJobUrl :: Maybe URL
    , Options -> Maybe FilePath
oHostDirectory :: Maybe FilePath
    , Options -> Bool
oUnrestricted :: Bool
    }

class HasOptions env where
    optionsL :: Lens' env Options

-- | Parse required environment variables and command-line options
--
-- See @restyler --help@
--
parseOptions :: IO Options
parseOptions :: IO Options
parseOptions = do
    EnvOptions {..} <- (Info Error -> Info Error)
-> Parser Error EnvOptions -> IO EnvOptions
forall e a. (Info Error -> Info e) -> Parser e a -> IO a
Env.parse Info Error -> Info Error
forall a. a -> a
id Parser Error EnvOptions
envParser
    CLIOptions {..} <-
        ParserInfo CLIOptions -> IO CLIOptions
forall a. ParserInfo a -> IO a
execParser (ParserInfo CLIOptions -> IO CLIOptions)
-> ParserInfo CLIOptions -> IO CLIOptions
forall a b. (a -> b) -> a -> b
$ Parser CLIOptions -> InfoMod CLIOptions -> ParserInfo CLIOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser CLIOptions
optionsParser Parser CLIOptions
-> Parser (CLIOptions -> CLIOptions) -> Parser CLIOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (CLIOptions -> CLIOptions)
forall a. Parser (a -> a)
helper) (InfoMod CLIOptions -> ParserInfo CLIOptions)
-> InfoMod CLIOptions -> ParserInfo CLIOptions
forall a b. (a -> b) -> a -> b
$ InfoMod CLIOptions
forall a. InfoMod a
fullDesc InfoMod CLIOptions -> InfoMod CLIOptions -> InfoMod CLIOptions
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod CLIOptions
forall a. FilePath -> InfoMod a
progDesc
            "Restyle a GitHub Pull Request"

    Bool
logColor <- case ColorOption
coColor of
        AlwaysColor -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        NeverColor -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        AutoColor -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> IO [Bool] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Handle -> IO Bool) -> [Handle] -> IO [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Handle -> IO Bool
hSupportsANSI [Handle
stdout, Handle
stderr]

    Options -> IO Options
forall (f :: * -> *) a. Applicative f => a -> f a
pure Options :: Text
-> LogLevel
-> Bool
-> Name Owner
-> Name Repo
-> IssueNumber
-> Maybe URL
-> Maybe FilePath
-> Bool
-> Options
Options
        { oAccessToken :: Text
oAccessToken = Text
eoAccessToken
        , oLogLevel :: LogLevel
oLogLevel = LogLevel
eoLogLevel
        , oLogColor :: Bool
oLogColor = Bool
logColor
        , oOwner :: Name Owner
oOwner = PullRequestSpec -> Name Owner
prsOwner PullRequestSpec
coPullRequestSpec
        , oRepo :: Name Repo
oRepo = PullRequestSpec -> Name Repo
prsRepo PullRequestSpec
coPullRequestSpec
        , oPullRequest :: IssueNumber
oPullRequest = PullRequestSpec -> IssueNumber
prsPullRequest PullRequestSpec
coPullRequestSpec
        , oJobUrl :: Maybe URL
oJobUrl = Maybe URL
coJobUrl
        , oHostDirectory :: Maybe FilePath
oHostDirectory = Maybe FilePath
coHostDirectory
        , oUnrestricted :: Bool
oUnrestricted = Bool
eoUnrestricted
        }

-- brittany-disable-next-binding
envParser :: Env.Parser Env.Error EnvOptions
envParser :: Parser Error EnvOptions
envParser = Text -> LogLevel -> Bool -> EnvOptions
EnvOptions
    (Text -> LogLevel -> Bool -> EnvOptions)
-> Parser Error Text
-> Parser Error (LogLevel -> Bool -> EnvOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader Error Text -> FilePath -> Mod Var Text -> Parser Error Text
forall e a.
AsUnset e =>
Reader e a -> FilePath -> Mod Var a -> Parser e a
Env.var (Reader Error Text
forall s e. IsString s => Reader e s
Env.str Reader Error Text
-> (FilePath -> Either Error FilePath) -> Reader Error Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FilePath -> Either Error FilePath
forall e s. (AsEmpty e, IsString s) => Reader e s
Env.nonempty) "GITHUB_ACCESS_TOKEN"
        (FilePath -> Mod Var Text
forall (t :: * -> *) a. HasHelp t => FilePath -> Mod t a
Env.help "GitHub access token with write access to the repository")
    Parser Error (LogLevel -> Bool -> EnvOptions)
-> Parser Error LogLevel -> Parser Error (Bool -> EnvOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LogLevel
-> LogLevel
-> FilePath
-> Mod Flag LogLevel
-> Parser Error LogLevel
forall a e. a -> a -> FilePath -> Mod Flag a -> Parser e a
Env.flag LogLevel
LevelInfo LogLevel
LevelDebug "DEBUG" Mod Flag LogLevel
forall (t :: * -> *) a. HasKeep t => Mod t a
Env.keep
    Parser Error (Bool -> EnvOptions)
-> Parser Error Bool -> Parser Error EnvOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> Mod Flag Bool -> Parser Error Bool
forall e. FilePath -> Mod Flag Bool -> Parser e Bool
Env.switch "UNRESTRICTED" Mod Flag Bool
forall (t :: * -> *) a. HasKeep t => Mod t a
Env.keep

-- brittany-disable-next-binding
optionsParser :: Parser CLIOptions
optionsParser :: Parser CLIOptions
optionsParser = ColorOption
-> Maybe URL -> Maybe FilePath -> PullRequestSpec -> CLIOptions
CLIOptions
    (ColorOption
 -> Maybe URL -> Maybe FilePath -> PullRequestSpec -> CLIOptions)
-> Parser ColorOption
-> Parser
     (Maybe URL -> Maybe FilePath -> PullRequestSpec -> CLIOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM ColorOption
-> Mod OptionFields ColorOption -> Parser ColorOption
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((FilePath -> Either FilePath ColorOption) -> ReadM ColorOption
forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader FilePath -> Either FilePath ColorOption
parseColorOption)
        (  FilePath -> Mod OptionFields ColorOption
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "color"
        Mod OptionFields ColorOption
-> Mod OptionFields ColorOption -> Mod OptionFields ColorOption
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields ColorOption
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "always|never|auto"
        Mod OptionFields ColorOption
-> Mod OptionFields ColorOption -> Mod OptionFields ColorOption
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields ColorOption
forall (f :: * -> *) a. FilePath -> Mod f a
help "Colorize log messages"
        Mod OptionFields ColorOption
-> Mod OptionFields ColorOption -> Mod OptionFields ColorOption
forall a. Semigroup a => a -> a -> a
<> ColorOption -> Mod OptionFields ColorOption
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value ColorOption
AutoColor
        )
    Parser
  (Maybe URL -> Maybe FilePath -> PullRequestSpec -> CLIOptions)
-> Parser (Maybe URL)
-> Parser (Maybe FilePath -> PullRequestSpec -> CLIOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser URL -> Parser (Maybe URL)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> URL
URL (Text -> URL) -> Parser Text -> Parser URL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (  FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "job-url"
        Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "URL"
        Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help "Link to Job on restyled.io"
        ))
    Parser (Maybe FilePath -> PullRequestSpec -> CLIOptions)
-> Parser (Maybe FilePath)
-> Parser (PullRequestSpec -> CLIOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (  FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "host-directory"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "PATH"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help "Path to host directory of sources"
        ))
    Parser (PullRequestSpec -> CLIOptions)
-> Parser PullRequestSpec -> Parser CLIOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM PullRequestSpec
-> Mod ArgumentFields PullRequestSpec -> Parser PullRequestSpec
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ((FilePath -> Either FilePath PullRequestSpec)
-> ReadM PullRequestSpec
forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader FilePath -> Either FilePath PullRequestSpec
parseSpec)
        (  FilePath -> Mod ArgumentFields PullRequestSpec
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "<owner>/<name>#<number>"
        Mod ArgumentFields PullRequestSpec
-> Mod ArgumentFields PullRequestSpec
-> Mod ArgumentFields PullRequestSpec
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields PullRequestSpec
forall (f :: * -> *) a. FilePath -> Mod f a
help "Repository and Pull Request to restyle"
        )

parseColorOption :: String -> Either String ColorOption
parseColorOption :: FilePath -> Either FilePath ColorOption
parseColorOption = \case
    "always" -> ColorOption -> Either FilePath ColorOption
forall a b. b -> Either a b
Right ColorOption
AlwaysColor
    "never" -> ColorOption -> Either FilePath ColorOption
forall a b. b -> Either a b
Right ColorOption
NeverColor
    "auto" -> ColorOption -> Either FilePath ColorOption
forall a b. b -> Either a b
Right ColorOption
AutoColor
    x :: FilePath
x -> FilePath -> Either FilePath ColorOption
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ColorOption)
-> FilePath -> Either FilePath ColorOption
forall a b. (a -> b) -> a -> b
$ "Invalid color option: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
x