{-# LANGUAGE CPP #-}

module Main where

#if __GLASGOW_HASKELL__ < 709

import Data.Traversable (traverse)

#endif

import Control.Monad (when)

import Data.Maybe (fromMaybe)

import Data.Monoid ((<>))

import System.Directory (getCurrentDirectory)

import System.Environment (getProgName)

import System.IO (hPutStrLn, stderr)

import System.FilePath ((</>), isAbsolute, takeDirectory)

import Cabal (findCabalFile)

import Client (getServerStatus, serverCommand, stopServer)

import CommandArgs

import Daemonize (daemonize)

import Server (startServer, createListenSocket)

import Stack (findStackYaml)

import Types (Command(..), CommandExtra(..), emptyCommandExtra)

absoluteFilePath :: FilePath -> IO FilePath

absoluteFilePath p = if isAbsolute p then return p else do

dir <- getCurrentDirectory

return $ dir </> p

defaultSocketFile :: FilePath

defaultSocketFile = ".hdevtools.sock"

main :: IO ()

main = do

args <- loadHDevTools

let argPath = pathArg args

dir <- maybe getCurrentDirectory (return . takeDirectory) argPath

mCabalFile <- findCabalFile dir >>= traverse absoluteFilePath

when (debug args) .

putStrLn $ "Cabal file: " <> show mCabalFile

mStackYaml <- if noStack args then return Nothing else findStackYaml dir

when (debug args) .

putStrLn $ "Stack file: " <> show mStackYaml

let extra = emptyCommandExtra

{ cePath = argPath

, ceGhcOptions = ghcOpts args

, ceCabalFilePath = mCabalFile

, ceCabalOptions = cabalOpts args

, ceStackYamlPath = mStackYaml

}

let defaultSocketPath = maybe "" takeDirectory mCabalFile </> defaultSocketFile

let sock = fromMaybe defaultSocketPath $ socket args

when (debug args) .

putStrLn $ "Socket file: " <> show sock

case args of

Admin {} -> doAdmin sock args extra

Check {} -> doCheck sock args extra

ModuleFile {} -> doModuleFile sock args extra

Info {} -> doInfo sock args extra

Type {} -> doType sock args extra

FindSymbol {} -> doFindSymbol sock args extra

doAdmin :: FilePath -> HDevTools -> CommandExtra -> IO ()

doAdmin sock args cmdExtra

| start_server args =

if noDaemon args then startServer sock Nothing cmdExtra

else do

s <- createListenSocket sock

daemonize True $ startServer sock (Just s) cmdExtra

| status args = getServerStatus sock

| stop_server args = stopServer sock

| otherwise = do

progName <- getProgName

hPutStrLn stderr "You must provide a command. See:"

hPutStrLn stderr $ progName ++ " --help"

doModuleFile :: FilePath -> HDevTools -> CommandExtra -> IO ()

doModuleFile sock args extra =

serverCommand sock (CmdModuleFile (module_ args)) extra

doFileCommand :: String -> (HDevTools -> Command) -> FilePath -> HDevTools -> CommandExtra -> IO ()

doFileCommand cmdName cmd sock args extra

| null (file args) = do

progName <- getProgName

hPutStrLn stderr "You must provide a haskell source file. See:"

hPutStrLn stderr $ progName ++ " " ++ cmdName ++ " --help"

| otherwise = do

absFile <- absoluteFilePath $ file args

let args' = args { file = absFile }

extra' = extra { ceTemplateHaskell = not (noTH args) }

serverCommand sock (cmd args') extra'

doCheck :: FilePath -> HDevTools -> CommandExtra -> IO ()

doCheck = doFileCommand "check" $

\args -> CmdCheck (file args)

doInfo :: FilePath -> HDevTools -> CommandExtra -> IO ()

doInfo = doFileCommand "info" $

\args -> CmdInfo (file args) (identifier args)

doType :: FilePath -> HDevTools -> CommandExtra -> IO ()

doType = doFileCommand "type" $

\args -> CmdType (file args) (line args, col args)

doFindSymbol :: FilePath -> HDevTools -> CommandExtra -> IO ()

doFindSymbol sock args extra =

serverCommand sock (CmdFindSymbol (symbol args) (files args)) extra