mathgenealogy 1.1.0 → 1.1.1
raw patch · 3 files changed
+44/−20 lines, 3 filesdep +safe
Dependencies added: safe
Files
- Extract.hs +22/−7
- Main.hs +17/−11
- mathgenealogy.cabal +5/−2
Extract.hs view
@@ -24,25 +24,40 @@ import qualified Data.Text.Lazy as T import qualified Data.ByteString.Lazy.Char8 as B import Control.Applicative+import Safe(headMay,tailMay) import Entry + openURL x = return . T.pack =<< getResponseBody =<< simpleHTTP (getRequest x) getTags :: Text -> IO [Tag Text] getTags url = parseTags <$> openURL (T.unpack url) parseEntry :: [Tag Text]- -> Entry+ -> Maybe Entry parseEntry tags = - Entry (scientist tags) - (graduationInfo tags)- (advisors tags)+ let msc = scientist tags in+ case msc of+ Nothing -> Nothing+ Just sc -> Just $+ Entry sc (graduationInfo tags) (advisors tags) -scientist :: [Tag Text] -> Text+scientist :: [Tag Text] -> Maybe Text scientist tags = - let TagText sc = removeClutter $ head $ tail $ head $ sections (~== "<h2 style") tags in- decodeUtf8 $ B.pack $ T.unpack sc + let t = removeClutter <$> do + r <- headMay (sections (~== "<h2 style") tags)+ r2 <- tailMay r+ headMay r2+-- let TagText sc = removeClutter $ headMay +-- $ tailMay +-- $ headMay +-- $ sections (~== "<h2 style") tags in+--+ in+ case t of+ Just (TagText sc) -> Just $ decodeUtf8 $ B.pack $ T.unpack sc + Nothing -> Nothing graduationInfo :: [Tag Text] -> Maybe GraduationInfo
Main.hs view
@@ -70,16 +70,18 @@ , keepDotFile = False -- , graphvizArgs = " -Tpdf -Gcharset=utf8 " &= typ "<graphviz parameters>" &= opt " -Tpdf -Gcharset=utf8 " , graphvizArgs = " -Gcharset=utf8 " &= typ "<graphviz parameters>" -- &= opt " -Gcharset=utf8 "- , onlyDotFile = False &= help "Only create .dot file"+ , onlyDotFile = False &= help "Only create the GraphViz '.dot' file" , verbose = False &= help "Print data to terminal." , includeTheses= False &= help "Include PhD thesis in output"- , outputFile = enum [ FilePDF &= help "create PDF file"+ , outputFile = enum [ FilePDF &= help "create PDF file (default)" , FilePNG &= help "create PNG file" , FileSVG &= help "create SVG 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"]+ } &= summary "Mathematics Genealogy Visualizer (C) 2010-2012 Peter Robinson thaldyron@gmail.com" + &= details[ "Run the program with a start-URL, for example:"+ ,"# mathgenealogy http://genealogy.math.ndsu.nodak.edu/id.php?id=18231"+ ,"This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. See the GNU General Public License (version 2) for more details."+ ] -- | GraphViz style attributes for edges and nodes. -- See: http://hackage.haskell.org/packages/archive/graphviz/2999.12.0.4/doc/html/Data-GraphViz-Attributes.html@@ -106,7 +108,7 @@ gvExecutable <- (do m <- findExecutable "dot" if m == Nothing - then throw (userError "Error - Couldn't find 'dot' program. Did you install graphviz?")+ then throw $ userError "Error - Couldn't find 'dot' program. Did you install graphviz?" else return (fromJust m)) let traverseEntries :: [Text] -> IO [Entry]@@ -118,10 +120,10 @@ `liftM` downloadEntry url threadDelay 1000000 if verbose args - then print e- else do - putStr $ show c ++ " "- hFlush stdout+ then print e+ else do + putStr $ show c ++ " "+ hFlush stdout let newUrls = urlAdvisors e traverseEntries' (c+1) (e:acc) (url:prevUrls) ((newUrls L.\\ prevUrls) ++ urls)@@ -158,5 +160,9 @@ downloadEntry :: Text -> IO Entry-downloadEntry = liftM parseEntry . getTags +downloadEntry t = do + res <- parseEntry <$> getTags t+ case res of+ Nothing -> throw $ userError "Error parsing fetched data. Did you provide a valid URL to an existing math-genealogy entry?"+ Just r -> return r
mathgenealogy.cabal view
@@ -1,6 +1,6 @@ Name: mathgenealogy -Version: 1.1.0+Version: 1.1.1 Synopsis: Discover your (academic) ancestors! @@ -21,8 +21,10 @@ . for more options. Requires GraphViz (in particular the /dot/ program) to run. . - /Changes in 1.1.0:/+ /Changes in 1.1.1:/ .+ * provide error message when given invalid start URL+ . * documentation and code cleanup . /Changes in 1.0.0:/@@ -73,6 +75,7 @@ , containers >= 0.4 && <0.6 , tagsoup >= 0.12.6 && <0.13 , HTTP >= 4000.1.2 && <5000+ , safe >= 0.3.3 && <0.5 Main-Is: Main.hs Other-modules: Graph , Extract