{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards, TupleSections  #-}

module TypedBibData where

import Control.Applicative hiding ((<|>),many)
import Control.Monad
import Control.Monad.Trans
import Data.Char
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Tree
import Text.BibTeX.Entry as Entry
import Text.BibTeX.Parse
import Data.Function
import Text.ParserCombinators.Parsek as Parsek


-------------------------------------
-- Bib Data manipulation

data Entry = Entry {
      Entry -> [Char]
kind :: String,
      Entry -> [([Char], [Char])]
authors :: [(String,String)],
      Entry -> [([Char], [Char])]
files :: [(String,String)],      -- ^ name, type
      Entry -> [([Char], [Char])]
seeAlso :: [(String,String)],
      Entry -> [([Char], [Char])]
otherFields :: [(String,String)]
    } deriving (Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> [Char]
(Int -> Entry -> ShowS)
-> (Entry -> [Char]) -> ([Entry] -> ShowS) -> Show Entry
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Entry -> ShowS
showsPrec :: Int -> Entry -> ShowS
$cshow :: Entry -> [Char]
show :: Entry -> [Char]
$cshowList :: [Entry] -> ShowS
showList :: [Entry] -> ShowS
Show, Entry -> Entry -> Bool
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
/= :: Entry -> Entry -> Bool
Eq, Eq Entry
Eq Entry =>
(Entry -> Entry -> Ordering)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Entry)
-> (Entry -> Entry -> Entry)
-> Ord Entry
Entry -> Entry -> Bool
Entry -> Entry -> Ordering
Entry -> Entry -> Entry
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Entry -> Entry -> Ordering
compare :: Entry -> Entry -> Ordering
$c< :: Entry -> Entry -> Bool
< :: Entry -> Entry -> Bool
$c<= :: Entry -> Entry -> Bool
<= :: Entry -> Entry -> Bool
$c> :: Entry -> Entry -> Bool
> :: Entry -> Entry -> Bool
$c>= :: Entry -> Entry -> Bool
>= :: Entry -> Entry -> Bool
$cmax :: Entry -> Entry -> Entry
max :: Entry -> Entry -> Entry
$cmin :: Entry -> Entry -> Entry
min :: Entry -> Entry -> Entry
Ord)


renderTex :: ShowS
renderTex = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
"{}")

sanitizeIdent :: ShowS
sanitizeIdent = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
c -> (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
".-_?+") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
                (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map ((\Char
c -> if Char -> Bool
isSpace Char
c then Char
'_' else Char
c) (Char -> Char) -> (Char -> Char) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toLower)


parseBib :: Parser [T]
parseBib = Parser [T] -> Parser [T]
forall a. Parser a -> Parser a
skippingSpace (Parser [T] -> Parser [T]) -> Parser [T] -> Parser [T]
forall a b. (a -> b) -> a -> b
$ Parser [T] -> Parser [T]
forall a. Parser a -> Parser a
skippingLeadingSpace Parser [T]
Text.BibTeX.Parse.file

-- >>> test
-- Left [([("\"{\"",Just '\n')],"satisfy"),([("\"\\\\\"",Just '\n')],"satisfy"),([],"satisfy"),([("\"}\"",Just '\n')],"satisfy")]

test :: ParseResult Char [Char]
test = Parser Char [Char]
-> ParseMethod Char [Char] [Char]
-> [Char]
-> ParseResult Char [Char]
forall s a r.
Parser s a -> ParseMethod s a r -> [s] -> ParseResult s r
parse (Bool -> Parser Char [Char]
pAuthBlock Bool
True) ParseMethod Char [Char] [Char]
forall s a. ParseMethod s a a
longestResult
 [Char]
"{students of the\nUtrecht University Generic Programming class}"
 -- "Ba, Jimmy"


pAuthLastFirst :: Parser Char ([Char], [Char])
pAuthLastFirst = do
  [Char]
lst <- Parser Char [Char]
pAuthName
  Parser Char ()
forall {p :: * -> *}. (SymbolOf p ~ Char, IsParser p) => p ()
spaces
  [Char]
_ <- [Char] -> Parser Char [Char]
forall (p :: * -> *).
(IsParser p, SymbolOf p ~ Char) =>
[Char] -> p [Char]
string [Char]
","
  Parser Char ()
forall {p :: * -> *}. (SymbolOf p ~ Char, IsParser p) => p ()
spaces
  [Char]
frst <- Parser Char [Char]
pAuthName
  ([Char], [Char]) -> Parser Char ([Char], [Char])
forall a. a -> Parser Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
frst,[Char]
lst)

