module Hoogle.Cabal.CmdOptions
  ( CmdOptions (..),
    readCmdOptions,
    Command (..),
  )
where

import Data.Text (Text)
import Options.Applicative

data CmdOptions = CmdOptions
  { CmdOptions -> Maybe Text
cmdOptions_compiler :: Maybe Text,
    CmdOptions -> Maybe Text
cmdOptions_platform :: Maybe Text,
    CmdOptions -> FilePath
cmdOptions_builddir :: FilePath,
    CmdOptions -> Command
cmdOptions_command :: Command
  }
  deriving (Int -> CmdOptions -> ShowS
[CmdOptions] -> ShowS
CmdOptions -> FilePath
(Int -> CmdOptions -> ShowS)
-> (CmdOptions -> FilePath)
-> ([CmdOptions] -> ShowS)
-> Show CmdOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CmdOptions] -> ShowS
$cshowList :: [CmdOptions] -> ShowS
show :: CmdOptions -> FilePath
$cshow :: CmdOptions -> FilePath
showsPrec :: Int -> CmdOptions -> ShowS
$cshowsPrec :: Int -> CmdOptions -> ShowS
Show, CmdOptions -> CmdOptions -> Bool
(CmdOptions -> CmdOptions -> Bool)
-> (CmdOptions -> CmdOptions -> Bool) -> Eq CmdOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmdOptions -> CmdOptions -> Bool
$c/= :: CmdOptions -> CmdOptions -> Bool
== :: CmdOptions -> CmdOptions -> Bool
$c== :: CmdOptions -> CmdOptions -> Bool
Eq)

data Command
  = CommandGenerate
  | CommandRun [String]
  deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> FilePath
(Int -> Command -> ShowS)
-> (Command -> FilePath) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> FilePath
$cshow :: Command -> FilePath
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show, Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq)

parser :: Parser CmdOptions
parser :: Parser CmdOptions
parser =
  Maybe Text -> Maybe Text -> FilePath -> Command -> CmdOptions
CmdOptions
    (Maybe Text -> Maybe Text -> FilePath -> Command -> CmdOptions)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> FilePath -> Command -> CmdOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> Parser (Maybe Text))
-> (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text
-> Parser (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 FilePath
"compiler"
          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 FilePath
"compiler name and version, for example 'ghc-9.2.3'"
      )
    Parser (Maybe Text -> FilePath -> Command -> CmdOptions)
-> Parser (Maybe Text)
-> Parser (FilePath -> Command -> CmdOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> Parser (Maybe Text))
-> (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text
-> Parser (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 FilePath
"platform"
          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 FilePath
"platform, for example x86_64-linux"
      )
    Parser (FilePath -> Command -> CmdOptions)
-> Parser FilePath -> Parser (Command -> CmdOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 FilePath
"builddir"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value FilePath
"dist-newstyle"
          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 FilePath
"cabal project build dir"
      )
    Parser (Command -> CmdOptions)
-> Parser Command -> Parser CmdOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser
      ( FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"generate" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
CommandGenerate) (FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"generate hoogle database"))
          Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"run" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
commandRunParser (FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"run hoogle, with arbitrary arguments"))
      )

commandRunParser :: Parser Command
commandRunParser :: Parser Command
commandRunParser = [FilePath] -> Command
CommandRun ([FilePath] -> Command) -> Parser [FilePath] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser FilePath -> Parser [FilePath]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser FilePath -> Parser [FilePath])
-> (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath
-> Parser [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument) (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"ARGS")

readCmdOptions :: IO CmdOptions
readCmdOptions :: IO CmdOptions
readCmdOptions = ParserInfo CmdOptions -> IO CmdOptions
forall a. ParserInfo a -> IO a
execParser ParserInfo CmdOptions
parserInfo
  where
    parserInfo :: ParserInfo CmdOptions
parserInfo =
      Parser CmdOptions -> InfoMod CmdOptions -> ParserInfo CmdOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info
        (Parser CmdOptions
parser Parser CmdOptions
-> Parser (CmdOptions -> CmdOptions) -> Parser CmdOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (CmdOptions -> CmdOptions)
forall a. Parser (a -> a)
helper)
        ( InfoMod CmdOptions
forall a. InfoMod a
fullDesc
            InfoMod CmdOptions -> InfoMod CmdOptions -> InfoMod CmdOptions
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod CmdOptions
forall a. FilePath -> InfoMod a
progDesc
              ( FilePath
"Run hoogle on your local packages and dependencies. "
                  FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"See https://github.com/kokobd/cabal-hoogle for more information"
              )
        )