{-# LANGUAGE RecordWildCards #-}

module Hoogle.Cabal.Command where

import qualified Hoogle.Cabal.Command.ActAsSetup as ActAsSetup
import Hoogle.Cabal.Command.Common
import qualified Hoogle.Cabal.Command.Generate as Generate
import qualified Hoogle.Cabal.Command.Run as Run
import qualified Hoogle.Cabal.Command.Version as Version
import Hoogle.Cabal.Logger
import Options.Applicative

data CmdOptions = CmdOptions
  { CmdOptions -> GlobalOptions
_cmdOptions_global :: GlobalOptions,
    CmdOptions -> Maybe Command
_cmdOptions_command :: Maybe Command
  }
  deriving (Int -> CmdOptions -> ShowS
[CmdOptions] -> ShowS
CmdOptions -> String
(Int -> CmdOptions -> ShowS)
-> (CmdOptions -> String)
-> ([CmdOptions] -> ShowS)
-> Show CmdOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CmdOptions -> ShowS
showsPrec :: Int -> CmdOptions -> ShowS
$cshow :: CmdOptions -> String
show :: CmdOptions -> String
$cshowList :: [CmdOptions] -> ShowS
showList :: [CmdOptions] -> ShowS
Show, CmdOptions -> CmdOptions -> Bool
(CmdOptions -> CmdOptions -> Bool)
-> (CmdOptions -> CmdOptions -> Bool) -> Eq CmdOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmdOptions -> CmdOptions -> Bool
== :: CmdOptions -> CmdOptions -> Bool
$c/= :: CmdOptions -> CmdOptions -> Bool
/= :: CmdOptions -> CmdOptions -> Bool
Eq)

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

data Log
  = LogGenerate Generate.Log
  | LogRun Run.Log

instance Show Log where
  show :: Log -> String
show (LogGenerate Log
l) = Log -> String
forall a. Show a => a -> String
show Log
l
  show (LogRun Log
l) = Log -> String
forall a. Show a => a -> String
show Log
l

executeCommand :: Logger Log -> IO ()
executeCommand :: Logger Log -> IO ()
executeCommand Logger Log
logger = do
  CmdOptions {Maybe Command
GlobalOptions
_cmdOptions_global :: CmdOptions -> GlobalOptions
_cmdOptions_command :: CmdOptions -> Maybe Command
_cmdOptions_global :: GlobalOptions
_cmdOptions_command :: Maybe Command
..} <- IO CmdOptions
readCmdOptions
  if GlobalOptions -> Bool
_globalOptions_version GlobalOptions
_cmdOptions_global
    then Command -> IO ()
Version.action Command
Version.Command
    else case Maybe Command
_cmdOptions_command of
      Maybe Command
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just Command
cmd' -> case Command
cmd' of
        CommandGenerate Command
cmd -> Logger Log -> GlobalOptions -> Command -> IO ()
Generate.action ((Log -> Log) -> Logger Log -> Logger Log
forall a b. (a -> b) -> Logger b -> Logger a
cmapLogger Log -> Log
LogGenerate Logger Log
logger) GlobalOptions
_cmdOptions_global Command
cmd
        CommandActAsSetup Command
cmd -> Command -> IO ()
ActAsSetup.action Command
cmd
        CommandRun Command
cmd -> Logger Log -> GlobalOptions -> Command -> IO ()
Run.action ((Log -> Log) -> Logger Log -> Logger Log
forall a b. (a -> b) -> Logger b -> Logger a
cmapLogger Log -> Log
LogRun Logger Log
logger) GlobalOptions
_cmdOptions_global Command
cmd
        CommandVersion Command
cmd -> Command -> IO ()
Version.action Command
cmd

parser :: Parser CmdOptions
parser :: Parser CmdOptions
parser =
  GlobalOptions -> Maybe Command -> CmdOptions
CmdOptions
    (GlobalOptions -> Maybe Command -> CmdOptions)
-> Parser GlobalOptions -> Parser (Maybe Command -> CmdOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GlobalOptions
globalOptionsParser
    Parser (Maybe Command -> CmdOptions)
-> Parser (Maybe Command) -> Parser CmdOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command -> Parser (Maybe Command)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser
          ( (Command -> Command) -> Mod CommandFields Command
forall a. (Command -> a) -> Mod CommandFields a
Generate.command Command -> Command
CommandGenerate
              Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> (Command -> Command) -> Mod CommandFields Command
forall a. (Command -> a) -> Mod CommandFields a
Run.command Command -> Command
CommandRun
              Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> (Command -> Command) -> Mod CommandFields Command
forall a. (Command -> a) -> Mod CommandFields a
Version.command Command -> Command
CommandVersion
              Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> (Command -> Command) -> Mod CommandFields Command
forall a. (Command -> a) -> Mod CommandFields a
ActAsSetup.command Command -> Command
CommandActAsSetup
          )
      )

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
<> String -> InfoMod CmdOptions
forall a. String -> InfoMod a
progDesc
              ( String
"Run hoogle on your local packages and dependencies. "
                  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"See https://github.com/kokobd/cabal-hoogle for more information"
              )
        )