{-# LANGUAGE ScopedTypeVariables #-}

module Tldr.App
  ( appMain
  ) where

import Data.List (intercalate)
import Data.Semigroup ((<>))
import Data.Version (showVersion)
import Options.Applicative
import Paths_tldr (version)
import System.Environment (getArgs)
import Tldr.App.Constant (platformDirs)
import Tldr.App.Handler
import Tldr.Types
import Control.Monad (void)

programOptions :: Parser TldrOpts
programOptions :: Parser TldrOpts
programOptions =
  TldrCommand -> Maybe Int -> Maybe ColorSetting -> TldrOpts
TldrOpts (TldrCommand -> Maybe Int -> Maybe ColorSetting -> TldrOpts)
-> Parser TldrCommand
-> Parser (Maybe Int -> Maybe ColorSetting -> TldrOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser TldrCommand
updateIndexCommand Parser TldrCommand -> Parser TldrCommand -> Parser TldrCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TldrCommand
viewPageCommand Parser TldrCommand -> Parser TldrCommand -> Parser TldrCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TldrCommand
aboutFlag) Parser (Maybe Int -> Maybe ColorSetting -> TldrOpts)
-> Parser (Maybe Int) -> Parser (Maybe ColorSetting -> TldrOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Int)
autoUpdateIntervalOpt Parser (Maybe ColorSetting -> TldrOpts)
-> Parser (Maybe ColorSetting) -> Parser TldrOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe ColorSetting)
colorFlags

updateIndexCommand :: Parser TldrCommand
updateIndexCommand :: Parser TldrCommand
updateIndexCommand =
  TldrCommand -> Mod FlagFields TldrCommand -> Parser TldrCommand
forall a. a -> Mod FlagFields a -> Parser a
flag'
    TldrCommand
UpdateIndex
    (String -> Mod FlagFields TldrCommand
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"update" Mod FlagFields TldrCommand
-> Mod FlagFields TldrCommand -> Mod FlagFields TldrCommand
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields TldrCommand
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u' Mod FlagFields TldrCommand
-> Mod FlagFields TldrCommand -> Mod FlagFields TldrCommand
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields TldrCommand
forall (f :: * -> *) a. String -> Mod f a
help String
"Update offline cache of tldr pages")

autoUpdateIntervalOpt :: Parser (Maybe Int)
autoUpdateIntervalOpt :: Parser (Maybe Int)
autoUpdateIntervalOpt =
  Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
    (ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto
       (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"auto-update-interval" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DAYS" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Perform an automatic update if the cache is older than DAYS"))

aboutFlag :: Parser TldrCommand
aboutFlag :: Parser TldrCommand
aboutFlag = TldrCommand -> Mod FlagFields TldrCommand -> Parser TldrCommand
forall a. a -> Mod FlagFields a -> Parser a
flag' TldrCommand
About (String -> Mod FlagFields TldrCommand
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"about" Mod FlagFields TldrCommand
-> Mod FlagFields TldrCommand -> Mod FlagFields TldrCommand
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields TldrCommand
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'a' Mod FlagFields TldrCommand
-> Mod FlagFields TldrCommand -> Mod FlagFields TldrCommand
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields TldrCommand
forall (f :: * -> *) a. String -> Mod f a
help String
"About this program")

viewOptionsParser :: Parser ViewOptions
viewOptionsParser :: Parser ViewOptions
viewOptionsParser = Maybe String -> Maybe String -> ViewOptions
ViewOptions (Maybe String -> Maybe String -> ViewOptions)
-> Parser (Maybe String) -> Parser (Maybe String -> ViewOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe String)
platformFlag Parser (Maybe String -> ViewOptions)
-> Parser (Maybe String) -> Parser ViewOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe String)
languageFlag

viewPageCommand :: Parser TldrCommand
viewPageCommand :: Parser TldrCommand
viewPageCommand =
  ViewOptions -> [String] -> TldrCommand
ViewPage (ViewOptions -> [String] -> TldrCommand)
-> Parser ViewOptions -> Parser ([String] -> TldrCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ViewOptions
viewOptionsParser Parser ([String] -> TldrCommand)
-> Parser [String] -> Parser TldrCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (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
"COMMAND" Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"name of the command"))

platformFlag :: Parser (Maybe String)
platformFlag :: Parser (Maybe String)
platformFlag =
  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
"platform" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' 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
"PLATFORM" 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
"Prioritize a specific platform while searching. Valid values include " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
           String
platformHelpValue)))
  where
    platformHelpValue :: String
    platformHelpValue :: String
platformHelpValue = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
platformDirs

languageFlag :: Parser (Maybe String)
languageFlag :: Parser (Maybe String)
languageFlag =
  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
