diff --git a/bibtex.cabal b/bibtex.cabal --- a/bibtex.cabal +++ b/bibtex.cabal @@ -1,5 +1,5 @@ Name: bibtex -Version: 0.1.0.6 +Version: 0.1.0.7 License: BSD3 License-File: LICENSE Author: Henning Thielemann @@ -62,7 +62,7 @@ . > TeX capacity exceeded, sorry [save size=5000] Tested-With: GHC==6.12.3 -Cabal-Version: >=1.6 +Cabal-Version: >=1.10 Build-Type: Simple Extra-Source-Files: Makefile @@ -76,7 +76,7 @@ location: http://code.haskell.org/~thielema/bibtex/ Source-Repository this - tag: 0.1.0.6 + tag: 0.1.0.7 type: darcs location: http://code.haskell.org/~thielema/bibtex/ @@ -100,6 +100,7 @@ base >= 1.0 && < 2, special-functors >=1.0 && <1.1 + Default-Language: Haskell98 GHC-Options: -Wall Hs-Source-Dirs: src Exposed-Modules: @@ -109,24 +110,33 @@ Executable publication-overview - If !flag(buildExamples) + If flag(buildExamples) + Build-Depends: + bibtex, + parsec, + base + Else Buildable: False + Default-Language: Haskell98 GHC-Options: -Wall - Hs-source-dirs: src - Main-Is: Publications.hs + Main-Is: demo/Publications.hs Executable hackage-bibtex If flag(buildExamples) Build-Depends: + bibtex, + latex, old-time >=1.0 && <1.2, - Cabal >=1.6 && <1.24, - tar >=0.3 && <0.5, - utf8-string >=0.3.4 && <0.4, - bytestring >=0.9 && <0.11 + Cabal >=3.6 && <3.11, + tar >=0.3 && <0.6, + utf8-string >=0.3.4 && <2, + bytestring >=0.9 && <0.13, + utility-ht, + base Else Buildable: False + Default-Language: Haskell98 GHC-Options: -Wall - Hs-source-dirs: src - Main-Is: Hackage.hs + Main-Is: demo/Hackage.hs diff --git a/demo/Hackage.hs b/demo/Hackage.hs new file mode 100644 --- /dev/null +++ b/demo/Hackage.hs @@ -0,0 +1,168 @@ +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.Parsec as PkgP +import qualified Distribution.PackageDescription as PkgD +import qualified Distribution.Package as Pkg +import qualified Distribution.Types.PackageName as PkgN +import qualified Distribution.Verbosity as Verbosity +import Distribution.PackageDescription + (PackageDescription, ) +import Distribution.Package + (PackageIdentifier(..), ) +import Distribution.PackageDescription.Parsec + (parseGenericPackageDescription, ) +import Distribution.Simple.PackageDescription + (readGenericPackageDescription, ) +import System.Time (ClockTime(TOD), getClockTime, + toCalendarTime, toUTCTime, + CalendarTime, ctYear, ctMonth, ) + +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 Distribution.Pretty (prettyShow, ) +import Distribution.Utils.ShortText (fromShortText, ) + +import Data.String.HT (trim, ) +import Data.Tuple.HT (mapFst, ) +import Data.List.HT (switchL, switchR, ) +import Data.Char (toLower, isSpace, isAlpha, chr, ) +import qualified Data.List as List + + +{- | +See hackage-server:Distribution/Server/Pages/Package.hs +-} +packageURL :: PackageIdentifier -> String +packageURL pkgid = "/package/" ++ display pkgid + + +{- | +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 authors = + splitAuthorList $ fromShortText $ PkgD.author pkg + surname = + switchL "unknown" (\firstAuthor _ -> + switchR "" (\_ -> filter isAlpha) $ + words firstAuthor) $ + authors + pkgId = PkgD.package pkg + name = PkgN.unPackageName (Pkg.pkgName pkgId) + year = ctYear time + versionStr = prettyShow (Pkg.pkgVersion pkgId) + 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 (fromShortText (PkgD.synopsis pkg)) ++ "}") : + ("howpublished", + "\\url{http://hackage.haskell.org" ++ + packageURL (PkgD.package pkg) ++ "}") : + ("year", show year) : + ("month", show (ctMonth time)) : + ("version", versionStr) : + ("keywords", "Haskell, " ++ fromShortText (PkgD.category pkg)) : + ("subtype", "program") : + [] + +example :: IO () +example = + do now <- toCalendarTime =<< getClockTime + pkg <- readGenericPackageDescription Verbosity.silent "example.cabal" + putStrLn (Format.entry $ fromPackage now $ PkgD.packageDescription pkg) + + +{- | +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 -> String +fromTarEntry ent = + case (List.isSuffixOf ".cabal" $ TarEnt.entryPath ent, + TarEnt.entryContent ent) of + (True, TarEnt.NormalFile txt _size) -> + case PkgP.runParseResult + (parseGenericPackageDescription (B.toStrict txt)) of + (_, Right pkg) -> + Format.entry $ + fromPackage + (toUTCTime (TOD (fromIntegral $ TarEnt.entryTime ent) 0)) + (PkgD.packageDescription pkg) + (_, Left err) -> show err + _ -> "" + +main :: IO () +main = + Tar.foldEntries + (\entry cont -> putStrLn (fromTarEntry entry) >> cont) + (return ()) (IO.hPutStr IO.stderr . show) . + Tar.read =<< + B.getContents diff --git a/demo/Publications.hs b/demo/Publications.hs new file mode 100644 --- /dev/null +++ b/demo/Publications.hs @@ -0,0 +1,45 @@ +module Main where + +import qualified Text.BibTeX.Parse as Parse +import qualified Text.BibTeX.Entry as Entry +import qualified Text.ParserCombinators.Parsec as Parsec + +import qualified Data.Char as Char +import System.IO (hPutStrLn, stderr, ) + + +typeTable :: [((String, Maybe String), String)] +typeTable = + (("article", Just "reviewed"), "reviewedjournal") : + (("article", Just "popular"), "popular") : + (("article", Nothing), "journal") : + (("inproceedings", Just "reviewed"), "reviewedconference") : + (("inproceedings", Nothing), "conference") : + (("techreport", Nothing), "techreport") : + (("inbook", Just "program"), "program") : + (("misc", Just "program"), "program") : + (("misc", Just "talk"), "talk") : + (("mastersthesis", Nothing), "thesis") : + (("phdthesis", Nothing), "thesis") : + [] + + +cite :: Entry.T -> String +cite entry = + maybe + "% \\nocite" + ("\\nocite" ++ ) + (lookup + (map Char.toLower (Entry.entryType entry), + lookup "subtype" (Entry.fields (Entry.lowerCaseFieldNames entry))) + typeTable) ++ + "{" ++ Entry.identifier entry ++ "}" + + +main :: IO () +main = + do bib <- getContents + case Parsec.parse (Parsec.skipMany Parsec.space >> Parse.file) "stdin" bib of + Left errMsg -> hPutStrLn stderr (show errMsg) + Right entries -> + mapM_ (putStrLn . cite) entries diff --git a/src/Hackage.hs b/src/Hackage.hs deleted file mode 100644 --- a/src/Hackage.hs +++ /dev/null @@ -1,164 +0,0 @@ -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 -import qualified Distribution.Verbosity as Verbosity -import Distribution.PackageDescription - (PackageDescription, ) -import Distribution.Package - (PackageIdentifier(..), ) -import Distribution.PackageDescription.Parse - (parsePackageDescription, - readPackageDescription, ) -import System.Time (ClockTime(TOD), getClockTime, - toCalendarTime, toUTCTime, - CalendarTime, ctYear, ctMonth, ) - -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.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 - - -{- | -See hackage-server:Distribution/Server/Pages/Package.hs --} -packageURL :: PackageIdentifier -> String -packageURL pkgid = "/package/" ++ display pkgid - - -{- | -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 authors = - splitAuthorList $ PkgD.author pkg - surname = - 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) - 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 (Format.entry $ fromPackage now $ PkgD.packageDescription pkg) - - -{- | -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 -> String -fromTarEntry ent = - case (List.isSuffixOf ".cabal" $ TarEnt.entryPath ent, - TarEnt.entryContent ent) of - (True, TarEnt.NormalFile txt _size) -> - 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 - _ -> "" - -main :: IO () -main = - Tar.foldEntries - (\entry cont -> putStrLn (fromTarEntry entry) >> cont) - (return ()) (IO.hPutStr IO.stderr . show) . - Tar.read =<< - B.getContents diff --git a/src/Publications.hs b/src/Publications.hs deleted file mode 100644 --- a/src/Publications.hs +++ /dev/null @@ -1,45 +0,0 @@ -module Main where - -import qualified Text.BibTeX.Parse as Parse -import qualified Text.BibTeX.Entry as Entry -import qualified Text.ParserCombinators.Parsec as Parsec - -import qualified Data.Char as Char -import System.IO (hPutStrLn, stderr, ) - - -typeTable :: [((String, Maybe String), String)] -typeTable = - (("article", Just "reviewed"), "reviewedjournal") : - (("article", Just "popular"), "popular") : - (("article", Nothing), "journal") : - (("inproceedings", Just "reviewed"), "reviewedconference") : - (("inproceedings", Nothing), "conference") : - (("techreport", Nothing), "techreport") : - (("inbook", Just "program"), "program") : - (("misc", Just "program"), "program") : - (("misc", Just "talk"), "talk") : - (("mastersthesis", Nothing), "thesis") : - (("phdthesis", Nothing), "thesis") : - [] - - -cite :: Entry.T -> String -cite entry = - maybe - "% \\nocite" - ("\\nocite" ++ ) - (lookup - (map Char.toLower (Entry.entryType entry), - lookup "subtype" (Entry.fields (Entry.lowerCaseFieldNames entry))) - typeTable) ++ - "{" ++ Entry.identifier entry ++ "}" - - -main :: IO () -main = - do bib <- getContents - case Parsec.parse (Parsec.skipMany Parsec.space >> Parse.file) "stdin" bib of - Left errMsg -> hPutStrLn stderr (show errMsg) - Right entries -> - mapM_ (putStrLn . cite) entries