{-# LANGUAGE RecordWildCards #-}

module Hoogle.Cabal.Command.Run
  ( Command,
    command,
    action,
    Log
  )
where

import qualified Hoogle
import Hoogle.Cabal.Command.Common (Context (..), GlobalOptions, hoogleDatabaseArg, readContext)
import Hoogle.Cabal.Logger
import qualified Options.Applicative as OptParse
import System.Directory (doesDirectoryExist, withCurrentDirectory)

newtype Command = Command
  { Command -> [String]
_hoogleArgs :: [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
"run" (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
"Run hoogle, with arbitrary arguments"))

commandParser :: OptParse.Parser Command
commandParser :: Parser Command
commandParser = [String] -> Command
Command ([String] -> Command) -> Parser [String] -> Parser Command
forall (f :: * -> *) a b. Functor 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")

data Log = LogHoogleDirDoesNotExist

instance Show Log where
  show :: Log -> String
show Log
LogHoogleDirDoesNotExist = String
"please run 'cabal-hoogle generate' first"

action :: Logger Log -> GlobalOptions -> Command -> IO ()
action :: Logger Log -> GlobalOptions -> Command -> IO ()
action Logger Log
logger GlobalOptions
globalOptions Command {[String]
_hoogleArgs :: Command -> [String]
_hoogleArgs :: [String]
..} = do
  Context {String
[String]
GlobalFlags
NixStyleFlags BuildFlags
ProjectBuildContext
ProjectBaseContext
_context_baseCtx :: ProjectBaseContext
_context_buildCtx :: ProjectBuildContext
_context_hoogleDir :: String
_context_targetStrings :: [String]
_context_flags :: NixStyleFlags BuildFlags
_context_globalFlags :: GlobalFlags
_context_baseCtx :: Context -> ProjectBaseContext
_context_buildCtx :: Context -> ProjectBuildContext
_context_hoogleDir :: Context -> String
_context_targetStrings :: Context -> [String]
_context_flags :: Context -> NixStyleFlags BuildFlags
_context_globalFlags :: Context -> GlobalFlags
..} <- GlobalOptions -> [String] -> IO Context
readContext GlobalOptions
globalOptions []
  Bool
hoogleDirExists <- String -> IO Bool
doesDirectoryExist String
_context_hoogleDir
  if Bool -> Bool
not Bool
hoogleDirExists
    then Logger Log -> Severity -> Log -> IO ()
forall (m :: * -> *) msg.
MonadIO m =>
Logger msg -> Severity -> msg -> m ()
logWith Logger Log
logger Severity
Error Log
LogHoogleDirDoesNotExist
    else
      String -> IO () -> IO ()
forall a. String -> IO a -> IO a
withCurrentDirectory String
_context_hoogleDir (IO () -> IO ()) -> ([String] -> IO ()) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> IO ()
Hoogle.hoogle ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
        [String]
hoogleArgs'
  where
    hoogleArgs' :: [String]
hoogleArgs' = case [String]
_hoogleArgs of
      (String
x : [String]
xs) -> String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
hoogleDatabaseArg String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs
      [] -> [String
hoogleDatabaseArg]