module Text.CSL.Input.Identifier.Internal where
import Control.Applicative ((<$>))
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (runResourceT)
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text as Text
import Database.Persist
import Database.Persist.TH
import Database.Persist.Sqlite
import Network.Curl.Download (openURIWithOpts)
import Network.Curl.Opts (CurlOption(CurlFollowLocation, CurlHttpHeaders))
import System.Directory (createDirectoryIfMissing)
import System.Process (runInteractiveCommand, system)
import System.IO (hGetContents, hClose)
import Text.CSL (Reference, readBiblioString, BibFormat(Bibtex, Json))
import Text.Printf
import qualified Paths_citation_resolve as Paths
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
WebCache
url String
content BS.ByteString
deriving Show
|]
type Resolver a = String -> IO (Either String a)
cached :: Resolver BS.ByteString -> Resolver BS.ByteString
cached resolver0 url = do
dbfn <- getDataFileName "reference.db3"
runResourceT $ withSqlitePool (Text.pack dbfn) 1 $ \pool -> do
flip runSqlPool pool $ runMigration migrateAll
mx <- flip runSqlPool pool $ do
selectFirst [WebCacheUrl ==. url] []
case mx of
Just x -> do
return $ Right $ webCacheContent $ entityVal x
Nothing -> do
ret <- liftIO $ resolver0 url
case ret of
Right content0 ->
flip runSqlPool pool $ do
insert $ WebCache
url content0
return ret
resolveBibtex :: String -> Resolver Reference
resolveBibtex src str = do
rs <- readBiblioString Bibtex str
case rs of
[r] -> return $ Right r
[] -> return $ Left $ src ++ " returned no reference."
_ -> return $ Left $ src ++ " returned multiple references."
readDOI :: Resolver Reference
readDOI doi = do
let
opts = [ CurlFollowLocation True
, CurlHttpHeaders ["Accept: text/bibliography; style=bibtex"]
]
url = "http://dx.doi.org/" ++ doi
res <- cached (openURIWithOpts opts) url
case res of
Left msg -> return $ Left msg
Right bs -> resolveBibtex url $ BS.unpack bs
readArXiv :: Resolver Reference
readArXiv arXiv = do
let
opts = [ CurlFollowLocation True]
url = "http://adsabs.harvard.edu/cgi-bin/bib_query?data_type=BIBTEX&arXiv:" ++ arXiv
res <- cached (openURIWithOpts opts) url
case res of
Left msg -> return $ Left msg
Right bs -> resolveBibtex url $ BS.unpack bs
readISBN :: Resolver Reference
readISBN isbn = do
let
opts = [ CurlFollowLocation True ]
url = printf "http://xisbn.worldcat.org/webservices/xid/isbn/%s?method=getMetadata&format=xml&fl=*"
isbn
res <- cached (openURIWithOpts opts) url
case res of
Left msg -> return $ Left msg
Right bs -> do
xsltfn <- getDataFileName "isbn2bibtex.xsl"
writeFile xsltfn xsl
(hIn,hOut,_,_) <- runInteractiveCommand $ printf "xsltproc %s -" xsltfn
BS.hPutStr hIn bs
hClose hIn
str <- hGetContents hOut
resolveBibtex url str
where
xsl = "<?xml version=\"1.0\"?>\n<xsl:stylesheet xmlns:xsl=\"http://www.w3.org/1999/XSL/Transform\" xmlns:wc=\"http://worldcat.org/xid/isbn/\" version=\"1.0\">\n <xsl:output method=\"text\" omit-xml-declaration=\"yes\" indent=\"no\"/>\n <xsl:template match=\"wc:isbn\">\n <code>\n @BOOK{CiteKeyGoesHere,\n AUTHOR = \"<xsl:value-of select=\"@author\"/>\",\n TITLE = \"<xsl:value-of select=\"@title\"/>\",\n PUBLISHER = \"<xsl:value-of select=\"@publisher\"/>\",\n ADDRESS = \"<xsl:value-of select=\"@city\"/>\",\n YEAR =\"<xsl:value-of select=\"@year\"/>\"}\n</code>\n </xsl:template>\n</xsl:stylesheet>\n"
getDataFileName :: String -> IO String
getDataFileName fn = do
dd <- Paths.getDataDir
createDirectoryIfMissing True dd
Paths.getDataFileName fn