hdevtools-0.1.8.0: src/CommandArgs.hs
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}
module CommandArgs
( HDevTools(..)
, loadHDevTools
, pathArg
)
where
import Cabal (findFile)
import Data.Version (showVersion)
import Paths_hdevtools (version)
import qualified Config
import System.Console.CmdArgs.Implicit
import System.Console.CmdArgs.Explicit (splitArgs)
import System.Directory (getCurrentDirectory)
import System.Environment (getProgName, withArgs, getArgs)
import System.FilePath (takeDirectory)
import System.Info (arch, os)
programVersion :: String
programVersion =
"version " ++ showVersion version
cabalVersion :: String
cabalVersion =
"cabal-" ++ VERSION_Cabal
fullVersion :: String
fullVersion =
concat
[ programVersion
, " ("
, "ghc-", Config.cProjectVersion, "-", arch, "-", os
, ", ", cabalVersion
, ")"
]
data HDevTools
= Admin
{ socket :: Maybe FilePath
, ghcOpts :: [String]
, start_server :: Bool
, cabalOpts :: [String]
, noDaemon :: Bool
, status :: Bool
, stop_server :: Bool
, debug :: Bool
, noStack :: Bool
}
| Check
{ socket :: Maybe FilePath
, ghcOpts :: [String]
, cabalOpts :: [String]
, path :: Maybe String
, file :: String
, json :: Bool
, debug :: Bool
, noStack :: Bool
, noTH :: Bool
}
| ModuleFile
{ socket :: Maybe FilePath
, ghcOpts :: [String]
, cabalOpts :: [String]
, module_ :: String
, debug :: Bool
, noStack :: Bool
}
| Info
{ socket :: Maybe FilePath
, ghcOpts :: [String]
, cabalOpts :: [String]
, path :: Maybe String
, file :: String
, identifier :: String
, debug :: Bool
, noStack :: Bool
, noTH :: Bool
}
| Type
{ socket :: Maybe FilePath
, ghcOpts :: [String]
, cabalOpts :: [String]
, path :: Maybe String
, file :: String
, line :: Int
, col :: Int
, debug :: Bool
, noStack :: Bool
, noTH :: Bool
}
| FindSymbol
{ socket :: Maybe FilePath
, ghcOpts :: [String]
, cabalOpts :: [String]
, symbol :: String
, files :: [String]
, debug :: Bool
, noStack :: Bool
, noTH :: Bool
}
deriving (Show, Data, Typeable)
dummyAdmin :: HDevTools
dummyAdmin = Admin
{ socket = Nothing
, ghcOpts = []
, cabalOpts = []
, start_server = False
, noDaemon = False
, status = False
, stop_server = False
, debug = False
, noStack = False
}
dummyCheck :: HDevTools
dummyCheck = Check
{ socket = Nothing
, ghcOpts = []
, cabalOpts = []
, path = Nothing
, file = ""
, json = False
, debug = False
, noTH = False
, noStack = False
}
dummyModuleFile :: HDevTools
dummyModuleFile = ModuleFile
{ socket = Nothing
, ghcOpts = []
, cabalOpts = []
, module_ = ""
, debug = False
, noStack = False
}
dummyInfo :: HDevTools
dummyInfo = Info
{ socket = Nothing
, ghcOpts = []
, cabalOpts = []
, path = Nothing
, file = ""
, identifier = ""
, debug = False
, noStack = False
, noTH = False
}
dummyType :: HDevTools
dummyType = Type
{ socket = Nothing
, ghcOpts = []
, cabalOpts = []
, path = Nothing
, file = ""
, line = 0
, col = 0
, debug = False
, noStack = False
, noTH = False
}
dummyFindSymbol :: HDevTools
dummyFindSymbol = FindSymbol
{ socket = Nothing
, ghcOpts = []
, cabalOpts = []
, symbol = ""
, files = []
, debug = False
, noStack = False
, noTH = False
}
admin :: Annotate Ann
admin = record dummyAdmin
[ socket := def += typFile += help "socket file to use"
, ghcOpts := def += typ "OPTION" += help "ghc options"
, cabalOpts := def += typ "OPTION" += help "cabal options"
, start_server := def += help "start server"
, noDaemon := def += help "do not daemonize (only if --start-server)"
, status := def += help "show status of server"
, stop_server := def += help "shutdown the server"
, debug := def += help "enable debug output"
, noStack := def += name "S" += help "disable stack integration"
] += help "Interactions with the server"
check :: Annotate Ann
check = record dummyCheck
[ socket := def += typFile += help "socket file to use"
, ghcOpts := def += typ "OPTION" += help "ghc options"
, cabalOpts := def += typ "OPTION" += help "cabal options"
, path := def += typFile += help "path to target file"
, file := def += typFile += argPos 0 += opt ""
, json := def += help "render output as JSON"
, debug := def += help "enable debug output"
, noStack := def += name "S" += help "disable stack integration"
, noTH := def += help "disable template haskell"
] += help "Check a haskell source file for errors and warnings"
moduleFile :: Annotate Ann
moduleFile = record dummyModuleFile
[ socket := def += typFile += help "socket file to use"
, ghcOpts := def += typ "OPTION" += help "ghc options"
, cabalOpts := def += typ "OPTION" += help "cabal options"
, module_ := def += typ "MODULE" += argPos 0
, debug := def += help "enable debug output"
, noStack := def += name "S" += help "disable stack integration"
] += help "Get the haskell source file corresponding to a module name"
info :: Annotate Ann
info = record dummyInfo
[ socket := def += typFile += help "socket file to use"
, ghcOpts := def += typ "OPTION" += help "ghc options"
, cabalOpts := def += typ "OPTION" += help "cabal options"
, path := def += typFile += help "path to target file"
, file := def += typFile += argPos 0 += opt ""
, identifier := def += typ "IDENTIFIER" += argPos 1
, debug := def += help "enable debug output"
, noStack := def += name "S" += help "disable stack integration"
, noTH := def += help "disable template haskell"
] += help "Get info from GHC about the specified identifier"
type_ :: Annotate Ann
type_ = record dummyType
[ socket := def += typFile += help "socket file to use"
, ghcOpts := def += typ "OPTION" += help "ghc options"
, cabalOpts := def += typ "OPTION" += help "cabal options"
, debug := def += help "enable debug output"
, noStack := def += name "S" += help "disable stack integration"
, path := def += typFile += help "path to target file"
, file := def += typFile += argPos 0 += opt ""
, line := def += typ "LINE" += argPos 1
, col := def += typ "COLUMN" += argPos 2
, noTH := def += help "disable template haskell"
] += help "Get the type of the expression at the specified line and column"
findSymbol :: Annotate Ann
findSymbol = record dummyFindSymbol
[ socket := def += typFile += help "socket file to use"
, ghcOpts := def += typ "OPTION" += help "ghc options"
, cabalOpts := def += typ "OPTION" += help "cabal options"
, symbol := def += typ "SYMBOL" += argPos 0
, files := def += typFile += args
, debug := def += help "enable debug output"
, noStack := def += name "S" += help "disable stack integration"
, noTH := def += help "disable template haskell"
] += help "List the modules where the given symbol could be found"
full :: String -> Annotate Ann
full progName = modes_ [admin += auto, check, moduleFile, info, type_, findSymbol]
+= helpArg [name "h", groupname "Help"]
+= versionArg [name "v", groupname "Help"]
+= program progName
+= summary (progName ++ ": " ++ fullVersion)
fileArg :: HDevTools -> Maybe String
fileArg Admin {} = Nothing
fileArg ModuleFile {} = Nothing
fileArg a@Check {} = Just $ file a
fileArg a@Info {} = Just $ file a
fileArg a@Type {} = Just $ file a
fileArg FindSymbol {} = Nothing
pathArg' :: HDevTools -> Maybe String
pathArg' Admin {} = Nothing
pathArg' ModuleFile {} = Nothing
pathArg' a@Check {} = path a
pathArg' a@Info {} = path a
pathArg' a@Type {} = path a
pathArg' FindSymbol {} = Nothing
pathArg :: HDevTools -> Maybe String
pathArg a = case pathArg' a of
Just x -> Just x
Nothing -> fileArg a
loadHDevTools :: IO HDevTools
loadHDevTools = do
progName <- getProgName
cfg0 <- cmdArgs_ (full progName)
dir <- maybe getCurrentDirectory (return . takeDirectory) $ pathArg cfg0
mConfig <- findFile (== ".hdevtoolsrc") dir
perProject <- maybe (return []) (\f -> splitArgs `fmap` readFile f) mConfig
args0 <- getArgs
withArgs (args0 ++ perProject) $ cmdArgs_ (full progName)