Options.hs

-----------------------------------------------------------------------------
---- |
---- Module      : Haste.Options
---- Copyright   : David Siegel
---- License     : BSD3-style (see LICENSE)
---- 
---- Maintainer  : David Siegel <djsiegel@gmail.com>
---- 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."