packages feed

bibdb 0.4.1 → 0.4.2

raw patch · 13 files changed

+769/−3 lines, 13 files

Files

bibdb.cabal view
@@ -1,5 +1,5 @@ name:                bibdb-version:             0.4.1+version:             0.4.2 category:            Text synopsis:            A database based bibliography manager for BibTeX homepage:            https://github.com/cacay/bibdb@@ -39,9 +39,25 @@    main-is:              Main.hs -  build-tools:          alex, happy+  other-modules:        Args+                        Bibliography+                        Reference -  other-modules:        Parser.Lexer, Parser.Parser+                        Database.Fetch+                        Database.ArXiv+                        Database.Dblp+                        Database.Doi+                        Database.Hal++                        Parser.AlexUserState+                        Parser.Location+                        Parser.Token+                        Parser.Lexer+                        Parser.Parser++                        Utility.Except++  build-tools:          alex, happy    build-depends:        base >= 4.6 && < 5,                         filepath >= 1 && < 2,
+ src/Args.hs view
@@ -0,0 +1,89 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Args+-- Description : Argument and option parsing+-- Maintainer  : coskuacay@gmail.com+-- Stability   : experimental+-----------------------------------------------------------------------------+module Args+  ( Job (..)+  , BibSize (..)+  , Stage (..)+  , jobParser+  ) where++import Options.Applicative++-- | A preprocessor job+data Job = Job+  { jobSource           :: FilePath+  , jobOutput           :: Maybe FilePath+  , jobBibSize          :: BibSize+  , jobStopAt           :: Stage+  , jobKeepIntermediate :: Bool+  }++-- | Processing stage+data Stage = Lexing | Parsing | Downloading | Output+  deriving (Eq, Ord, Show)++-- | Bibliography size+data BibSize = Condensed | Standard | Crossref+  deriving (Eq, Ord, Show)+++-- | Parse a job+jobParser :: Parser Job+jobParser = Job+  <$> argument str (metavar "FILE")+  <*> optional (strOption+      ( long "output"+     <> short 'o'+     <> metavar "FILE"+     <> help "Place the output into <FILE>"+      ))+  <*> bibSizeParser+  <*> stageParser+  <*> switch+      ( long "save-temps"+     <> short 't'+     <> help "Save intermediate forms"+      )++bibSizeParser :: Parser BibSize+bibSizeParser =+      flag Standard Condensed+      ( long "condensed"+     <> short 's'+     <> help "Generate condensed bibliography"+      )+  <|> flag Standard Crossref+      ( long "crossref"+     <> short 'c'+     <> help "Generate full bibliography with cross-references"+      )++stageParser :: Parser Stage+stageParser =+      flag completeRun Lexing+      ( long "lex"+     <> help "Lex only (output a token stream)"+      )+  <|> flag completeRun Parsing+      ( long "parse"+     <> help "Parse only (act as a pretty printer)"+      )+  <|> flag completeRun Downloading+      ( long "download"+     <> help "Download references but do not generate output"+      )+  <|> flag completeRun Output+      ( long "complete-run"+     <> help "Download references and produce output"+      )+  where+    completeRun :: Stage+    completeRun = Output+++
+ src/Bibliography.hs view
@@ -0,0 +1,48 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Bibliography+-- Description : Functions for renaming, sorting, and cleaning up bibliography+-- Maintainer  : coskuacay@gmail.com+-- Stability   : experimental+--+-- This module removes duplicates in a bibliography database, sorts+-- citations such that cross-referenced ones come after the referrers,+-- and renames citations according to the given rule table.+-----------------------------------------------------------------------------+module Bibliography (bibliography) where++import Control.Arrow ((&&&))++import Data.Maybe (mapMaybe)+import qualified Data.Map.Strict as Map+import qualified Data.Graph as Graph+import qualified Data.Tree as Tree++import Reference+++bibliography :: [(RefIdent, RefIdent)] -> [BibTeX] -> [BibTeX]+bibliography renames database =+  let databaseMap = Map.fromList $ map (bibIdent &&& id) database+      renamed = map (\(s, t) -> renameBib t $ databaseMap Map.! s) renames+      renamedMap = Map.fromList $ map (bibIdent &&& id) renamed+      allMap = Map.union renamedMap databaseMap+      all = Map.elems allMap+  in topsort $ reachable (map snd renames) all+++topsort :: [BibTeX] -> [BibTeX]+topsort bib = map ((\(bib, _, _) -> bib) . vertexMap) sorted+  where+    (g, vertexMap, _) = Graph.graphFromEdges $ map bibToNode bib+    sorted = Graph.topSort g++reachable :: [RefIdent] -> [BibTeX] -> [BibTeX]+reachable roots bib = map ((\(bib, _, _) -> bib) . vertexMap) reachableVertecies+  where+    (g, vertexMap, key) = Graph.graphFromEdges $ map bibToNode bib+    rootsVertex = mapMaybe key roots+    reachableVertecies = concatMap Tree.flatten (Graph.dfs g rootsVertex)++bibToNode :: BibTeX -> (BibTeX, RefIdent, [RefIdent])+bibToNode bib = (bib, bibIdent bib, crossrefs bib)
+ src/Database/ArXiv.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Database.ArXiv+-- Description : Communication protocols for arXiv+-- Maintainer  : coskuacay@gmail.com+-- Stability   : experimental+-----------------------------------------------------------------------------+module Database.ArXiv (fetchString) where++import qualified Data.ByteString.Char8 as ByteString++import Network.Curl.Download (openURIWithOpts)+import Network.Curl.Opts++import Args (BibSize (..))+import Reference++import Utility.Except+++fetchString :: BibSize -> SourceKey -> Exception String+fetchString size key = do+  res <- liftIO $ openURIWithOpts headers (getUrl size key)+  bs <- liftEither res+  return $ ByteString.unpack bs+  where+    headers = [ CurlFollowLocation True ]+++getUrl :: BibSize -> SourceKey -> String+getUrl size (SourceKey key) =+  "http://adsabs.harvard.edu/cgi-bin/bib_query?data_type=BIBTEX&arXiv:" ++ key+
+ src/Database/Dblp.hs view
@@ -0,0 +1,31 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Database.Dblp+-- Description : Communication protocols for dblp+-- Maintainer  : coskuacay@gmail.com+-- Stability   : experimental+-----------------------------------------------------------------------------+module Database.Dblp (fetchString) where++import Network.Curl.Download (openURIString)++import Args (BibSize (..))+import Reference++import Utility.Except+++fetchString :: BibSize -> SourceKey -> Exception String+fetchString size key = do+  res <- liftIO $ openURIString (getUrl size key)+  liftEither res+++getUrl :: BibSize -> SourceKey -> String+getUrl size (SourceKey key) =+  "http://dblp.uni-trier.de/rec/" ++ parseSize size ++ "/" ++ key ++ ".bib"+  where parseSize :: BibSize -> String+        parseSize Condensed = "bib0"+        parseSize Standard  = "bib1"+        parseSize Crossref  = "bib2"+
+ src/Database/Doi.hs view
@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Database.Doi+-- Description : Communication protocols for DOI+-- Maintainer  : coskuacay@gmail.com+-- Stability   : experimental+-----------------------------------------------------------------------------+module Database.Doi (fetchString) where++import qualified Data.ByteString.Char8 as ByteString++import Network.Curl.Download (openURIWithOpts)+import Network.Curl.Opts++import Args (BibSize (..))+import Reference++import Utility.Except+++fetchString :: BibSize -> SourceKey -> Exception String+fetchString size key = do+  res <- liftIO $ openURIWithOpts headers (getUrl size key)+  bs <- liftEither res+  return $ ByteString.unpack bs+  where+    headers = [ CurlFollowLocation True+              , CurlHttpHeaders ["Accept: application/x-bibtex"]+              ]+++getUrl :: BibSize -> SourceKey -> String+getUrl size (SourceKey key) = "http://dx.doi.org/" ++ key+
+ src/Database/Fetch.hs view
@@ -0,0 +1,49 @@++-----------------------------------------------------------------------------+-- |+-- Module      : Database.Fetch+-- Description : Communication protocols for databases+-- Maintainer  : coskuacay@gmail.com+-- Stability   : experimental+-----------------------------------------------------------------------------+module Database.Fetch (fetch, fetchAll) where++import Args (BibSize)+import Reference++import qualified Database.Doi as Doi+import qualified Database.Dblp as Dblp+import qualified Database.ArXiv as ArXiv+import qualified Database.Hal as Hal++import Utility.Except+++fetch :: BibSize -> Source -> Exception (RefIdent, [BibTeX])+fetch size source@(Source t key) = do+  liftIO $ putStrLn $ "Fetching " ++ show source+  bibstr <- fetchString size key+  case parseBibTeX bibstr of+    Left err -> throwError $ "Error: cannot parse server response:\n" ++ err+    Right bibtex@(h : _) -> return (bibIdent h, bibtex)+    Right _ -> throwError $ "Error: empty response from server"+  where+    fetchString :: BibSize -> SourceKey -> Exception String+    fetchString = case t of+      Doi -> Doi.fetchString+      Dblp -> Dblp.fetchString+      ArXiv -> ArXiv.fetchString+      Hal -> Hal.fetchString+      Inria -> \size key -> Hal.fetchString size (inriaToHalKey key)+      _ -> undefined++    inriaToHalKey :: SourceKey -> SourceKey+    inriaToHalKey (SourceKey key) = SourceKey ("inria-" ++ key)+++fetchAll :: BibSize -> [Source] -> Exception ([RefIdent], [BibTeX])+fetchAll size srcs = do+  results <- mapM (fetch size) srcs+  let (idents, bibs) = unzip results+  return (idents, concat bibs)+
+ src/Database/Hal.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Database.Hal+-- Description : Communication protocols for HAL and Inria+-- Maintainer  : coskuacay@gmail.com+-- Stability   : experimental+-----------------------------------------------------------------------------+module Database.Hal (fetchString) where++import qualified Data.ByteString.Char8 as ByteString++import Network.Curl.Download (openURIWithOpts)+import Network.Curl.Opts++import Args (BibSize (..))+import Reference++import Utility.Except+++fetchString :: BibSize -> SourceKey -> Exception String+fetchString size key = do+  res <- liftIO $ openURIWithOpts headers (getUrl size key)+  bs <- liftEither res+  return $ ByteString.unpack bs+  where+    headers = [ CurlFollowLocation True ]+++getUrl :: BibSize -> SourceKey -> String+getUrl size (SourceKey key) =+  "http://hal.inria.fr/" ++ key ++ "/bibtex"+
+ src/Parser/AlexUserState.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE TemplateHaskell #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Parser.AlexUserState+-- Description : Lexer extra state+-- Maintainer  : coskuacay@gmail.com+-- Stability   : experimental+-----------------------------------------------------------------------------+module Parser.AlexUserState+  ( -- * User state+    AlexUserState+  , alexInitUserState+    -- * Lenses+  , srcFile+  , prevStartCodes+  ) where++import Lens.Micro.TH (makeLenses)+++type StartCode = Int+++data AlexUserState = AlexUserState+  { _srcFile        :: FilePath+  , _prevStartCodes :: [StartCode]+  }++alexInitUserState :: AlexUserState+alexInitUserState = AlexUserState+  { _srcFile        = "<no file>"+  , _prevStartCodes = []+  }+++makeLenses ''AlexUserState+
+ src/Parser/Location.hs view
@@ -0,0 +1,174 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Parser.Location+-- Description : Source location and span information+-- Maintainer  : coskuacay@gmail.com+-- Stability   : experimental+-----------------------------------------------------------------------------+module Parser.Location+  (+    -- * Source location+    SrcLoc+  , makeSrcLoc+  , srcFile, srcAbs, srcLine, srcCol+    -- * Source span+  , SrcSpan+  , makeSrcSpan+  , srcLocSpan+  , makeSrcSpanLength, makeSrcSpanLengthEnd+  , mergeSrcSpan+  , spanFile, spanSLine, spanSCol, spanELine, spanECol+    -- * Types with location information+  , Located (..)+  , mergeLocated+  , Loc+  , makeLoc, unLoc+  ) where++import Text.PrettyPrint+import Text.PrettyPrint.HughesPJClass (Pretty (..), prettyShow)+++-- | Represents a single point within a file. Refer to 'locInvariant'.+data SrcLoc = SrcLoc+  { srcFile :: !FilePath -- ^ path to the source file+  , srcAbs  :: !Int      -- ^ absolute character offset+  , srcLine :: !Int      -- ^ line number, counting from 1+  , srcCol  :: !Int      -- ^ column number, counting from 1+  }+  deriving (Eq, Ord)++-- | Construct a 'SrcLoc' given the file, absolute character offset,+-- line number, and column number+makeSrcLoc :: FilePath -> Int -> Int -> Int -> SrcLoc+makeSrcLoc = SrcLoc++locInvariant :: SrcLoc -> Bool+locInvariant s = srcAbs s > 0 && srcLine s > 0 && srcCol s > 0+++-- | Delimits a portion of a text file. The end position is defined+-- to be the column /after/ the end of the span. That is, a span of+-- (1,1)-(1,2) is one character long, and a span of (1,1)-(1,1) is+-- zero characters long.+data SrcSpan = SrcSpan+  { spanFile  :: !FilePath+  , spanSLine :: !Int+  , spanSCol  :: !Int+  , spanELine :: !Int+  , spanECol  :: !Int+  }+  deriving (Eq, Ord)++-- | Construct a span using a start location and an end location.+-- Both locations need to have the same source file. Also note+-- 'spanInvariant'.+makeSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan+makeSrcSpan start end = SrcSpan+  { spanFile  = srcFile start+  , spanSLine = srcLine start+  , spanSCol  = srcCol start+  , spanELine = srcLine end+  , spanECol  = srcCol end+  }++-- | Construct a span using a start location and the number of characters+-- in the span. The span will start and end on the same line.+makeSrcSpanLength :: SrcLoc -> Int -> SrcSpan+makeSrcSpanLength s l = makeSrcSpan s s{ srcCol = l + srcCol s }++-- | Construct a span using an end location and the number of characters+-- in the span. The span will start and end on the same line. The given+-- length /must/ be less than the current position on the line.+makeSrcSpanLengthEnd :: SrcLoc -> Int -> SrcSpan+makeSrcSpanLengthEnd e l = makeSrcSpan e{ srcCol = srcCol e - l } e++-- | Create a 'SrcSpan' corresponding to a single point+srcLocSpan :: SrcLoc -> SrcSpan+srcLocSpan loc = makeSrcSpan loc loc++-- All 'SrcSpan' instances should satisfy this invariant+spanInvariant :: SrcSpan -> Bool+spanInvariant s = spanSLine s <= spanELine s && spanSCol s <= spanECol s+++{--------------------------------------------------------------------------+  Operations+--------------------------------------------------------------------------}++-- | Fuse two spans together. Both spans need to be in the same file.+mergeSrcSpan :: SrcSpan -> SrcSpan -> SrcSpan+mergeSrcSpan s1 s2 | s1 > s2 = mergeSrcSpan s2 s1+mergeSrcSpan s1 s2 = SrcSpan+  { spanFile  = spanFile s1+  , spanSLine = spanSLine s1+  , spanSCol  = spanSCol s1+  , spanELine = spanELine s2+  , spanECol  = spanECol s2+  }+++{--------------------------------------------------------------------------+  Located class+--------------------------------------------------------------------------}++-- | An object with an attached 'SrcSpan'+class Located t where+  location :: t -> SrcSpan++instance Located SrcSpan where+  location = id++instance Located (Loc a) where+  location (Loc s _) = s+++-- | Marge the 'SrcSpan's of two Located objects+mergeLocated :: (Located t1, Located t2) => t1 -> t2 -> SrcSpan+mergeLocated t1 t2 = mergeSrcSpan (location t1) (location t2)+++-- | Default way to attach location information+data Loc a = Loc SrcSpan a++makeLoc :: SrcSpan -> a -> Loc a+makeLoc = Loc++-- | Get the data out of a 'Loc'+unLoc :: Loc a -> a+unLoc (Loc _ a) = a+++{--------------------------------------------------------------------------+  Printing+--------------------------------------------------------------------------}++instance Pretty SrcLoc where+  pPrint (SrcLoc f _ l c) = text f <> colon <> pPrint l <> comma <> pPrint c++instance Pretty SrcSpan where+  pPrint s = text (spanFile s) <> colon <> start <> text "-" <> end+    where+      SrcSpan { spanSLine = sl, spanSCol = sc+              , spanELine = el, spanECol = ec } = s++      start :: Doc+      start = pPrint sl <> comma <> pPrint sc++      end :: Doc+      end | sl == el  = pPrint ec+          | otherwise = pPrint el <> comma <> pPrint ec++instance Pretty e => Pretty (Loc e) where+  pPrint l = pPrint (unLoc l) <+> parens (text "at" <+> pPrint (location l))+++instance Show SrcLoc where+  show = prettyShow++instance Show SrcSpan where+  show = prettyShow++instance Show e => Show (Loc e) where+  show l = show (unLoc l) ++ " (at " ++ show (location l) ++ ")"+
+ src/Parser/Token.hs view
@@ -0,0 +1,63 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Parser.Token+-- Description : Tokens generated by the lexer+-- Maintainer  : coskuacay@gmail.com+-- Stability   : experimental+-----------------------------------------------------------------------------+module Parser.Token+  ( Token (..)+  , Lexeme (..)+  , token+  ) where++import Parser.Location (SrcSpan, Located(..))++import Text.PrettyPrint+import Text.PrettyPrint.HughesPJClass (Pretty (..), prettyShow)+++data Token =+    TType String+  | TIdent String+  | TColon+  | TAs+  | TEof+  deriving (Eq, Ord)+++data Lexeme = Lexeme SrcSpan Token++token :: Lexeme -> Token+token (Lexeme _ t) = t++instance Located Lexeme where+  location (Lexeme s _) = s+++----------------------------------------------------------------------------+-- * Printing+----------------------------------------------------------------------------++instance Pretty Token where+  pPrint (TType t) = text "type" <> parens (text t)+  pPrint (TIdent id) = text "identifier" <> parens (text id)+  pPrint TColon = text ":"+  pPrint TAs = text "as"+  pPrint TEof = text "<EOF>"+++instance Pretty Lexeme where+  pPrint (Lexeme loc token) = pPrint token <+> text "at" <+> pPrint loc+++----------------------------------------------------------------------------+-- * Showing+----------------------------------------------------------------------------++instance Show Token where+  show = prettyShow++instance Show Lexeme where+  show = prettyShow+
+ src/Reference.hs view
@@ -0,0 +1,135 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Reference+-- Description : Data and functions related to references+-- Maintainer  : coskuacay@gmail.com+-- Stability   : experimental+-----------------------------------------------------------------------------+module Reference+  ( Source (..)+  , SourceType (..)+  , SourceKey (..)+  , RefIdent (..)+  , BibTeX (..)+  , parseBibTeX+  , renameBib+  , crossrefs+  ) where++import Data.Char (toLower)++import Text.PrettyPrint+import Text.PrettyPrint.HughesPJClass (Pretty (..), prettyShow)++import qualified Text.BibTeX.Entry as Entry+import Text.BibTeX.Parse (skippingLeadingSpace, file)+import Text.Parsec.Prim (parse)+++data Source = Source+  { sourceType :: SourceType+  , sourceKey  :: SourceKey+  }+  deriving (Eq, Ord)++data SourceType = Doi+                | Dblp+                | ArXiv+                | CiteSeerX+                | Hal+                | Inria+  deriving (Eq, Ord)++newtype SourceKey = SourceKey String+  deriving (Eq, Ord)+++newtype RefIdent = RefIdent String+  deriving (Eq, Ord)+++data BibTeX = BibTeX+  { bibType   :: String+  , bibIdent  :: RefIdent+  , bibFields :: [(String, String)]+  }+++renameBib :: RefIdent -> BibTeX -> BibTeX+renameBib new bib = bib {bibIdent = new}++crossrefs :: BibTeX -> [RefIdent]+crossrefs (BibTeX _ _ fields) =+  map (RefIdent . snd) (filter isCrossref fields)+  where+    isCrossref :: (String, String) -> Bool+    isCrossref (name, _) = map toLower name == "crossref"+++----------------------------------------------------------------------------+-- * Parsing+----------------------------------------------------------------------------++parseBibTeX :: String -> Either String [BibTeX]+parseBibTeX s = case parse (skippingLeadingSpace file) "" s of+  Left err -> Left (show err ++ "\n" ++ s)+  Right entries -> Right (map convert entries)+  where+    convert :: Entry.T -> BibTeX+    convert (Entry.Cons t id fields) = BibTeX t (RefIdent id) fields+++----------------------------------------------------------------------------+-- * Printing+----------------------------------------------------------------------------++instance Pretty Source where+  pPrint (Source t key) = pPrint t <> colon <> pPrint key++instance Pretty SourceType where+  pPrint Doi = text "DOI"+  pPrint Dblp = text "DBLP"+  pPrint ArXiv = text "arXiv"+  pPrint CiteSeerX = text "CiteSeerX"+  pPrint Hal = text "HAL"+  pPrint Inria = text "inria"++instance Pretty SourceKey where+  pPrint (SourceKey key) = text key+++instance Pretty RefIdent where+  pPrint (RefIdent id) = text id+++instance Pretty BibTeX where+  pPrint (BibTeX t id fields) =+    hang (char '@' <> text t <> lbrace <> pPrint id <> comma) 2+      (vcat $ punctuate comma $ map printField fields)+    $+$ (rbrace <> char '\n')+    where+      printField :: (String, String) -> Doc+      printField (name, value) = text name <+> equals <+> braces (text value)+++----------------------------------------------------------------------------+-- * Showing+----------------------------------------------------------------------------++instance Show Source where+  show = prettyShow++instance Show SourceType where+  show = prettyShow++instance Show SourceKey where+  show = prettyShow+++instance Show RefIdent where+  show = prettyShow+++instance Show BibTeX where+  show = prettyShow+
+ src/Utility/Except.hs view
@@ -0,0 +1,24 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Utility.Except+-- Description : Utility functions for exceptions in the `IO` monad+-- Maintainer  : coskuacay@gmail.com+-- Stability   : experimental+-----------------------------------------------------------------------------+module Utility.Except+  ( module Control.Monad.Except+  , MonadIO (..)+  , Exception+  , liftEither+  ) where+import Control.Monad.Except+import Control.Monad.IO.Class (MonadIO (..))+++type Exception = ExceptT String IO+++liftEither :: Monad m => Either e a -> ExceptT e m a+liftEither (Left e) = throwError e+liftEither (Right a) = return a+