module Hoogle.Cabal.Command.ActAsSetup
  ( command,
    Command,
    action,
  )
where

import Data.Maybe (fromJust)
import qualified Distribution.Make as Make
import Distribution.Parsec (simpleParsec)
import qualified Distribution.Simple as Simple
import Distribution.Types.BuildType
import qualified Options.Applicative as OptParse

data Command = Command
  { Command -> String
_buildType :: String,
    Command -> [String]
_args :: [String]
  }
  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)

command :: (Command -> a) -> OptParse.Mod OptParse.CommandFields a
command :: forall a. (Command -> a) -> Mod CommandFields a
command Command -> a
f =
  String -> ParserInfo a -> Mod CommandFields a
forall a. String -> ParserInfo a -> Mod CommandFields a
OptParse.command
    String
"act-as-setup"
    (Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
OptParse.info ((Command -> a) -> Parser Command -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Command -> a
f Parser Command
commandParser) (String -> InfoMod a
forall a. String -> InfoMod a
OptParse.progDesc String
"(Internal) Run as-if this was a Setup.hs"))

commandParser :: OptParse.Parser Command
commandParser :: Parser Command
commandParser =
  String -> [String] -> Command
Command
    (String -> [String] -> Command)
-> Parser String -> Parser ([String] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
OptParse.strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
OptParse.long String
"build-type")
    Parser ([String] -> Command) -> Parser [String] -> Parser Command
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 -> Parser [String]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
OptParse.many (Parser String -> Parser [String])
-> (Mod ArgumentFields String -> Parser String)
-> Mod ArgumentFields String
-> Parser [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
OptParse.strArgument) (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OptParse.metavar String
"ARGS")

action :: Command -> IO ()
action :: Command -> IO ()
action (Command String
buildTypeStr [String]
args) =
  let bt :: BuildType
bt = Maybe BuildType -> BuildType
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe BuildType -> BuildType) -> Maybe BuildType -> BuildType
forall a b. (a -> b) -> a -> b
$ String -> Maybe BuildType
forall a. Parsec a => String -> Maybe a
simpleParsec String
buildTypeStr -- TODO: report error properly
   in case BuildType
bt of
        BuildType
Simple -> [String] -> IO ()
Simple.defaultMainArgs [String]
args
        BuildType
Configure ->
          UserHooks -> [String] -> IO ()
Simple.defaultMainWithHooksArgs
            UserHooks
Simple.autoconfUserHooks
            [String]
args
        BuildType
Make -> [String] -> IO ()
Make.defaultMainArgs [String]
args
        BuildType
Custom -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"actAsSetupAction Custom"