diff --git a/src/GraphType.hs b/src/GraphType.hs index db5d990..d17bb5a 100644 --- a/src/GraphType.hs +++ b/src/GraphType.hs @@ -1,6 +1,7 @@ module Main where import Parse (parseFiles) +import OptionParser import Language.Haskell.Exts import Data.Generics.PlateData (universeBi) @@ -9,23 +10,15 @@ import Data.List import Data.Maybe import Control.Monad --- | Drawing depth -data Depth = Inf | Limit Int - --- TODO: --- * Add CL options for: --- ** Specifying input file(s) --- ** Specifying drawing depth --- ** Specifying root ADT --- ** Output file name main = do - let files = [ "../example/Test01.hs", "../example/Test02.hs" ] + (Mode depth output, root, files) <- getOpts types <- parseFiles files - let graph = buildGraph types Inf "Organization" - writeFile "output.dot" graph + let graph = buildGraph types depth root + writeFile output graph -- | Builds dependency graph starting with datatype declaration `root'. -- Recursively expands all user-defined `types' referenced from `root', up to `depth' +-- TODO: use depth buildGraph types depth root = showDot $ do -- Allow links that end on cluster boundaries diff --git a/src/OptionParser.hs b/src/OptionParser.hs new file mode 100644 index 0000000..b972c51 --- /dev/null +++ b/src/OptionParser.hs @@ -0,0 +1,45 @@ +module OptionParser + ( + Mode(..), + getOpts, + ) +where + +import System (getArgs) +import System.Exit +import System.Console.GetOpt +import Data.Maybe ( fromMaybe ) +import Control.Monad (when) + +data Flag + = Inf | Limit Int | Output FilePath | Help + deriving (Eq,Show) + +options :: [OptDescr Flag] +options = + [ Option ['d'] ["depth"] (OptArg getDepth "N") "Follow links up to this depth (default: infinite)", + Option ['o'] ["output"] (OptArg getOutput "file") "Name of the output file (default: output.dot)", + Option [] ["help"] (NoArg Help) "Show this help" ] + +getDepth Nothing = Inf +getDepth (Just s) = Limit ( read s ) + +getOutput Nothing = Output "output.dot" +getOutput (Just s) = Output s + +data Mode = Mode { depth :: Maybe Int, output :: String } +defaultMode = Mode Nothing "output.dot" + +update Inf m = m { depth = Nothing } +update (Limit n) m = m { depth = Just n } +update (Output f) m = m { output = f } + +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