doi (empty) → 0.0.1
raw patch · 5 files changed
+581/−0 lines, 5 filesdep +MissingHdep +asyncdep +base
Dependencies added: MissingH, async, base, bibtex, directory, filepath, haskeline, optparse-applicative, parsec, process, regex-base, regex-compat, regex-tdfa, safe, strict, tagsoup, temporary, time, transformers, urlencoded, utility-ht
Files
+ BibTeX.hs view
@@ -0,0 +1,209 @@+{- |+The parsers in this module also skip trailing spaces.+-}+module BibTeX (+ file,+ comment,+ entry,+ assignment,+ value,+ texSequence,+ texBlock,+ identifier,+ bibIdentifier,++ -- utility functions+ skippingSpace,+ skippingLeadingSpace,++ splitCommaSepList,+ splitAuthorList,+ splitSepList,+ ) where++import qualified Text.BibTeX.Entry as Entry++import qualified Text.ParserCombinators.Parsec.Token as T+import qualified Text.ParserCombinators.Parsec.Language as L+import qualified Text.ParserCombinators.Parsec as Parsec+import Text.ParserCombinators.Parsec+ (CharParser, Parser,+ (<|>), alphaNum, digit, letter, char, noneOf, oneOf,+ between, many, many1, sepEndBy, )++import Control.Monad (liftM, liftM2, liftM3, )++import Data.List.HT (chop, )+import Data.Maybe+++lexer :: T.TokenParser st+lexer =+ T.makeTokenParser $ L.emptyDef {+ L.commentLine = "%",+ L.identStart = alphaNum,+ L.identLetter = alphaNum+ }+++identifier, comma, equals :: CharParser st String+identifier = T.identifier lexer+comma = T.comma lexer+equals = T.symbol lexer "="++braces, lexeme :: CharParser st a -> CharParser st a+braces = T.braces lexer+lexeme = T.lexeme lexer++{- |+Beware that this and all other parsers do not accept leading spaces,+cf. 'skippingSpace'.+That is when encountering leading white spaces+the parser will just return an empty list.+If you want to parse a file that contains entirely of BibTeX data+you better call @skippingLeadingSpace file@ instead.+However, the @file@ parser is more combinable+and can be used for files that contain both BibTeX and other data+or it can be used for automated filetype checking.+-}+file :: Parser [Entry.T]+file = comment >> catMaybes <$> sepEndBy entry comment+++comment :: Parser String+comment = many $ noneOf "@"+++{- |+Parse a BibTeX entry like++> @article{author2010title,+> author = {Firstname Surname},+> title = {Title},+> year = 2010,+> month = jul,+> }++.+-}+entry :: Parser (Maybe Entry.T) -- could be onyl a comment+entry =+ do entryType <- char '@' >> identifier+ if entryType == "comment" then return Nothing+ else fmap Just $ braces $+ liftM2 (Entry.Cons entryType)+ (Parsec.try bibIdentifier)+ (comma >> sepEndBy assignment comma)++{- |+Parse an assignment like++> author = {Firstname Surname}++.+-}+assignment :: Parser (String, String)+assignment =+ liftM2 (,)+ bibIdentifier+ (equals >> value)++{- |+Parse a value like++> jul++or++> 2010++or++> {Firstname Surname}++or++> "Firstname Surname"++.+-}+value :: Parser String+value =+ lexeme (many1 letter) <|> -- for fields like: month = jul+ lexeme (many1 digit) <|> -- for fields like: year = 2010+ braces (texSequence '}') <|>+ lexeme (between (char '"') (char '"') (texSequence '"'))++{- |+Parse a sequence of 'texBlock's until the occurrence of a closing character.+The closing character is not part of the result.+-}+texSequence :: Char -> Parser String+texSequence closeChar =+ liftM concat (many (texBlock closeChar))++{- |+Parse a single character like @a@,+a LaTeX macro call like @\\alpha@+or a block enclosed in curly braces like @{\\\"{a}bc}@.+-}+texBlock :: Char -> Parser String+texBlock closeChar =+ liftM3 (\open body close -> open : body ++ close : [])+ (char '{') (texSequence '}') (char '}') <|>+ sequence+ [char '\\',+ oneOf "_{}$|'`^&%\".,~# " <|> letter] <|>+ fmap (:[]) (noneOf [closeChar])+++{- |+Parse a name of a BibTeX entry like @author2010title@.+-}+bibIdentifier :: Parser String+bibIdentifier =+ lexeme $+ liftM2 (:) (alphaNum <|> char '_') -- less restrictive to handle all the internet shit!+ (many (alphaNum <|> oneOf "&;:-_.?+/"))+++{- |+Extends a parser, such that all trailing spaces are skipped.+It might be more comfortable to skip all leading spaces,+but parser written that way are hard to combine.+This is so, since if you run two parsers in parallel+and both of them expect leading spaces,+then the parser combinator does not know+which one of the parallel parsers to choose.++See also: 'lexeme'.+-}+skippingSpace :: Parser a -> Parser a+skippingSpace p =+ do x <- p+ Parsec.skipMany Parsec.space+ return x++skippingLeadingSpace :: Parser a -> Parser a+skippingLeadingSpace p =+ Parsec.skipMany Parsec.space >> p+++-- * Convert contents of BibTeX fields into lists++{- |+Split a string at the commas and remove leading spaces.+-}+splitCommaSepList :: String -> [String]+splitCommaSepList = splitSepList ','++{- |+Split a string containing a list of authors in BibTeX notation.+-}+splitAuthorList :: String -> [String]+splitAuthorList =+ map unwords . chop ("and" ==) . words++splitSepList :: Char -> String -> [String]+splitSepList sep =+ map (dropWhile (' '==)) . chop (sep==)
+ DOI.hs view
@@ -0,0 +1,274 @@+{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}++module DOI+ where++import qualified BibTeX as B1+import Control.Arrow+import Control.Concurrent+import Control.Concurrent.Async+import Control.Monad+import Control.Monad.IO.Class+import Data.Bool+import Data.Char+import Data.Function+import Data.List+import Data.Maybe+import Data.Monoid+import Data.Ord+import Data.String.Utils hiding (join)+import Data.Time.Format+import Data.Time.LocalTime+import Data.URLEncoded+import Options.Applicative hiding (action)+import Safe+import System.Console.Haskeline+import System.Directory+import System.Environment+import System.Exit+import System.FilePath+import System.IO+import qualified System.IO.Strict as S+import System.IO.Temp+import System.Process+import Text.BibTeX.Entry+import Text.BibTeX.Format+import Text.HTML.TagSoup+import Text.Parsec.Prim hiding ((<|>))+import Text.Printf+import Text.Read+import Text.Regex+import Text.Regex.Base.RegexLike+import Text.Regex.TDFA++-- * hard coded global config (bad)+dst = "/home/data/promotion/Literatur"+-- ^ destination folder++pdfSubDir = "doi"+-- ^ subdirectory for PDFs++bibFile = dst </> "literatur.bib" +-- ^ BibTeX entries are appended to this file ++-- | Url of the bibsonomy scraper (e.g. their public version of self hosted)+-- needs to be install in ROOT app (tested on tomcat8)+-- > cd /tmp && wget http://dev.bibsonomy.org/maven2/org/bibsonomy/bibsonomy-scrapingservice/3.3.0/bibsonomy-scrapingservice-3.3.0.war && sudo mv bibsonomy-scrapingservice-3.3.0.war /var/lib/tomcat8/webapps/ROOT.war+bibsonomyUrl = if True then+ "http://scraper.bibsonomy.org/service?format=bibtex&selection=&url="+ else+ "http://localhost:8080/service?format=bibtex&selection=&"+ -- needs to be install in ROOT app (tested on tomcat8)+ -- cd /tmp && wget http://dev.bibsonomy.org/maven2/org/bibsonomy/bibsonomy-scrapingservice/3.3.0/bibsonomy-scrapingservice-3.3.0.war && sudo mv bibsonomy-scrapingservice-3.3.0.war /var/lib/tomcat8/webapps/ROOT.war++-- * The types and the program+ +data Options = Options+ { oTarget :: String+ , oFile :: Maybe String+ , oKey :: Maybe String }+ deriving Show++optP :: Parser Options+optP = Options+ <$> (on (<|>) (strArgument . metavar) "URL" "DOI")+ <*> optional (strOption+ ( short 'f'+ <> metavar "PATH"+ <> help "Path to possibly pre-existing pdf" ))+ <*> optional (strOption+ ( short 'k'+ <> help "Provide a BibTeX Key" ))++main :: IO ()+main = customExecParser (prefs showHelpOnError) (info (helper <*> optP) i) >>= action+ where i = fullDesc+ <> header "retrieve BibTeX information and PDFs from a DOI or URL" +++test4 = " @article{Armada_2007, title={A modified finite-lived American exchange option methodology applied to real options valuation}, volume={17}, ISSN={1044-0283}, url={http://dx.doi.org/10.1016/j.gfj.2006.05.006}, DOI={10.1016/j.gfj.2006.05.006}, number={3}, journal={Global Finance Journal}, publisher={Elsevier BV}, author={Armada, Manuel Rocha and Kryzanowski, Lawrence and Pereira, Paulo Jorge}, year={2007}, month={Mar}, pages={419\8211\&438}}\n"+++test = "http://www.sciencedirect.com/science/article/pii/S1044028306000603"+test2 ="http://dx.doi.org/10.1016/j.gfj.2006.05.006"+test3 = "http://dx.doi.org/10.2139/ssrn.1709599"+ +parseOrError name x y = either (error . unlines . (:[y]) . show) id $ parse x name y+parseBib name bib = f . parseOrError name (B1.skippingLeadingSpace $ B1.skippingSpace B1.file)+ . sr "^@comment" "comment" $ bib+ where f [x] = Just x+ f [] = Nothing -- todo: propagate error, but fail only+ -- if there are no bibtex entries at all (also from other+ -- sources)+ f x = error $ printf "BibTeX %s parser returns wrong number of entries:\n%s\n%sEOF\n" name (show x) bib++doiFromBibsonomy :: Maybe T -> String+doiFromBibsonomy b = f $ find ((=="doi") . fmap toLower . fst) =<< fmap fields b+ where f = fromMaybe (error $ printf "Bibsonomy returned no DOI:\n%s\n" $ maybe "" entry b)+ . (extractDoi . snd =<<)+ +existingKey Nothing = return ()+existingKey (Just key) = (isInfixOf key <$> readFile bibFile) >>= flip when+ (printf "Key '%s' already present in '%s'\n" key bibFile >> exitFailure)++-- | first arg: doi or url+-- second arg: filename for preexisting file (which will be moved to doi location)+-- or value for the 'file' field+action (Options raw path key) = do+ existingKey key+ let edoi = extractDoi raw+ url = maybe raw doiUrl edoi+ bibson <- async $ downloadBibTeX url bibsonomy+ doi <- fromMaybe (doiFromBibsonomy <$> wait bibson) $ return <$> edoi+ -- print bibson+ -- print doi + bibs <- (fmap catMaybes . mapM wait . (bibson:)) =<<+ mapM (async . downloadBibTeX (doiUrl doi)) [crossref2]+ -- crossref not as up-to-date e.g. for SSRN+ file <- maybeToList . fmap ((,) "file") <$> getFile doi path+ timestamp <- formatTime defaultTimeLocale "%FT%T" <$> getZonedTime+ let mod bib = bib { fields =+ fields bib ++ file ++ [("timestamp",timestamp)]+ , identifier = fromMaybe (identifier bib) key}+ str = entry $ mod $ merge bibs+ putStrLn str+ appendFile bibFile $ "\n" ++ str+++-- combine several bibtex entries into one. the result with contain+-- the fields of both entries and thus contain duplicates.+merge :: [T] -> T+merge xs = (headNote "empty list in 'merge'" xs) {+ fields = sortBy (comparing fst) $ nub $+ fmap (normalizeDoi . first (fmap toLower) . second strip) $ concatMap fields xs }++normalizeDoi (f,v) = (,) f $+ if f=="doi" then fromMaybe v $ extractDoi v+ else v++getFile :: String -- ^ DOI+ -> Maybe String -- ^ Existing File if available+ -> IO (Maybe FilePath)+getFile doi f = do e <- doesFileExist target+ if e then do pErr "File already exists: %s" target+ return $ Just filename+ else g f + where g (Just f) = do+ e <- doesFileExist f+ if e then withTarget (fmap Just . copyFile f)+ else do pErr "File %s does not exist. Using it literally." f+ return $ Just f+ g Nothing = do r <- selectLink . extractLinks =<< doi2html doi+ withTarget $ fmap join . forM r . downloadPdf+ filename = pdfSubDir </> sr "/" "SLASH" doi <.> "pdf"+ target = dst </> filename+ withTarget :: (String -> IO (Maybe ())) -> IO (Maybe FilePath)+ withTarget ac = do+ createDirectoryIfMissing True $ fst $ splitFileName target+ (fmap $ const filename) <$> ac target++extractDoi :: String -> Maybe String+extractDoi input = -- maybe (error $ printf "Could not extract DOI from '%s'" input)+ ((!!3).getAllTextSubmatches) <$>+ input =~~ "^(http://(dx\\.)?doi\\.org/|doi:)?([^./]+\\.[^/]+/.*)"++doiUrl doi = "http://dx.doi.org/" ++ doi+ +selectLink :: [String] -> IO (Maybe String)+selectLink = runInputT defaultSettings . f . fmap transformUrl+ where f [] = do+ r <- fromJust <$> getInputChar "No Pdf Link Found, leave empty? [y/N] "+ if r == 'y' then return Nothing+ else error "not implemented, use -f argument instead"+ f [x] = return $ Just x+ f xs = do liftIO $ sequence $ reverse $ zipWith (printf "%2d: %s\n\n")+ [(0::Int)..] ("(skip PDF download)":xs)+ either ((>> f xs) . liftIO . putStrLn)+ (return . selected)+ . readEither . fromJust =<< getInputLine "Select PDF: "+ where selected 0 = Nothing+ selected x = Just $ xs !! (pred x)+ transformUrl = sr "(.*jstor.*)" "\\1?acceptTC=true"+++pErr :: HPrintfType r => [Char] -> r+pErr x = hPrintf stderr $ "\n" ++ x ++ "\n\n"++extractLinks = mapMaybe mPdf . fmap (fromAttrib "href" . head)+ . sections (~== "<a href>") . parseTags++mPdf x = x =~~ "[^#].*pdf.*" :: Maybe String+mPdf2 x = (headNote "empty list in 'mPdf2'")+ <$> matchRegex (mkRegexWithOpts "^[^#].*pdf.*" False False) x++-- | get Location header+-- doi2url url = either (error.show) f <$> simpleHTTP (getRequest url) +-- where f = fromMaybe (error $ "No Location Header in "++ url ) . findHeader HdrLocation++downloadBibTeX url (name,io) = do+ pErr "Downloading %s BibTeX for %s" name url+ a <- io url+ print a+ return $ parseBib name a :: IO (Maybe T)++bibsonomy = (,) "Bibsonomy" $ \url -> do+ readProcess2 "curl"+ ["-L"+ , bibsonomyUrl+ ++ export (importList [("url", url)])+ ]+ ""++readProcess2 a b c = do pErr $ sr "%" "%%" $ showCommandForUser a b+ readProcess a b c+ +crossref = (,) "CrossRef" $ \url -> do+ readProcess2 "curl"+ (["-LH", "Accept: text/bibliography; style=bibtex", url])+ ""+ +crossref2 = (,) "CrossRef" $ \url -> do+ readProcess2 "curl"+ (["-LH", "Accept: application/x-bibtex", url])+ ""++uA = "Mozilla/5.0 (Windows NT 6.3; rv:36.0) Gecko/20100101 Firefox/36.0"++doi2html :: String -> IO String+doi2html url = do+ pErr "Downloading Website for %s" url+ withSystemTempFile "wget_doi" $ \file h -> do+ putStrLn file+ hClose h+ readProcess "wget"+ (["-U",uA,"-O",file,"-k"+ ] ++ [doiUrl url])+ ""+ S.readFile file+ -- readProcess "curl"+ -- ["-LH",uA+ -- ,doiUrl url]+ -- ""+ ++downloadPdf :: String -> String -> IO (Maybe ())+downloadPdf target url = do+ pErr "Downloading PDF from for %s" url+ callProcess "wget"+ ["-U",uA+ ,"-O",target+ ,url]+ ft <- readProcess "xdg-mime"+ ["query","filetype",target]+ ""+ if isInfixOf "pdf" $ fmap toLower ft+ then return $ Just ()+ else do pErr "Filetype not PDF: %s" ft+ return Nothing++-- | substitute regex +sr :: String -- ^ regex+ -> String -- ^ replacement+ -> String -- ^ input+ -> String+sr regex replacement input = subRegex (mkRegex regex) input replacement
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2017 Johannes Gerer++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ doi.cabal view
@@ -0,0 +1,74 @@+name: doi+version: 0.0.1+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: LICENSE+maintainer: Johannes Gerer <oss@johannesgerer.com>+stability: Experimental+homepage: http://johannesgerer.com/doi+synopsis: Automatic Bibtex and fulltext of scientific articles+description:+ Extract Bibtex entries and download fulltext of scientific articles automatically for a given DOI or URL+ .+ See <https://github.com/johannesgerer/doi Readme> on Github.+category: Database+author: Johannes Gerer++library+ exposed-modules:+ DOI+ BibTeX+ build-depends:+ MissingH >=1.4.0.1 && <1.5,+ async >=2.1.1 && <2.2,+ base >=4.9.0.0 && <4.10,+ bibtex >=0.1.0.6 && <0.2,+ directory >=1.2.6.2 && <1.3,+ filepath >=1.4.1.0 && <1.5,+ haskeline >=0.7.3.0 && <0.8,+ optparse-applicative >=0.12.1.0 && <0.13,+ parsec >=3.1.11 && <3.2,+ process >=1.4.2.0 && <1.5,+ regex-base >=0.93.2 && <0.94,+ regex-compat >=0.95.1 && <0.96,+ regex-tdfa >=1.2.2 && <1.3,+ safe >=0.3.10 && <0.4,+ strict >=0.3.2 && <0.4,+ tagsoup ==0.14.*,+ temporary >=1.2.0.4 && <1.3,+ time >=1.6.0.1 && <1.7,+ transformers >=0.5.2.0 && <0.6,+ utility-ht >=0.0.12 && <0.1,+ urlencoded >=0.4.1 && <0.5+ default-language: Haskell2010++executable doi+ main-is: main.hs+ build-depends:+ MissingH >=1.4.0.1 && <1.5,+ async >=2.1.1 && <2.2,+ base >=4.9.0.0 && <4.10,+ bibtex >=0.1.0.6 && <0.2,+ directory >=1.2.6.2 && <1.3,+ filepath >=1.4.1.0 && <1.5,+ haskeline >=0.7.3.0 && <0.8,+ optparse-applicative >=0.12.1.0 && <0.13,+ parsec >=3.1.11 && <3.2,+ process >=1.4.2.0 && <1.5,+ regex-base >=0.93.2 && <0.94,+ regex-compat >=0.95.1 && <0.96,+ regex-tdfa >=1.2.2 && <1.3,+ safe >=0.3.10 && <0.4,+ strict >=0.3.2 && <0.4,+ tagsoup ==0.14.*,+ temporary >=1.2.0.4 && <1.3,+ time >=1.6.0.1 && <1.7,+ transformers >=0.5.2.0 && <0.6,+ utility-ht >=0.0.12 && <0.1,+ urlencoded >=0.4.1 && <0.5+ default-language: Haskell2010+ other-modules:+ BibTeX+ DOI+
+ main.hs view
@@ -0,0 +1,3 @@+module Main (DOI.main)+ where+import DOI