----------------------------------------------------------------------------- ---- | ---- Module : Haste.Options ---- Copyright : David Siegel ---- License : BSD3-style (see LICENSE) ---- ---- Maintainer : David Siegel ---- Stability : experimental ---- Portability : ? ---- ---- Command-line options parsing. ------------------------------------------------------------------------------- module Haste.Options ( getOptions -- :: Args -> (HasteOptions, Args) , helpText -- :: String ) where import Data.List (sort) import Haste.Types import Haste.PasteProviders (lookupProvider, pasteProviders) import Text.Printf (printf) import System.Console.GetOpt -- | Default 'HasteOptions' defaultOptions :: HasteOptions defaultOptions = HasteOptions { optProvider = Nothing , optLanguage = Nothing , optHelp = False } -- | Help text for options. helpText :: String helpText = usageInfo "haste options:" options options :: [OptDescr (HasteOptions -> HasteOptions)] options = [ Option "h" ["help"] (NoArg (\os -> os { optHelp = True })) helpOptionInfo , Option "p" ["provider"] (ReqArg (\p os -> os { optProvider = (Just . readProvider) p }) "PROVIDER") providerOptionInfo , Option "l" ["language"] (ReqArg (\l os -> os { optLanguage = (Just . readLanguage) l }) "LANGUAGE") languageOptionInfo ] helpOptionInfo = "Print help information." providerOptionInfo = "Which paste provider to use " ++ (argumentList . map optionName) pasteProviders languageOptionInfo = "Which language to paste " ++ (argumentList . showBoundedEnums) languageOptionName readLanguage :: String -> Language readLanguage (reads -> (lang, _) : _) = lang readLanguage s = argumentError $ printf "Unrecognized language \"%s\"" s readProvider :: String -> SomePasteProvider readProvider (lookupProvider -> Just p) = p readProvider name = argumentError $ printf "Unrecognized paste provider \"%s\"" name -- | Parse command-line arguments. Returns tuple of parsed 'HasteOptions' and -- unparsed 'Args'. getOptions :: Args -> (HasteOptions, Args) getOptions args = case getOpt Permute options args of (fs, args, []) -> (applyAll fs defaultOptions, args) where applyAll = foldl (.) id (_, _, errors) -> argumentError (concat errors) -- | Show all instances of a bounded enum with a custom show function. showBoundedEnums :: (Enum a, Bounded a) => (a -> String) -> [String] showBoundedEnums show' = map show' . enumFrom $ minBound -- | Take a list of strings, and format them as a list of options to print with -- help info. argumentList :: [String] -> String argumentList = reformat . show . sort where reformat = map change . filter (/= '"') change ',' = '|' change '[' = '(' change ']' = ')' change c = c argumentError :: String -> a argumentError = error . printf "%s Use --help for help."