diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright (c) 2009, Henning Thielemann + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * The names of contributors may not be used to endorse or promote + products derived from this software without specific prior + written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#! /usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/bibtex.cabal b/bibtex.cabal new file mode 100644 --- /dev/null +++ b/bibtex.cabal @@ -0,0 +1,60 @@ +Name: bibtex +Version: 0.0.1 +License: BSD3 +License-File: LICENSE +Author: Henning Thielemann +Maintainer: Henning Thielemann +Homepage: http://www.haskell.org/haskellwiki/BibTeX +Category: Text +Synopsis: Parse, format and processing BibTeX files +Description: + This package allows parsing, formatting and processing of BibTeX files. + BibTeX files are databases for literature for the natbib package + of the LaTeX typesetting system. +Tested-With: GHC==6.10.4 +Cabal-Version: >=1.6 +Build-Type: Simple +Source-Repository head + type: darcs + location: http://code.haskell.org/~thielema/bibtex/ + +Source-Repository this + type: darcs + location: http://code.haskell.org/~thielema/bibtex/ + tag: 0.0.1 + +Flag base2 + description: Choose the new smaller, split-up base package. + +Flag buildExamples + description: Build example executables + default: False + +Library + Build-Depends: + parsec >=2.1 && <2.2, + utility-ht >=0.0.5 && <0.1 + If flag(base2) + Build-Depends: + base >= 2 && <5 + Else + Build-Depends: + base >= 1.0 && < 2, + special-functors >=1.0 && <1.1 + + GHC-Options: -Wall + Hs-Source-Dirs: src + Exposed-Modules: + Text.BibTeX.Entry + Text.BibTeX.Format + Text.BibTeX.Parse + Text.LaTeX.Character + + +Executable publication-overview + If !flag(buildExamples) + Buildable: False + + GHC-Options: -Wall + Hs-source-dirs: src + Main-Is: Publications.hs diff --git a/src/Publications.hs b/src/Publications.hs new file mode 100644 --- /dev/null +++ b/src/Publications.hs @@ -0,0 +1,44 @@ +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 Data.Maybe (fromMaybe, ) +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") : + (("mastersthesis", Nothing), "thesis") : + (("phdthesis", Nothing), "thesis") : + [] + + +cite :: Entry.T -> String +cite entry = + "\\nocite" ++ + fromMaybe "" + (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/Text/BibTeX/Entry.hs b/src/Text/BibTeX/Entry.hs new file mode 100644 --- /dev/null +++ b/src/Text/BibTeX/Entry.hs @@ -0,0 +1,25 @@ +module Text.BibTeX.Entry where + +import Data.Char (toLower, ) +import Data.Tuple.HT (mapFst, ) + + +data T = + Cons { + entryType :: String, + identifier :: String, + fields :: [(String, String)] + } + deriving (Show) + +{- | +Convert the name style \"Surname, First name\" into \"First name Surname\". +-} +flipName :: String -> String +flipName name = + let (surname, firstName) = break (','==) name + in dropWhile (flip elem ", ") firstName ++ " " ++ surname + +lowerCaseFieldNames :: T -> T +lowerCaseFieldNames entry = + entry {fields = map (mapFst (map toLower)) $ fields entry} diff --git a/src/Text/BibTeX/Format.hs b/src/Text/BibTeX/Format.hs new file mode 100644 --- /dev/null +++ b/src/Text/BibTeX/Format.hs @@ -0,0 +1,36 @@ +module Text.BibTeX.Format where + +import qualified Text.BibTeX.Entry as Entry + +import Data.List (intersperse, ) +import Data.List.HT (switchR, ) + +import qualified Data.Char as Char + + +entry :: Entry.T -> String +entry (Entry.Cons entryType bibId items) = + let formatItem (name, value) = + " "++name++" = {"++value++"},\n" + in "@" ++ entryType ++ "{" ++ bibId ++ ",\n" ++ + concatMap formatItem items ++ + "}\n\n" + + +enumerate :: [String] -> String +enumerate = + switchR "" $ \xs0 lastWord0 -> + flip (switchR lastWord0) xs0 $ \xs1 lastWord1 -> + foldr + (\word -> (word ++) . (", " ++)) + (lastWord1 ++ " and " ++ lastWord0) xs1 + +authorList :: [String] -> String +authorList = + concat . intersperse " and " + +commaSepList :: [String] -> String +commaSepList = sepList ',' + +sepList :: Char -> [String] -> String +sepList sep = concat . intersperse (sep:" ") diff --git a/src/Text/BibTeX/Parse.hs b/src/Text/BibTeX/Parse.hs new file mode 100644 --- /dev/null +++ b/src/Text/BibTeX/Parse.hs @@ -0,0 +1,111 @@ +module Text.BibTeX.Parse where + +import qualified Text.BibTeX.Entry as Entry + +import Text.ParserCombinators.Parsec (Parser, (<|>), ) +import qualified Text.ParserCombinators.Parsec as Parsec +import qualified Data.Char as Char + +import Control.Monad (liftM, liftM2, liftM3, ) + +import Data.Maybe (catMaybes, ) +import Data.List.HT (chop, ) +import Data.String.HT (trim, ) + + +file :: Parser [Entry.T] +file = + fmap catMaybes $ + Parsec.many + (skippingSpace (fmap Just entry <|> fmap (const Nothing) comment)) + +comment :: Parser String +comment = + do Parsec.char '#' + fmap trim $ Parsec.manyTill Parsec.anyChar Parsec.newline + +entry :: Parser Entry.T +entry = + do Parsec.char '@' + entryType <- skippingSpace identifier + skippingSpace (Parsec.char '{') + bibId <- skippingSpace (bibIdentifier <|> return "") + skippingSpace (Parsec.char ',') + assigns <- assignment `Parsec.sepEndBy` skippingSpace (Parsec.char ',') + skippingSpace (Parsec.char '}') + return (Entry.Cons entryType bibId assigns) + + +assignment :: Parser (String, String) +assignment = + do field <- skippingSpace bibIdentifier + skippingSpace (Parsec.char '=') + val <- skippingSpace value + return (field, trim val) + +value :: Parser String +value = + Parsec.many1 Parsec.digit <|> + Parsec.between (Parsec.char '{') (Parsec.char '}') (texSequence '}') <|> + Parsec.between (Parsec.char '"') (Parsec.char '"') (texSequence '"') + +texSequence :: Char -> Parser String +texSequence closeChar = + liftM concat (Parsec.many (texBlock closeChar)) + +texBlock :: Char -> Parser String +texBlock closeChar = + liftM3 (\open body close -> open : body ++ close : []) + (Parsec.char '{') (texSequence '}') (Parsec.char '}') <|> + sequence + [Parsec.char '\\', + Parsec.oneOf "{}'`^&%\".,~# " <|> Parsec.letter] <|> + fmap (:[]) (Parsec.noneOf [closeChar]) + +identifier :: Parser String +identifier = + liftM2 (:) + Parsec.letter + (Parsec.many Parsec.alphaNum) + +bibIdentifier :: Parser String +bibIdentifier = + liftM2 (:) + Parsec.letter + (Parsec.many (Parsec.alphaNum <|> Parsec.oneOf "-_.")) + +{- | +Extends a parser, such that all trailing spaces are skipped. +It might be more comfortable to skip all leading zeros, +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. +-} +skippingSpace :: Parser a -> Parser a +skippingSpace p = + do x <- p + Parsec.skipMany Parsec.space + return x + + + +-- * 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==) diff --git a/src/Text/LaTeX/Character.hs b/src/Text/LaTeX/Character.hs new file mode 100644 --- /dev/null +++ b/src/Text/LaTeX/Character.hs @@ -0,0 +1,30 @@ +module Text.LaTeX.Character where + +import Data.List.HT (multiReplace, ) +import Data.Tuple.HT (swap, ) + + +toUnicodeString :: String -> String +toUnicodeString = multiReplace table + +fromUnicodeString :: String -> String +fromUnicodeString = + multiReplace (map swap table) + + +table :: [(String, String)] +table = + ("\\&", "&") : + ("\\~{}", "~") : + ("\\\"a", "ä") : + ("\\\"o", "ö") : + ("\\\"u", "ü") : + ("\\\"A", "Ä") : + ("\\\"O", "Ö") : + ("\\\"U", "Ü") : + ("\\ss{}", "ß") : + ("\\`e", "è") : + ("\\'e", "é") : + ("\\'a", "á") : + ("\\'{\\i}", "í") : + []