graphtype-0.2.0: src/OptionParser.hs

module OptionParser
  (
   Mode(..),
   getOpts,
  )
where

import System.Environment (getArgs)    
import System.Exit
import System.Console.GetOpt
import Data.Maybe ( fromMaybe )
import Control.Monad (when)
import Language.Haskell.Exts (Extension)

-- | Mode of operation
data Mode = Mode { output :: String -- ^ Name of the output file
                 , trim :: Bool -- ^ Trim trivial types/newtypes or not
                 , exts :: Maybe [Extension]
                 }

-- | Default mode: output to "output.dot", dont trim trivial types
defaultMode = Mode {output="output.dot", trim=False, exts=Nothing}

data Flag 
     = Output FilePath | Trim | Help | Extensions [Extension]
       deriving (Eq,Show)

options :: [OptDescr Flag]
options =
  [ Option ['o']        ["output"]  (OptArg getOutput "file") "Name of the output file (default: output.dot)",
    Option ['t']        ["trim"]    (NoArg Trim)    "Trim types/newtype that do not have references to other user-defined types",
    Option ['e']        ["exts"]    (ReqArg getExts "extensions") "Comma-separated list of extensions to enable when parsing sources",
    Option []           ["help"]    (NoArg Help)    "Show this help" ]

getOutput Nothing = Output "output.dot"
getOutput (Just s) = Output s

getExts exts = Extensions $ read $ "[" ++ exts ++ "]"

update (Output f) m      = m { output = f }
update Trim m            = m { trim = True }
update (Extensions es) m = m { exts = Just es }

getOpts :: IO (Mode, String, [FilePath])
getOpts = getArgs >>= \argv ->
  case getOpt Permute options argv of
       (o, (root:files), []  ) -> do when (Help `elem` o) (do putStrLn usage 
                                                              exitWith ExitSuccess)
                                     return (foldr update defaultMode o, root, files)
       (_, _, errs)      -> ioError (userError (concat errs ++ usage))
 where header = "Usage: graphtype [OPTION...] type_name file1.hs file2.hs ..."
       usage  = usageInfo header options