diff --git a/Entry.hs b/Entry.hs --- a/Entry.hs +++ b/Entry.hs @@ -50,3 +50,8 @@ maybeShow (Just gi) = T.unpack gi maybeShow Nothing = "" +removeThesis :: Entry -> Entry +removeThesis e = e{ entryGraduationInfo = case (entryGraduationInfo e) of + Nothing -> Nothing + Just g -> Just g{gradThesis = Nothing}} + diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -19,8 +19,9 @@ import Data.GraphViz.Attributes.Complete import qualified Data.ByteString.Lazy.Char8 as B import qualified Data.List as L -import System +import System.Cmd(system) -- import System.IO.Error +import System.Exit import System.Directory import Data.Maybe import Data.Text.Lazy(Text) @@ -33,15 +34,31 @@ import Entry import Graph +data OutputType = PDF | PNG + deriving(Eq,Data,Typeable) +instance Show OutputType where + show PDF = ".pdf" + show PNG = ".png" + +outputTypeToGraphviz :: OutputType -> String +outputTypeToGraphviz PDF = " -Tpdf " +outputTypeToGraphviz PNG = " -Tpng " + + +instance Default OutputType where + def = PNG + -- command line arguments: data MathGenealogy = MathGenealogy { filePrefix :: String , keepDotFile :: Bool , graphvizArgs :: String - , noPDF :: Bool - , quiet :: Bool + , onlyDotFile :: Bool + , verbose :: Bool + , includeTheses:: Bool , startURL :: String + , outputType :: OutputType } deriving(Eq,Data,Typeable,Show) @@ -49,9 +66,12 @@ { startURL = def &= args &= typ "URL" , filePrefix = "output" &= typ "PREFIX" , keepDotFile = False - , graphvizArgs = " -Tpdf -Gcharset=utf8 " &= typ "" &= opt " -Tpdf -Gcharset=utf8 " - , noPDF = False - , quiet = False +-- , graphvizArgs = " -Tpdf -Gcharset=utf8 " &= typ "" &= opt " -Tpdf -Gcharset=utf8 " + , graphvizArgs = " -Gcharset=utf8 " &= typ "" -- &= opt " -Gcharset=utf8 " + , onlyDotFile = False &= help "Only create .dot file" + , verbose = False &= help "Print data to terminal." + , includeTheses= False &= help "Include PhD thesis in output" + , outputType = enum [PNG &= help "create PNG file",PDF &= help "create PDF file"] } &= summary "Mathematics Genealogy Visualizer" &= details[ "Run the program with a start-URL, for example:", "# mathgenealogy http://genealogy.math.ndsu.nodak.edu/id.php?id=18231"] @@ -74,19 +94,32 @@ main = do - MathGenealogy filePrefix keepDotFile graphvizArgs noPdf quiet startURL - <- cmdArgs mathGenealogy - when (null startURL) $ + args <- cmdArgs mathGenealogy + let targs = args + when (null $ startURL args) $ throw (userError "Missing start-URL. Run 'mathgenealogy --help' for help.") gvExecutable <- (do m <- findExecutable "dot" if m == Nothing - then throw (userError "Error - Couldn't find 'dot' program") + then throw (userError "Error - Couldn't find 'dot' program. Did you install graphviz?") else return (fromJust m)) + + let traverseEntries :: [Text] -> IO [Entry] + traverseEntries = traverseEntries' [] [] + where + traverseEntries' acc _ [] = return $ L.nub acc + traverseEntries' acc prevUrls (url:urls) = do + e <- (if includeTheses args then id else removeThesis) + `liftM` downloadEntry url + threadDelay 1000000 + when (verbose args) $ print e + let newUrls = urlAdvisors e + traverseEntries' (e:acc) (url:prevUrls) ((newUrls L.\\ prevUrls) ++ urls) + putStrLn "Downloading data..." - theGraph <- entryGraph <$> traverseEntries quiet [T.pack startURL] + theGraph <- entryGraph <$> traverseEntries [T.pack $ startURL args] putStrLn "done. :)" - let dotFileName = filePrefix ++ ".dot" + let dotFileName = filePrefix args ++ ".dot" putStr $ "Writing DOT-file " ++ dotFileName ++ "..." let output = printDotGraph $ graphToDot nonClusteredParams{ fmtNode = nodeAtt @@ -96,32 +129,22 @@ `catch` (\(e::IOException) -> do { print e ; throw e }) putStrLn "done. :)" - unless noPdf $ do + unless (onlyDotFile args) $ do putStr "Generating graphics file..." - let command = gvExecutable ++ " " ++ graphvizArgs ++ " " ++ dotFileName ++ " > " - ++ filePrefix ++ ".pdf" + let command = gvExecutable ++ " " ++ outputTypeToGraphviz (outputType args) ++ graphvizArgs args + ++ " " ++ dotFileName ++ " > " + ++ filePrefix args ++ show (outputType args) print command result <- system command when (isExitFailure result) $ do print $ "Error running the graphviz (dot) program. I tried: " ++ command throw $ userError "Existing." putStrLn "done. :)" - unless keepDotFile $ removeFile dotFileName + unless (keepDotFile args) $ removeFile dotFileName where isExitFailure (ExitFailure _) = True isExitFailure _ = False - -- TODO: Build the graph here? - traverseEntries :: Bool -> [Text] -> IO [Entry] - traverseEntries quiet = traverseEntries' [] [] - where - traverseEntries' acc _ [] = return $ L.nub acc - traverseEntries' acc prevUrls (url:urls) = do - e <- downloadEntry url - threadDelay 1000000 - unless quiet $ print e - let newUrls = urlAdvisors e - traverseEntries' (e:acc) (url:prevUrls) ((newUrls L.\\ prevUrls) ++ urls) downloadEntry :: Text -> IO Entry downloadEntry = liftM parseEntry . getTags diff --git a/mathgenealogy.cabal b/mathgenealogy.cabal --- a/mathgenealogy.cabal +++ b/mathgenealogy.cabal @@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.0.2 +Version: 1.0.0 Synopsis: Discover your (academic) ancestors! @@ -15,19 +15,25 @@ Description: A command line program for extracting data from the Mathematics Genealogy Project (). . + Find your entry at and + then use the URL as argument to mathgenealogy. For example, if Carl Gauss wanted to explore his academic ancestors, he would type . > mathgenealogy http://genealogy.math.ndsu.nodak.edu/id.php?id=18231 . - which will produce a directed acyclic graph in output.pdf - (). See + which produces the directed acyclic graph + . See . > mathgenealogy --help . for details. Requires GraphViz to run. . - /Changes in 0.0.2:/ + /Changes in 1.0.0:/ + * updated for GHC 7.6.1 + * choice between PDF and PNG output + * optional inclusion of PhD theses in output + /Changes in 0.1.0:/ . * fixed bug regarding trailing commas (thanks to A. Koessler) @@ -58,14 +64,15 @@ Executable mathgenealogy build-depends: base >= 4 && < 5 - , text >= 0.11 && <0.12 - , directory >= 1.1 && <1.2 - , haskell98 >= 1.1 && <1.2 + , text >= 0.11 && <0.13 + , directory >= 1.1 && <1.3 +-- , haskell98 >= 1.1 && <2.1 + , process >= 1.1 && < 1.2 , bytestring >= 0.9 && <1.0 , graphviz >= 2999.12 && <3000.0 , cmdargs >= 0.9.5 && <1.0.0 , fgl >= 5.4 && <5.5 - , containers >= 0.4 && <0.5 + , containers >= 0.4 && <0.6 , tagsoup >= 0.12.6 && <0.13 , HTTP >= 4000.1.2 && <5000 Main-Is: Main.hs