pAuthFirstLast :: Parser Char ([Char], [Char])
pAuthFirstLast = do
  [Char]
frst <- Parser Char [Char]
pAuthName
  [Char]
_ <- Parser Char Char -> Parser Char [Char]
forall a. Parser Char a -> Parser Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char Char
Parser Char (SymbolOf (Parser Char))
forall {p :: * -> *}.
(SymbolOf p ~ Char, IsParser p) =>
p (SymbolOf p)
space
  [Char]
lst <- Parser Char [Char]
pAuthNamePart
  ([Char], [Char]) -> Parser Char ([Char], [Char])
forall a. a -> Parser Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
frst,[Char]
lst)

pAuthLastOnly :: Parser Char ([Char], [Char])
pAuthLastOnly = do
  [Char]
lst <- Parser Char [Char]
pAuthNamePart
  ([Char], [Char]) -> Parser Char ([Char], [Char])
forall a. a -> Parser Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"",[Char]
lst)

pAuth :: Parser Char ([Char], [Char])
pAuth :: Parser Char ([Char], [Char])
pAuth = Parser Char ([Char], [Char])
pAuthFirstLast Parser Char ([Char], [Char])
-> Parser Char ([Char], [Char]) -> Parser Char ([Char], [Char])
forall a. Parser Char a -> Parser Char a -> Parser Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char ([Char], [Char])
pAuthLastFirst Parser Char ([Char], [Char])
-> Parser Char ([Char], [Char]) -> Parser Char ([Char], [Char])
forall a. Parser Char a -> Parser Char a -> Parser Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char ([Char], [Char])
pAuthLastOnly

pAuthors :: Parser Char [([Char], [Char])]
pAuthors :: Parser Char [([Char], [Char])]
pAuthors = Parser Char ([Char], [Char])
pAuth Parser Char ([Char], [Char])
-> Parser Char [Char] -> Parser Char [([Char], [Char])]
forall {f :: * -> *} {a1} {a2}.
Alternative f =>
f a1 -> f a2 -> f [a1]
`Parsek.sepBy1` (Parser Char Char -> Parser Char [Char]
forall a. Parser Char a -> Parser Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char Char
Parser Char (SymbolOf (Parser Char))
forall {p :: * -> *}.
(SymbolOf p ~ Char, IsParser p) =>
p (SymbolOf p)
space Parser Char [Char] -> Parser Char [Char] -> Parser Char [Char]
forall a b. Parser Char a -> Parser Char b -> Parser Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Parser Char [Char]
forall (p :: * -> *).
(IsParser p, SymbolOf p ~ Char) =>
[Char] -> p [Char]
string [Char]
"and" Parser Char [Char] -> Parser Char [Char] -> Parser Char [Char]
forall a b. Parser Char a -> Parser Char b -> Parser Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Char Char -> Parser Char [Char]
forall a. Parser Char a -> Parser Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char Char
Parser Char (SymbolOf (Parser Char))
forall {p :: * -> *}.
(SymbolOf p ~ Char, IsParser p) =>
p (SymbolOf p)
space)
           Parser Char [([Char], [Char])]
-> Parser Char [([Char], [Char])] -> Parser Char [([Char], [Char])]
forall a. Parser Char a -> Parser Char a -> Parser Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [([Char], [Char])] -> Parser Char [([Char], [Char])]
forall a. a -> Parser Char a
forall (m :: * -> *) a. Monad m => a -> m a
return [([Char]
"",[Char]
"UnknownAuthor")]


