diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -14,7 +14,8 @@ (cd $(dir $<); pdflatex $(notdir $<); pdflatex $(notdir $<)) %-cite.tex: %.bib - ghc -e main src/Publications.hs < $< >$@ + ./dist/build/publication-overview/publication-overview < $< >$@ +# ghc -e main src/Publications.hs < $< >$@ %.bbl: %.aux tex/publications.bib (cd $(dir $<); bibtex $(notdir $*)) @@ -25,6 +26,6 @@ hackbib: hackage.bib -hackage.bib: $(HOME)/.cabal/packages/hackage.haskell.org/00-index.tar.gz - gunzip --stdout $< | ghc -e main src/Hackage.hs >$@ -# gunzip --stdout $< | hackage-bibtex >$@ +hackage.bib: $(HOME)/.cabal/packages/hackage.haskell.org/00-index.tar.gz src/Hackage.hs + gunzip --stdout $< | ./dist/build/hackage-bibtex/hackage-bibtex >$@ +# gunzip --stdout $< | ghc -e main src/Hackage.hs >$@ diff --git a/bibtex.cabal b/bibtex.cabal --- a/bibtex.cabal +++ b/bibtex.cabal @@ -1,5 +1,5 @@ Name: bibtex -Version: 0.0.3 +Version: 0.0.4 License: BSD3 License-File: LICENSE Author: Henning Thielemann @@ -44,6 +44,22 @@ The file @hackage.bib@ is written to the current directory. The program reads an uncompressed tar archive from standard input and writes the result bibliography file to standard output. + . + Note that @hackage.bib@ exceeds some limits of standard BibTeX and LaTeX: + There are currently much more than 5000 versions of packages, + the maximum my BibTeX can handle at once. + That is, you can use the bibliography file, + but you cannot cite all entries with @\\nocite*@. + If there are more than 26 uploads by the same author in a year, + the BibTeX style @alpha@ generates identifiers including curly braces + -- like @Thi2009\{@, + which interacts badly with LaTeX's handling of them. + If you reduce the Bibliography file to 5000 entries + and try to generate an overview of all entries with @\\nocite@, + -- @\\nocite{*}@, + then @pdflatex@ hits its limits: + . + > TeX capacity exceeded, sorry [save size=5000] Tested-With: GHC==6.10.4 Cabal-Version: >=1.6 Build-Type: Simple @@ -58,7 +74,7 @@ Source-Repository this type: darcs location: http://code.haskell.org/~thielema/bibtex/ - tag: 0.0.3 + tag: 0.0.4 Flag base2 description: Choose the new smaller, split-up base package. @@ -70,6 +86,7 @@ Library Build-Depends: parsec >=2.1 && <3.1, + containers >= 0.1 && <0.4, utility-ht >=0.0.5 && <0.1 If flag(base2) Build-Depends: @@ -102,6 +119,7 @@ old-time >=1.0 && <1.1, Cabal >=1.6 && <1.10, tar >=0.3 && <0.4, + utf8-string >=0.3.4 && <0.4, bytestring >=0.9 && <0.10 Else Buildable: False diff --git a/src/Hackage.hs b/src/Hackage.hs --- a/src/Hackage.hs +++ b/src/Hackage.hs @@ -1,5 +1,9 @@ module Main where +import qualified Text.BibTeX.Format as Format +import qualified Text.BibTeX.Entry as Entry +import qualified Text.LaTeX.Character as LaTeX + import qualified Distribution.PackageDescription.Parse as PkgP import qualified Distribution.PackageDescription as PkgD import qualified Distribution.Package as Pkg @@ -17,14 +21,17 @@ import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Entry as TarEnt +import qualified Data.ByteString.Lazy.UTF8 as UTF8 import qualified Data.ByteString.Lazy as B import qualified System.IO as IO import Distribution.Text (display, ) -import Data.List.HT (dropWhileRev, ) -import Data.Char (toLower, isSpace, isAlpha, chr, ) -import Data.Version (showVersion, ) +import Data.String.HT (trim, ) +import Data.Tuple.HT (mapFst, ) +import Data.List.HT (switchL, switchR, ) +import Data.Char (toLower, isSpace, isAlpha, chr, ) +import Data.Version (showVersion, ) import qualified Data.List as List @@ -35,68 +42,127 @@ packageURL pkgid = "/package/" ++ display pkgid -fromPackage :: CalendarTime -> PackageDescription -> String +{- | +Filter out parts in parentheses and e-mails addresses +-} +removeAnnotations :: String -> String +removeAnnotations "" = "" +removeAnnotations (c:cs) = + case c of + '(' -> removeAnnotations $ drop 1 $ dropWhile (')'/=) cs + '<' -> removeAnnotations $ drop 1 $ dropWhile ('>'/=) cs + _ -> c : removeAnnotations cs + +splitList :: String -> [String] +splitList = + let separate rest = ([], uncurry (:) $ recourse rest) + continue c rest = mapFst (c:) $ recourse rest + recourse str = + case str of + '/' : rest -> separate rest + '&' : rest -> separate rest + ',' : rest -> separate rest + c0:rest0@('a':'n':'d':c1:rest) -> + if isSpace c0 && isSpace c1 + then separate rest + else continue c0 rest0 + c:rest -> continue c rest + "" -> ([], []) + in uncurry (:) . recourse + +splitAuthorList :: String -> [String] +splitAuthorList = + map (\author -> + case author of + "..." -> "others" + "et al." -> "others" + _ -> author) . + filter (not . null) . + map trim . + splitList . + -- remove numbers, quotation marks ... + filter (\c -> isAlpha c || isSpace c || elem c ".-'@/&,") . + removeAnnotations + +{- authors must be split with respect to ',', '/', '&' and ' and ' -} +fromPackage :: CalendarTime -> PackageDescription -> Entry.T fromPackage time pkg = - let author = - let str = dropWhile isSpace $ PkgD.author pkg - in case str of - '"' : t -> takeWhile ('"' /=) t - _ -> dropWhileRev isSpace $ takeWhile ('<' /=) str + let authors = + splitAuthorList $ PkgD.author pkg surname = - let nameParts = words author - in if null nameParts - then "" - else filter isAlpha $ last nameParts + switchL "unknown" (\firstAuthor _ -> + switchR "" (\_ -> filter isAlpha) $ + words firstAuthor) $ + authors pkgId = PkgD.package pkg Pkg.PackageName name = Pkg.pkgName pkgId year = ctYear time versionStr = showVersion (Pkg.pkgVersion pkgId) - in unlines $ - ("@Misc{" ++ map toLower surname ++ show year ++ - name ++ "-" ++ versionStr ++ ",") : - map (\(field,value) -> " " ++ field ++ " = {" ++ value ++ "},") ( - ("author", author) : - ("title", "{" ++ name ++ ": " ++ PkgD.synopsis pkg ++ "}") : - ("howpublished", - "\\url{http://hackage.haskell.org" ++ - packageURL (PkgD.package pkg) ++ "}") : - ("year", show year) : - ("month", show (ctMonth time)) : - ("version", versionStr) : - ("keywords", "Haskell, " ++ PkgD.category pkg ) : - ("subtype", "program") : - []) ++ - "}" : + bibId = + map toLower surname ++ show year ++ + name ++ "-" ++ versionStr + in Entry.Cons "Misc" bibId $ + ("author", + if null authors + then "unknown" + else Format.authorList $ + map LaTeX.fromUnicodeString authors) : + ("title", + "{" ++ name ++ ": " ++ + LaTeX.fromUnicodeString (PkgD.synopsis pkg) ++ "}") : + ("howpublished", + "\\url{http://hackage.haskell.org" ++ + packageURL (PkgD.package pkg) ++ "}") : + ("year", show year) : + ("month", show (ctMonth time)) : + ("version", versionStr) : + ("keywords", "Haskell, " ++ PkgD.category pkg ) : + ("subtype", "program") : [] example :: IO () example = do now <- toCalendarTime =<< getClockTime pkg <- readPackageDescription Verbosity.silent "example.cabal" - putStrLn (fromPackage now (PkgD.packageDescription pkg)) + putStrLn (Format.entry $ fromPackage now $ PkgD.packageDescription pkg) -fromTarEntry :: Tar.Entry -> String +{- | +This decodes UTF-8 but in contrast to UTF8.toString +it handles invalid characters like Latin-1 ones. +This way we can also cope with many texts that contain actually Latin-1. +-} +decodeUTF8orLatin :: B.ByteString -> String +decodeUTF8orLatin = + List.unfoldr (\bstr -> + flip fmap (UTF8.uncons bstr) $ \(c, rest) -> + if c==UTF8.replacement_char + then (chr $ fromIntegral $ B.head bstr, B.tail bstr) + else (c,rest)) + + +fromTarEntry :: Tar.Entry -> B.ByteString fromTarEntry ent = if List.isSuffixOf ".cabal" (TarEnt.entryPath ent) then case TarEnt.entryContent ent of TarEnt.NormalFile txt _size -> - case parsePackageDescription - (map (chr . fromIntegral) (B.unpack txt)) of + UTF8.fromString $ + case parsePackageDescription (decodeUTF8orLatin txt) of PkgP.ParseOk _ pkg -> + Format.entry $ fromPackage (toUTCTime (TOD (fromIntegral $ TarEnt.entryTime ent) 0)) (PkgD.packageDescription pkg) PkgP.ParseFailed msg -> show msg - _ -> "" - else "" + _ -> B.empty + else B.empty main :: IO () main = Tar.foldEntries (\entry cont -> - putStrLn (fromTarEntry entry) >> cont) + B.putStrLn (fromTarEntry entry) >> cont) (return ()) (IO.hPutStr IO.stderr) . Tar.read =<< B.getContents diff --git a/src/Text/BibTeX/Format.hs b/src/Text/BibTeX/Format.hs --- a/src/Text/BibTeX/Format.hs +++ b/src/Text/BibTeX/Format.hs @@ -14,7 +14,7 @@ " "++name++" = {"++value++"},\n" in "@" ++ entryType ++ "{" ++ bibId ++ ",\n" ++ concatMap formatItem items ++ - "}\n\n" + "}\n" enumerate :: [String] -> String diff --git a/src/Text/LaTeX/Character.hs b/src/Text/LaTeX/Character.hs --- a/src/Text/LaTeX/Character.hs +++ b/src/Text/LaTeX/Character.hs @@ -1,17 +1,79 @@ -module Text.LaTeX.Character where +module Text.LaTeX.Character ( + toUnicodeString, + fromUnicodeString, + table, + ) where -import Data.List.HT (multiReplace, ) -import Data.Tuple.HT (swap, ) +-- import Data.List.HT (multiReplace, ) +import Data.Tuple.HT (mapSnd, ) +import Data.Char (isLetter, chr, ord, ) +import qualified Data.Map as Map +{- | +Replace LaTeX macros for special characters +by Unicode characters in a lazy way. +-} toUnicodeString :: String -> String -toUnicodeString = multiReplace table +toUnicodeString = + filter (not . flip elem "{}") . + toUnicodeStringCore +{- +toUnicodeString = + multiReplace table +-} +toUnicodeStringCore :: String -> String +toUnicodeStringCore "" = "" +toUnicodeStringCore (c:cs) = + case c of + '\\' -> + let getArgument "" = ("", "") + getArgument (a:argsuffix) = + if a/='{' + then ([a], argsuffix) + else + {- + this does not support nested curly braces, + however, I have no argument with braces in my dictionary + -} + let (argstr, suffix) = break ('}'==) argsuffix + in (argstr, drop 1 suffix) + translateInvocation = do + (macro,(arg,rest)) <- + case cs of + [] -> Nothing + b:bs -> Just $ + if elem b "'`^\"~" + then ([b], getArgument bs) + else mapSnd getArgument $ + span isLetter cs + code <- Map.lookup (macro,arg) toMap + return (code, rest) + in case translateInvocation of + Just (code,rest) -> code : toUnicodeStringCore rest + Nothing -> c : toUnicodeStringCore cs + '$' -> + let (math, rest) = break ('$'==) cs + in parseMathString math ++ toUnicodeStringCore (drop 1 rest) + _ -> c : toUnicodeStringCore cs + +parseMathString :: String -> String +parseMathString "" = "" +parseMathString (c:cs) = + if c/='\\' + then c : parseMathString cs + else let (ident,rest) = span isLetter cs + in maybe ('\\':ident) (:[]) + (Map.lookup ident mathMap) ++ + parseMathString rest + fromUnicodeString :: String -> String fromUnicodeString = - multiReplace (map swap table) - + concatMap (\c -> Map.findWithDefault [c] c fromMap) +-- multiReplace (map swap table) +{-# DEPRECATED table "use toUnicodeString or fromUnicodeString" #-} table :: [(String, String)] table = ("\\&", "&") : @@ -27,4 +89,163 @@ ("\\'e", "é") : ("\\'a", "á") : ("\\'{\\i}", "í") : + ("\\'u", "ú") : + ("\\'U", "Ú") : + ("\\o{}", "ø") : + ("\\O{}", "Ø") : + ("\\oe{}", "œ") : + ("\\OE{}", "Œ") : + ("\\ae{}", "æ") : + ("\\AE{}", "Æ") : + ("\\l{}", "ł") : + ("\\L{}", "Ł") : + ("\\c{c}", "ç") : + ("\\c{C}", "Ç") : + ("\\~a", "ã") : + ("\\~A", "Ã") : [] + + +fromMap :: Map.Map Char String +fromMap = + Map.fromList + (do (base, variants) <- accents + (accent, code) <- variants + return (chr code, '\\':accent:'{':base:'}':"")) + `Map.union` + Map.fromList + (map (\(ident, code) -> (chr code, "\\"++ident++"{}")) specialChars) + `Map.union` + Map.fromList + -- curly braces around dollars assert that no $$ can occur in the output + (map (\(ident, code) -> (chr code, "{$\\"++ident++"$}")) mathChars) + `Map.union` + Map.fromList + (map (\c -> (c, '\\':c:[])) escapedChars) + + +toMap :: Map.Map (String, String) Char +toMap = + Map.fromList + (do (base, variants) <- accents + (accent, code) <- variants + return (([accent], [base]), chr code)) + `Map.union` + Map.fromList + (map (\(ident, code) -> ((ident, ""), chr code)) specialChars) + `Map.union` + Map.fromList + (map (\c -> (('\\':c:[], ""), c)) escapedChars) + + +accents :: [(Char, [(Char, Int)])] +accents = + ('A', ('`', 192) : ('\'', 193) : ('^', 194) : ('~', 195) : ('"', 196) : []) : + ('E', ('`', 200) : ('\'', 201) : ('^', 202) : ('"', 203) : []) : + ('I', ('`', 204) : ('\'', 205) : ('^', 206) : ('"', 207) : []) : + ('N', ('~', 209) : []) : + ('O', ('`', 210) : ('\'', 211) : ('^', 212) : ('~', 213) : ('"', 214) : []) : + ('U', ('`', 217) : ('\'', 218) : ('^', 219) : ('"', 220) : []) : + ('Y', ('"', 223) : ('\'', 221) : []) : + ('C', ('c', 199) : ('\'', 262) : ('^', 264) : ('.', 266) : ('v', 268) : []) : + ('S', ('c', 350) : ('\'', 346) : ('^', 348) : ('v', 352) : []) : + ('a', ('`', 224) : ('\'', 225) : ('^', 227) : ('"', 228) : []) : + ('e', ('`', 232) : ('\'', 233) : ('^', 234) : ('"', 235) : []) : + ('i', ('`', 236) : ('\'', 237) : ('^', 238) : ('"', 239) : []) : + ('n', ('~', 241) : []) : + ('o', ('`', 242) : ('\'', 243) : ('^', 244) : ('~', 245) : ('"', 246) : []) : + ('u', ('`', 249) : ('\'', 250) : ('^', 251) : ('"', 252) : []) : + ('y', ('"', 255) : ('\'', 253) : []) : + ('c', ('c', 231) : ('\'', 263) : ('^', 265) : ('.', 267) : ('v', 269) : []) : + ('s', ('c', 351) : ('\'', 347) : ('^', 349) : ('"', 223) : ('v', 353) : []) : + [] + +specialChars :: [(String, Int)] +specialChars = + ("cc", 231) : + ("cC", 199) : + ("aa", 229) : + ("AA", 197) : + ("i", 239) : + ("l", 321) : + ("L", 322) : + ("ss", 223) : + ("3", 223) : + ("o", 248) : + ("O", 216) : + ("ae", 230) : + ("AE", 198) : + ("S", 167) : + ("pounds", 163) : + ("euro", 8364) : + ("copyright", 169) : + + ("textbackslash", ord '\\') : + ("textasciitilde", ord '~') : + ("textasciicircum", ord '^') : + ("textless", ord '<') : + ("textgreater", ord '>') : + ("textdollar", ord '$') : + ("textexclamdown", 161) : + ("textquestiondown", 191) : + ("textquotedblleft", ord '"') : + [] + +mathMap :: Map.Map String Char +mathMap = + Map.fromList (map (\(name,code) -> (name, chr code)) mathChars) + +mathChars :: [(String, Int)] +mathChars = + ("Alpha", 913) : + ("Beta", 914) : + ("Gamma", 915) : + ("Delta", 916) : + ("Epsilon", 917) : + ("Zeta", 918) : + ("Eta", 919) : + ("Theta", 920) : + ("Iota", 921) : + ("Kappa", 922) : + ("Lambda", 923) : + ("Mu", 924) : + ("Nu", 925) : + ("Xi", 926) : + ("Omikron", 927) : + ("Pi", 928) : + ("Rho", 929) : + ("Sigma", 931) : + ("Tau", 932) : + ("Upsilon", 933) : + ("Phi", 934) : + ("Chi", 935) : + ("Psi", 936) : + ("Omega", 937) : + ("alpha", 945) : + ("beta", 946) : + ("gamma", 947) : + ("delta", 948) : + ("epsilon", 949) : + ("zeta", 950) : + ("eta", 951) : + ("theta", 952) : + ("iota", 953) : + ("kappa", 954) : + ("lambda", 955) : + ("mu", 956) : + ("nu", 957) : + ("xi", 958) : + ("omikron", 959) : + ("pi", 960) : + ("rho", 961) : + ("sigma", 963) : + ("tau", 964) : + ("upsilon", 965) : + ("phi", 966) : + ("chi", 967) : + ("psi", 968) : + ("omega", 969) : + [] + +escapedChars :: [Char] +escapedChars = "$%&_#{}"