haste-compiler-0.2: src/Args.hs

module Args (ArgSpec (..), handleArgs) where
import Data.List (partition, stripPrefix)

data ArgSpec a = ArgSpec {
    optName   :: String,
    updateCfg :: a -> [String] -> a,
    info      :: String
  }

-- | Updates a config based on the given list of ArgSpecs and command line
--   arguments. If --help is encountered within the arguments, we stop
--   everything and just return a help message.
handleArgs :: a -> [ArgSpec a] -> [String] -> Either String (a, [String])
handleArgs cfg specs args =
  if elem "--help" cfgargs
     then Left (printHelp specs)
     else Right (foldl (matchSpec specs) cfg (map (drop 2) cfgargs), rest)
  where
    (cfgargs, rest) = partition ((== "--") . take 2) args

matchSpec :: [ArgSpec a] -> a -> String -> a
matchSpec specs cfg arg =
  foldl updCfg cfg matchingSpecs
  where
    updCfg cfg' (spec, args) =
      updateCfg spec cfg' (commaBreak args)
    specArgs =
      map (\spec -> stripPrefix (optName spec) arg) specs
    matchingSpecs =
      map (\(s, Just a) -> (s, a)) $ filter isMatching (zip specs specArgs)
    isMatching (_, Nothing) = False
    isMatching _            = True

-- | Like 'words', except it breaks on commas instead of spaces.
commaBreak :: String -> [String]
commaBreak [] = []
commaBreak s  =
  case span (/= ',') s of
    (w, ws) -> w : commaBreak (drop 1 ws)

printHelp :: [ArgSpec a] -> String
printHelp = unlines . map helpString

helpString :: ArgSpec a -> String
helpString spec =
  "--" ++ hdr ++ "\n  "
       ++ info spec
       ++ "\n"
  where
    hdr =
      case last $ optName spec of
        '=' -> optName spec ++ "<arg>"
        _   -> optName spec