pAuthName :: Parser Char [Char]
pAuthName :: Parser Char [Char]
pAuthName = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " ([[Char]] -> [Char]) -> Parser Char [[Char]] -> Parser Char [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char [Char]
pAuthNamePart Parser Char [Char] -> Parser Char [Char] -> Parser Char [[Char]]
forall {f :: * -> *} {a1} {a2}.
Alternative f =>
f a1 -> f a2 -> f [a1]
`sepBy1` Parser Char Char -> Parser Char [Char]
forall a. Parser Char a -> Parser Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char Char
Parser Char (SymbolOf (Parser Char))
forall {p :: * -> *}.
(SymbolOf p ~ Char, IsParser p) =>
p (SymbolOf p)
space)

pAuthNamePart :: Parser Char [Char]
pAuthNamePart :: Parser Char [Char]
pAuthNamePart =
  do [Char]
n <- [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> Parser Char [[Char]] -> Parser Char [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char [Char] -> Parser Char [[Char]]
forall a. Parser Char a -> Parser Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Bool -> Parser Char [Char]
pAuthBlock Bool
False)
     Bool -> Parser Char () -> Parser Char ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"and") ([Char] -> Parser Char ()
forall a. [Char] -> Parser Char a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"and is not a name")
     [Char] -> Parser Char [Char]
forall a. a -> Parser Char a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
n

pAuthBlock :: Bool -> Parser Char String
pAuthBlock :: Bool -> Parser Char [Char]
pAuthBlock Bool
allowSpace =
   (\Char
open [Char]
body Char
close -> Char
open Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
body [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
close Char -> ShowS
forall a. a -> [a] -> [a]
: []) (Char -> [Char] -> Char -> [Char])
-> Parser Char Char -> Parser Char ([Char] -> Char -> [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SymbolOf (Parser Char) -> Parser Char (SymbolOf (Parser Char))
forall {p :: * -> *}.
(IsParser p, Eq (SymbolOf p), Show (SymbolOf p)) =>
SymbolOf p -> p (SymbolOf p)
Parsek.char Char
SymbolOf (Parser Char)
'{') Parser Char ([Char] -> Char -> [Char])
-> Parser Char [Char] -> Parser Char (Char -> [Char])
forall a b. Parser Char (a -> b) -> Parser Char a -> Parser Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> Parser Char [[Char]] -> Parser Char [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char [Char] -> Parser Char [[Char]]
forall a. Parser Char a -> Parser Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Bool -> Parser Char [Char]
pAuthBlock Bool
True)) Parser Char (Char -> [Char])
-> Parser Char Char -> Parser Char [Char]
forall a b. Parser Char (a -> b) -> Parser Char a -> Parser Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SymbolOf (Parser Char) -> Parser Char (SymbolOf (Parser Char))
forall {p :: * -> *}.
(IsParser p, Eq (SymbolOf p), Show (SymbolOf p)) =>
SymbolOf p -> p (SymbolOf p)
Parsek.char Char
SymbolOf (Parser Char)
'}') Parser Char [Char] -> Parser Char [Char] -> Parser Char [Char]
forall a. Parser Char a -> Parser Char a -> Parser Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
   [Parser Char Char] -> Parser Char [Char]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
      [SymbolOf (Parser Char) -> Parser Char (SymbolOf (Parser Char))
forall {p :: * -> *}.
(IsParser p, Eq (SymbolOf p), Show (SymbolOf p)) =>
SymbolOf p -> p (SymbolOf p)
Parsek.char Char
SymbolOf (Parser Char)
'\\',
       [Char] -> Parser Char (SymbolOf (Parser Char))
forall {p :: * -> *}.
(SymbolOf p ~ Char, IsParser p) =>
[Char] -> p (SymbolOf p)
Parsek.oneOf [Char]
"{}'`^&%\".,~# " Parser Char Char -> Parser Char Char -> Parser Char Char
forall a. Parser Char a -> Parser Char a -> Parser Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char Char
Parser Char (SymbolOf (Parser Char))
forall {p :: * -> *}.
(SymbolOf p ~ Char, IsParser p) =>
p (SymbolOf p)
Parsek.letter] Parser Char [Char] -> Parser Char [Char] -> Parser Char [Char]
forall a. Parser Char a -> Parser Char a -> Parser Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
   (SymbolOf (Parser Char) -> Bool)
