module Hi.Option
(
getOptions
, getMode
, options
, usage
) where
import Hi.Config (parseConfig)
import Hi.Types
import Hi.Utils
import Control.Applicative
import Data.Char (isUpper, toLower)
import Data.List (intercalate)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Time.Calendar (toGregorian)
import Data.Time.Clock (getCurrentTime, utctDay)
import System.Console.GetOpt
import System.Directory (doesFileExist, getHomeDirectory)
import qualified System.Environment
import System.FilePath (joinPath)
options :: [OptDescr Option]
options =
[ Option ['m'] ["module-name"] (ReqArg (Arg "moduleName" ) "Module.Name" ) "Name of Module"
, Option ['p'] ["package-name"] (ReqArg (Arg "packageName") "package-name") "Name of package ( optional )"
, Option ['a'] ["author"] (ReqArg (Arg "author" ) "NAME" ) "Name of the project's author"
, Option ['e'] ["email"] (ReqArg (Arg "email" ) "EMAIL" ) "Email address of the maintainer"
, Option ['r'] ["repository"] (ReqArg (Arg "repository" ) "REPOSITORY" ) "Template repository ( optional )"
, Option [] ["configuration-file"] (ReqArg (Arg "configFile" ) "CONFIGFILE" ) "Run with configuration file"
, Option ['v'] ["version"] (NoArg Version) "Show version number"
, Option [] ["initialize-git-repository"] (NoArg InitializeGitRepository) "Initialize with git repository"
, Option ['h'] ["help"] (NoArg Help) "Display this help and exit"
]
toOption :: (String, String) -> Maybe Option
toOption (key, value) = maybe err ok $ key `lookupOption` options
where
err = error $ "Invalid options \"" ++ key ++ "\" was specified"
ok (Option _ _ argDescr _) = toOption' argDescr value
lookupOption :: String -> [OptDescr Option] -> Maybe (OptDescr Option)
lookupOption k opts = k `lookup` map (\x@(Option _ (longOpt:_) _ _) -> (longOpt,x)) opts
toOption' :: ArgDescr Option -> String -> Maybe Option
toOption' (NoArg opt) "True" = Just opt
toOption' (NoArg _) _ = Nothing
toOption' (ReqArg f _) val = Just $ f val
getOptions :: IO [Option]
getOptions = handleError
<$> validateOptions
=<< addDefaultRepo
=<< addPackageNameIfMissing
=<< addOptionsFromConfigFile
=<< addYear
=<< parseOptions
<$> System.Environment.getArgs
where
addYear :: [Option] -> IO [Option]
addYear vals = do
y <- getCurrentYear
return $ vals ++ [y]
addOptionsFromConfigFile :: [Option] -> IO [Option]
addOptionsFromConfigFile vals = do
repo <- do
mfile <- readFileMaybe =<< getConfigFileName
return $ mapMaybe toOption $ fromMaybe [] (parseConfig <$> mfile)
return $ vals ++ repo
addDefaultRepo :: [Option] -> IO [Option]
addDefaultRepo vals = return $ vals ++ [Arg "repository" defaultRepo]
addPackageNameIfMissing :: [Option] -> IO [Option]
addPackageNameIfMissing vals =
return $ case ("packageName" `lookupArg` vals, "moduleName" `lookupArg` vals) of
(Nothing, Just m) -> vals ++ [Arg "packageName" $ (removeDup . hyphenize) m]
_ -> vals
where
removeDup [] = []
removeDup [x] = [x]
removeDup ('-':'-':xs) = removeDup('-':xs)
removeDup (x:xs) = x: removeDup xs
hyphenize [] = []
hyphenize (x:xs) = hyphenize' $ toLower x:xs
hyphenize' [] = []
hyphenize' (x:[]) = [toLower x]
hyphenize' (x:xs) | isUpper x = '-':toLower x:hyphenize' xs
| x == '.' = '-':hyphenize' xs
| otherwise = x:hyphenize' xs
handleError :: Either [String] [Option] -> IO [Option]
handleError result = case result of
Left errors -> error $ (intercalate "\n" errors) ++ "\n (Run with no arguments to see usage)"
Right x -> return x
readFileMaybe :: FilePath -> IO (Maybe String)
readFileMaybe f = do
e <- doesFileExist f
if e then Just <$> readFile f else return Nothing
getMode :: IO Mode
getMode = do
args <- parseOptions <$> System.Environment.getArgs
return $ modeFor args
where
modeFor args | Help `elem` args = ShowHelp
| Version `elem` args = ShowVersion
| otherwise = Run
parseOptions :: [String] -> [Option]
parseOptions argv =
case getOpt Permute options argv of
([],_,errs) -> error $ concat errs ++ usage
(o,_,[] ) -> o
(_,_,errs ) -> error $ concat errs ++ usage
usage :: String
usage = usageInfo header options ++ footer
where
header = "Usage: hi [OPTION...]\n" ++
"Generate a haskell project based on a template from github.\n"
footer = "\n" ++
"If repository is not provided, it defaults to the repository at\n" ++
defaultRepo ++ ".\n" ++
"\n" ++
"Example:\n" ++
" hi --module-name 'Foo.Bar' " ++
"--author 'you' --email 'you@gmail.com'"
defaultConfigFilePath :: IO FilePath
defaultConfigFilePath = do
h <- getHomeDirectory
return $ joinPath [h, defaultConfigFileName]
defaultConfigFileName :: FilePath
defaultConfigFileName = ".hirc"
defaultRepo :: String
defaultRepo = "git://github.com/fujimura/hi-hspec.git"
getConfigFileName :: IO FilePath
getConfigFileName = go =<< parseOptions <$> System.Environment.getArgs
where
go [] = defaultConfigFilePath
go ((Arg "configFile" p):_) = return p
go (_:xs) = go xs
getCurrentYear :: IO Option
getCurrentYear = do
(y,_,_) <- (toGregorian . utctDay) <$> getCurrentTime
return (Arg "year" $ show y)
validateOptions :: [Option] -> Either [Error] [Option]
validateOptions values = case mapMaybe ($ values) validations of
[] -> Right values
errors -> Left errors
validations ::[[Option] -> Maybe String]
validations = [ hasKey "packageName"
, hasKey "moduleName"
, hasKey "author"
, hasKey "email"
, hasKey "repository"
, hasKey "year"
]
hasKey :: String -> [Option] -> Maybe String
hasKey k options = case lookupArg k options of
Just _ -> Nothing
Nothing -> Just $ "Could not find option: " ++ k