#!/usr/bin/runhugs
-- Time-stamp: <2007-06-25 08:23:31 hhalvors>

import IO
import System
import Char
import Monad
import Text.ParserCombinators.Parsec

eol = newline <|> (eof >> return '\n') 

tilEOL :: CharParser st String
tilEOL = manyTill (noneOf "\n") eol 

nonDigit :: CharParser st Char
nonDigit = noneOf ['x'|x <- [0..9]]

semicolonSep :: CharParser st ()
semicolonSep = skipMany1 (space <|> char ';')

authnames :: CharParser st [String]
authnames = do x <- sepBy1 word (char ',')
               return x

replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace [] _ _ = []
replace s find repl =
    if take (length find) s == find
        then repl ++ (replace (drop (length find) s) find repl)
        else [head s] ++ (replace (tail s) find repl)

commaword :: CharParser st String
commaword = do x <- word
               y <- (many (char ','))
               return (x ++ y) 

word :: CharParser st String
word = do x <- many1 alphaNum
          return x         

concatWith :: [a] -> (a -> String) -> String -> String
concatWith [] f s = ""
concatWith [x] f s = f x
concatWith (x:xs) f s = (concatWith [x] f s) ++ s ++ (concatWith xs f s) 

author :: CharParser st String
author = do x <- (sepBy1 commaword (char '-'))
            return (concatWith x (\y -> y) " ")

mungeAuthors :: CharParser st [(String,String)]
mungeAuthors = do spaces
                  x <- (sepBy1 author (string "; "))
                  eol 
                  return [("author",(concatWith x (\y -> y) " and "))]

title :: CharParser st [(String,String)]
title  = do spaces
            x <-  tilEOL 
            return [("title",x)]

abstract :: CharParser st [(String,String)]
abstract  = do spaces
               x <-  tilEOL 
               return [("abstract",x)]

journalName :: CharParser st String
journalName = do spaces
                 x <- manyTill anyChar (char '.')
                 return x

journalYear :: CharParser st String
journalYear = do skipMany ((satisfy isAlpha) <|> (char '-') <|> space)
                 x <- (manyTill digit (char ';'))
                 return (if (length x) == 4 then x 
                             else (if (x < "09") then ("20" ++ x) else ("19" ++ x)))

journalVolume :: CharParser st String
journalVolume = do spaces
                   x <- (many1 digit)
                   (manyTill anyChar (char ':'))
                   return x

mungeJournal :: CharParser st [(String,String)]
mungeJournal = do spaces
                  x <- journalName
                  y <- journalYear
                  z <- journalVolume
                  spaces     
                  w <- tilEOL   -- page numbers
                  return [("journal",(replace x "-" " ")),("year",y),("volume",z),("pages",w)]

keywords :: CharParser st [(String,String)]
keywords = do spaces
              x <- tilEOL
              return [("keywords",(replace x "-" ""))]

skipLine :: CharParser st [(String,String)]
skipLine = do x <- tilEOL
              return []

conditionalParse :: String -> CharParser st [(String,String)]
conditionalParse "TI" = title
conditionalParse "AU" = mungeAuthors
conditionalParse "SO" = mungeJournal
conditionalParse "AB" = abstract
conditionalParse "DE" = keywords
conditionalParse "DT" = entryType
conditionalParse "PB" = publisher
conditionalParse _ = skipLine

journalArticle :: CharParser st String
journalArticle = do string "Journal-Article"
                    return "article"

publisher :: CharParser st [(String,String)]
publisher = do spaces
               x <- manyTill anyChar (string " : ")  -- is it always a colon with surrounding spaces?
               y <- manyTill anyChar (string ", ")
               z <- manyTill digit eol
               return [("publisher",(replace x "-" " ")),("address",y),("year",z)]
                    
inCollection :: CharParser st String
inCollection = do string "Book-Chapter"
                  return "incollection"

book :: CharParser st String
book = do string "Monograph"
          return "book"

entryType :: CharParser st [(String,String)]
entryType = do spaces
               x <- (journalArticle <|> inCollection <|> book)
               spaces     
               return [("type",x)]

main :: IO ()
main = do args <- getArgs
          doDat (head args)
          return ()

bibLine :: CharParser st [(String,String)]
bibLine = do label <- manyTill (satisfy isAlpha) (char ':')
             x <- (conditionalParse label)
             return x

bibentry :: CharParser st [(String,String)]
bibentry = do skipMany (char '\n' >> return "")
              x <- many1 bibLine 
              return (foldl (++) [] x)

doDat filename =
    bracket (openFile filename ReadMode) hClose
                (\h -> do contents <- hGetContents h
                          case parse (many bibentry) "" contents of 
                            Left err -> putStr "Error: " >> print err 
                            Right cs -> putStr (concatWith cs convert "\n\n")) 

allButType :: [(String,String)] -> [(String,String)]
allButType x = [(y,z)|(y,z) <- x , y /= "type"] 

catatonic :: [(String,String)] -> String
catatonic [] = ""
catatonic [(x,y)] = x ++ "=" ++ "{" ++ y ++ "}"
catatonic (x:xs) = (catatonic [x]) ++ ",\n" ++ (catatonic xs) 

convert :: [(String,String)] -> String
convert x = "@" ++ (entrytype x) ++ "{" ++ "key" ++ ",\n"
            ++ (catatonic (allButType x)) ++ "\n}"

entrytype :: [(String,String)] -> String
entrytype x = head [v|(u,v) <- x,u == "type"]

-- end of file philbib.hs