"language" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'L' 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
"LOCALE" 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
"Preferred language for the page returned"))

useColorFlag :: Parser (Maybe ColorSetting)
useColorFlag :: Parser (Maybe ColorSetting)
useColorFlag =
  Parser ColorSetting -> Parser (Maybe ColorSetting)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
    (ColorSetting -> Mod FlagFields ColorSetting -> Parser ColorSetting
forall a. a -> Mod FlagFields a -> Parser a
flag' ColorSetting
UseColor
        (String -> Mod FlagFields ColorSetting
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"color" Mod FlagFields ColorSetting
-> Mod FlagFields ColorSetting -> Mod FlagFields ColorSetting
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod FlagFields ColorSetting
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Force colored output, overriding the NO_COLOR environment variable"))

noColorFlag :: Parser (Maybe ColorSetting)
noColorFlag :: Parser (Maybe ColorSetting)
noColorFlag =
  Parser ColorSetting -> Parser (Maybe ColorSetting)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
    (ColorSetting -> Mod FlagFields ColorSetting -> Parser ColorSetting
forall a. a -> Mod FlagFields a -> Parser a
flag' ColorSetting
NoColor
        (String -> Mod FlagFields ColorSetting
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-color" Mod FlagFields ColorSetting
-> Mod FlagFields ColorSetting -> Mod FlagFields ColorSetting
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod FlagFields ColorSetting
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Disable colored output"))

colorFlags :: Parser (Maybe ColorSetting)
colorFlags :: Parser (Maybe ColorSetting)
colorFlags = Parser (Maybe ColorSetting)
useColorFlag Parser (Maybe ColorSetting)
-> Parser (Maybe ColorSetting) -> Parser (Maybe ColorSetting)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe ColorSetting)
noColorFlag

tldrParserInfo :: ParserInfo TldrOpts
tldrParserInfo :: ParserInfo TldrOpts
tldrParserInfo =
  Parser TldrOpts -> InfoMod TldrOpts -> ParserInfo TldrOpts
forall a. Parser a -> InfoMod a -> ParserInfo a
info
    (Parser ((TldrOpts -> TldrOpts) -> TldrOpts -> TldrOpts)
forall a. Parser (a -> a)
helper Parser ((TldrOpts -> TldrOpts) -> TldrOpts -> TldrOpts)
-> Parser (TldrOpts -> TldrOpts) -> Parser (TldrOpts -> TldrOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (TldrOpts -> TldrOpts)
forall a. Parser (a -> a)
versionOption Parser (TldrOpts -> TldrOpts) -> Parser TldrOpts -> Parser TldrOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TldrOpts
programOptions)
    (InfoMod TldrOpts
forall a. InfoMod a
fullDesc InfoMod TldrOpts -> InfoMod TldrOpts -> InfoMod TldrOpts
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod TldrOpts
forall a. String -> InfoMod a
progDesc String
"tldr Client program" InfoMod TldrOpts -> InfoMod TldrOpts -> InfoMod TldrOpts
forall a. Semigroup a => a -> a -> a
<>
     String -> InfoMod TldrOpts
forall a. String -> InfoMod a
header String
"tldr - Simplified and community-driven man pages")
  where
    versionOption :: Parser (a -> a)
    versionOption :: Parser (a -> a)
versionOption =
      String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
        (Version -> String
showVersion Version
version)
        (String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version")

appMain :: IO ()
appMain :: IO ()
appMain = do
  [String]
args <- IO [String]
getArgs
  case ParserPrefs
-> ParserInfo TldrOpts -> [String] -> ParserResult TldrOpts
forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
execParserPure (PrefsMod -> ParserPrefs
prefs PrefsMod
showHelpOnEmpty) ParserInfo TldrOpts
tldrParserInfo [String]
args of
    failOpts :: ParserResult TldrOpts
failOpts@(Failure ParserFailure ParserHelp
_) -> IO TldrOpts -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO TldrOpts -> IO ()) -> IO TldrOpts -> IO ()
forall a b. (a -> b) -> a -> b
$ ParserResult TldrOpts -> IO TldrOpts
forall a. ParserResult a -> IO a
handleParseResult ParserResult TldrOpts
failOpts
    Success TldrOpts
opts -> TldrOpts -> IO ()
handleTldrOpts TldrOpts
opts
    compOpts :: ParserResult TldrOpts
compOpts@(CompletionInvoked CompletionResult
_) -> IO TldrOpts -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO TldrOpts -> IO ()) -> IO TldrOpts -> IO ()
forall a b. (a -> b) -> a -> b
$ ParserResult TldrOpts -> IO TldrOpts
forall a. ParserResult a -> IO a
handleParseResult ParserResult TldrOpts
compOpts