-> Parser Char [SymbolOf (Parser Char)]
forall (m :: * -> *).
IsParser m =>
(SymbolOf m -> Bool) -> m [SymbolOf m]
munch1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((if Bool
allowSpace then [Char]
"" else [Char]
"\n\t " ) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"{},")))


-- | When searching ignore special characters
project :: String -> String
project :: ShowS
project = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum

-- | Does a node contain a string (for search)
contains :: Entry -> String -> Bool
contains :: Entry -> [Char] -> Bool
contains Entry
t [Char]
needle = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [[Char]
needle [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` ShowS
project [Char]
txt | [Char]
txt <- Entry -> [Char]
findTitle Entry
t [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd (Entry -> [([Char], [Char])]
authors Entry
t)]

matchSearch :: Entry -> String -> Bool
matchSearch :: Entry -> [Char] -> Bool
matchSearch Entry
entry [Char]
pattern =  ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Entry -> [Char] -> Bool
contains Entry
entry) (ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
project ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
words [Char]
pattern)  

findCiteAuth :: Entry -> String
findCiteAuth :: Entry -> [Char]
findCiteAuth Entry {[Char]
[([Char], [Char])]
kind :: Entry -> [Char]
authors :: Entry -> [([Char], [Char])]
files :: Entry -> [([Char], [Char])]
seeAlso :: Entry -> [([Char], [Char])]
otherFields :: Entry -> [([Char], [Char])]
kind :: [Char]
authors :: [([Char], [Char])]
files :: [([Char], [Char])]
seeAlso :: [([Char], [Char])]
otherFields :: [([Char], [Char])]
..} = ShowS
renderTex ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ case (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd [([Char], [Char])]
authors of
      [] -> [Char]
"????"
      [[Char]
a] -> [Char]
a
      [[Char]
a,[Char]
b] -> [Char]
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" and " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
b
      [[Char]
a,[Char]
b,[Char]
c] -> [Char]
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" and " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
c
      ([Char]
a:[[Char]]
_) -> [Char]
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" et al."

findYear :: Entry -> String
findYear :: Entry -> [Char]
findYear = [Char] -> Entry -> [Char]
findField [Char]
"year" 

findTitle :: Entry -> String
findTitle :: Entry -> [Char]
findTitle = [Char] -> Entry -> [Char]
findField [Char]
"title"

findField :: String -> Entry -> String
findField :: [Char] -> Entry -> [Char]
findField [Char]
f Entry
t = [Char] -> Entry -> [[Char]]
findField' [Char]
f Entry
t [[Char]] -> ShowS
forall {a}. [a] -> a -> a
?? [Char]
"????"

eqField :: [Char] -> [Char] -> Bool
eqField :: [Char] -> [Char] -> Bool
eqField = [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Char] -> [Char] -> Bool) -> ShowS -> [Char] -> [Char] -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower)

findField' :: String -> Entry -> [String]
findField' :: [Char] -> Entry -> [[Char]]
findField' [Char]
f  Entry {[Char]
[([Char], [Char])]
kind :: Entry -> [Char]
authors :: Entry -> [([Char], [Char])]
files :: Entry -> [([Char], [Char])]
seeAlso :: Entry -> [([Char], [Char])]
otherFields :: Entry -> [([Char], [Char])]
kind :: [Char]
authors :: [([Char], [Char])]
files :: [([Char], [Char])]
seeAlso :: [([Char], [Char])]
otherFields :: [([Char], [Char])]
..} = (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd ((([Char], [Char]) -> Bool)
-> [([Char], [Char])] -> [([Char], [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
eqField [Char]
f) ([Char] -> Bool)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], [Char])]
otherFields)

findFirstAuthor :: Entry -> String
findFirstAuthor :: Entry -> [Char]
findFirstAuthor Entry{[Char]
[([Char], [Char])]
kind :: Entry -> [Char]
authors :: Entry -> [([Char], [Char])]
files :: Entry -> [([Char], [Char])]
seeAlso :: Entry -> [([Char], [Char])]
otherFields :: Entry -> [([Char], [Char])]
kind :: [Char]
authors :: [([Char], [Char])]
files :: [([Char], [Char])]
seeAlso :: [([Char], [Char])]
otherFields :: [([Char], [Char])]
..} = (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd [([Char], [Char])]
authors [[Char]] -> ShowS
forall {a}. [a] -> a -> a
?? [Char]
"UnknownAuthor"

findCite :: Entry -> [Char]
findCite Entry
t = Entry -> [Char]
findCiteAuth Entry
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Entry -> [Char]
findYear Entry
t
findNiceKey :: Entry -> [Char]
findNiceKey Entry
t = [Char] -> Entry -> [[Char]]
findField' [Char]
"forcedkey" Entry
t [[Char]] -> ShowS
forall {a}. [a] -> a -> a
?? 
                ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"_" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
sanitizeIdent ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Entry -> [Char]
findFirstAuthor Entry
t, [Char]
title, Entry -> [Char]
findYear Entry
t])
    where title :: [Char]
title = ((([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2) (Int -> Bool) -> ([Char] -> Int) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[Char]] -> [[Char]]) -> (Entry -> [[Char]]) -> Entry -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
sanitizeIdent ([[Char]] -> [[Char]]) -> (Entry -> [[Char]]) -> Entry -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words ([Char] -> [[Char]]) -> (Entry -> [Char]) -> Entry -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> [Char]
findTitle (Entry -> [[Char]]) -> Entry -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Entry
t) 
                   [[Char]] -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [a]
\\ [[Char]
"de",[Char]
"am",[Char]
"for",[Char]
"le",[Char]
"an",[Char]
"to",[Char]
"be",[Char]
"on",[Char]
"make",[Char]
"the",[Char]
"how",[Char]
"why",[Char]
"its",[Char]
"from",[Char]
"towards",[Char]
"does"])
                  [[Char]] -> ShowS
forall {a}. [a] -> a -> a
?? [Char]
"????"

findFullText :: Entry -> [[Char]]
findFullText Entry {[Char]
[([Char], [Char])]
kind :: Entry -> [Char]
authors :: Entry -> [([Char], [Char])]
files :: Entry -> [([Char], [Char])]
seeAlso :: Entry -> [([Char], [Char])]
otherFields :: Entry -> [([Char], [Char])]
kind :: [Char]
authors :: [([Char], [Char])]
files :: [([Char], [Char])]
seeAlso :: [([Char], [Char])]
otherFields :: [([Char], [Char])]
..} = (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst ([([Char], [Char])] -> [[Char]])
-> ([([Char], [Char])] -> [([Char], [Char])])
-> [([Char], [Char])]
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], [Char]) -> Bool)
-> [([Char], [Char])] -> [([Char], [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"pdf",[Char]
"ps"]) ([Char] -> Bool)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd) ([([Char], [Char])] -> [[Char]]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
files

addFile :: ([Char], [Char]) -> Entry -> Entry
addFile ([Char], [Char])
f (Entry {[Char]
[([Char], [Char])]
kind :: Entry -> [Char]
authors :: Entry -> [([Char], [Char])]
files :: Entry -> [([Char], [Char])]
seeAlso :: Entry -> [([Char], [Char])]
otherFields :: Entry -> [([Char], [Char])]
kind :: [Char]
authors :: [([Char], [Char])]
files :: [([Char], [Char])]
seeAlso :: [([Char], [Char])]
otherFields :: [([Char], [Char])]
..})= Entry {files :: [([Char], [Char])]
files = ([Char], [Char])
f([Char], [Char]) -> [([Char], [Char])] -> [([Char], [Char])]
forall a. a -> [a] -> [a]
:[([Char], [Char])]
files,[Char]
[([Char], [Char])]
kind :: [Char]
authors :: [([Char], [Char])]
seeAlso :: [([Char], [Char])]
otherFields :: [([Char], [Char])]
kind :: [Char]
authors :: [([Char], [Char])]
seeAlso :: [([Char], [Char])]
otherFields :: [([Char], [Char])]
..}

partitions :: [a -> Bool] -> [a] -> [[a]]
partitions :: forall a. [a -> Bool] -> [a] -> [[a]]
partitions [] [a]
l = [[a]
l]
partitions (a -> Bool
x:[a -> Bool]
xs) [a]
l = [a]
yes [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a -> Bool] -> [a] -> [[a]]
forall a. [a -> Bool] -> [a] -> [[a]]
partitions [a -> Bool]
xs [a]
no
    where ([a]
yes,[a]
no) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition a -> Bool
x [a]
l

entryToTree :: Entry.T -> Either String Entry
entryToTree :: T -> Either [Char] Entry
entryToTree Entry.Cons{[Char]
[([Char], [Char])]
entryType :: [Char]
identifier :: [Char]
fields :: [([Char], [Char])]
entryType :: T -> [Char]
identifier :: T -> [Char]
fields :: T -> [([Char], [Char])]
..} =
  do [([Char], [Char])]
authors <- [Char] -> Either [Char] [([Char], [Char])]
authorsToTree ((([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd [([Char], [Char])]
auths)
     Entry -> Either [Char] Entry
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Entry {[Char]
[([Char], [Char])]
kind :: [Char]
authors :: [([Char], [Char])]
files :: [([Char], [Char])]
seeAlso :: [([Char], [Char])]
otherFields :: [([Char], [Char])]
authors :: [([Char], [Char])]
otherFields :: [([Char], [Char])]
kind :: [Char]
files :: [([Char], [Char])]
seeAlso :: [([Char], [Char])]
..}
  where
    [[([Char], [Char])]
auths,[([Char], [Char])]
fils,[([Char], [Char])]
seeAlsos,[([Char], [Char])]
otherFields] = [([Char], [Char]) -> Bool]
-> [([Char], [Char])] -> [[([Char], [Char])]]
forall a. [a -> Bool] -> [a] -> [[a]]
partitions (([Char] -> ([Char], [Char]) -> Bool)
-> [[Char]] -> [([Char], [Char]) -> Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
k -> ([Char] -> [Char] -> Bool
eqField [Char]
k) ([Char] -> Bool)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst) [[Char]
"author",[Char]
"file",[Char]
"see"]) [([Char], [Char])]
fields
    kind :: [Char]
kind = [Char]
entryType
    ident :: [Char]
ident = [Char]
identifier
    files :: [([Char], [Char])]
files = [[Char] -> ([Char], [Char])
fileToTree [Char]
f | ([Char]
_,[Char]
fs) <- [([Char], [Char])]
fils, [Char]
f <- [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
";" [Char]
fs]
    seeAlso :: [([Char], [Char])]
seeAlso = [[Char] -> ([Char], [Char])
seeAlsoToTree [Char]
r | ([Char]
_,[Char]
rs) <- [([Char], [Char])]
seeAlsos, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rs, [Char]
r <- [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
";" [Char]
rs ]

treeToEntry :: Entry -> Entry.T
treeToEntry :: Entry -> T
treeToEntry t :: Entry
t@Entry {[Char]
[([Char], [Char])]
kind :: Entry -> [Char]
authors :: Entry -> [([Char], [Char])]
files :: Entry -> [([Char], [Char])]
seeAlso :: Entry -> [([Char], [Char])]
otherFields :: Entry -> [([Char], [Char])]
kind :: [Char]
authors :: [([Char], [Char])]
files :: [([Char], [Char])]
seeAlso :: [([Char], [Char])]
otherFields :: [([Char], [Char])]
..} = Entry.Cons{[Char]
[([Char], [Char])]
entryType :: [Char]
identifier :: [Char]
fields :: [([Char], [Char])]
fields :: [([Char], [Char])]
entryType :: [Char]
identifier :: [Char]
..}
   where fields :: [([Char], [Char])]
fields = ([Char]
"author", [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" and " [[Char]
first [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
last | ([Char]
first,[Char]
last) <- [([Char], [Char])]
authors]) ([Char], [Char]) -> [([Char], [Char])] -> [([Char], [Char])]
forall a. a -> [a] -> [a]
:
                  [([Char]
"file",[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
";" [[Char]
":" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
f [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
t | ([Char]
f,[Char]
t) <- [([Char], [Char])]
files]) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [([Char], [Char])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], [Char])]
files] [([Char], [Char])] -> [([Char], [Char])] -> [([Char], [Char])]
forall a. [a] -> [a] -> [a]
++
                  [([Char], [Char])]
otherFields [([Char], [Char])] -> [([Char], [Char])] -> [([Char], [Char])]
forall a. [a] -> [a] -> [a]
++
                  [([Char]
"see",[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
";" [[Char]
how [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
what | ([Char]
how,[Char]
what) <- [([Char], [Char])]
seeAlso]) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [([Char], [Char])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], [Char])]
seeAlso]
         entryType :: [Char]
entryType = [Char]
kind
         identifier :: [Char]
identifier = Entry -> [Char]
findNiceKey Entry
t 

fileToTree :: [Char] -> ([Char], [Char])
fileToTree :: [Char] -> ([Char], [Char])
fileToTree = \case
  (Char
':':[Char]
fs) -> ([Char]
f, [Char]
t)
    where ([Char]
f,Char
':':[Char]
t) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') [Char]
fs
  [Char]
other -> ([Char] -> ([Char], [Char])
forall a. HasCallStack => [Char] -> a
error ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
"fileToTree: unexpected: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
10 [Char]
other))

authorsToTree :: String -> Either String [(String,String)]
authorsToTree :: [Char] -> Either [Char] [([Char], [Char])]
authorsToTree [Char]
s = case Parser Char [([Char], [Char])]
-> ParseMethod Char [([Char], [Char])] ([([Char], [Char])], [Char])
-> [Char]
-> ParseResult Char ([([Char], [Char])], [Char])
forall s a r.
Parser s a -> ParseMethod s a r -> [s] -> ParseResult s r
parse (Parser Char [([Char], [Char])]
pAuthors Parser Char [([Char], [Char])]
-> Parser Char () -> Parser Char [([Char], [Char])]
forall a b. Parser Char a -> Parser Char b -> Parser Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char ()
forall {p :: * -> *}. (SymbolOf p ~ Char, IsParser p) => p ()
spaces) ParseMethod Char [([Char], [Char])] ([([Char], [Char])], [Char])
forall s a. ParseMethod s a (a, [s])
longestResultWithLeftover [Char]
s of
   Right ([([Char], [Char])]
r,[]) -> [([Char], [Char])] -> Either [Char] [([Char], [Char])]
forall a b. b -> Either a b
Right [([Char], [Char])]
r
   ParseResult Char ([([Char], [Char])], [Char])
_ -> [Char] -> Either [Char] [([Char], [Char])]
forall a b. a -> Either a b
Left ([Char]
"parse error in authors name: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s)

seeAlsoToTree :: [Char] -> ([Char], [Char])
seeAlsoToTree [Char]
r = ([Char]
how,[Char]
what)
    where ([Char]
how,Char
':':[Char]
what) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') [Char]
r

[a]
l ?? :: [a] -> a -> a
?? a
b = [a] -> a
forall a. HasCallStack => [a] -> a
head ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
b]

bibToForest :: [T] -> Either String [Entry]
bibToForest :: [T] -> Either [Char] [Entry]
bibToForest [T]
xs = (T -> Either [Char] Entry) -> [T] -> Either [Char] [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM T -> Either [Char] Entry
entryToTree [T]
xs

formatEntry :: Entry.T -> String
formatEntry :: T -> [Char]
formatEntry (Entry.Cons [Char]
entryType [Char]
bibId [([Char], [Char])]
items) =
   let formatItem :: ([Char], [Char]) -> [Char]
formatItem ([Char]
name, [Char]
value) =
         [Char]
"\t"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
name[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" = {"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
value[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"}"
   in  [Char]
"@" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
entryType [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"{" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
bibId [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
",\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
       [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
",\n" ((([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
formatItem [([Char], [Char])]
items) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
       [Char]
"\n}\n\n"


Entry
e1 isSeeAlso :: Entry -> Entry -> Bool
`isSeeAlso` Entry
e2 = Entry -> [Char]
findNiceKey Entry
e1 [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd (Entry -> [([Char], [Char])]
seeAlso Entry
e2))

areRelated :: Entry -> Entry -> Bool
areRelated Entry
e1 Entry
e2 = Entry
e1 Entry -> Entry -> Bool
`isSeeAlso` Entry
e2 Bool -> Bool -> Bool
|| Entry
e2 Entry -> Entry -> Bool
`isSeeAlso` Entry
e1