diff --git a/.imbib b/.imbib new file mode 100644 --- /dev/null +++ b/.imbib @@ -0,0 +1,6 @@ +watched = %(home)s/Downloads +archive = %(home)s/Papers +library = %(home)s/library.bib + +viewer = /usr/bin/evince +editor = /usr/bin/emacs diff --git a/Batch.hs b/Batch.hs new file mode 100644 --- /dev/null +++ b/Batch.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE RecordWildCards, TupleSections #-} + +import Control.Applicative hiding ((<|>),many) +import Control.Monad +import Control.Monad.Trans +import qualified Data.ByteString.Lazy as BS +import Data.Char +import Data.List +import Data.Maybe +import Data.Tree +import Data.Traversable +import System.FilePath +import System.Process +import Text.BibTeX.Entry as Entry +import Text.BibTeX.Parse +import Data.Function +import System.Environment +import qualified Data.Map as M +import Config + +import TypedBibData +import BibDB +import BibAttach +import qualified SuffixTreeCluster as SC +-- import Text.Groom +import MaybeIO + +------------------------------------------------------------------------- +-- CheckDuplicates, method 1 + + +pairs (x:xs) = map (x,) xs ++ pairs xs +pairs _ = [] + +checkDup bib = do + -- mapM_ putString $ [ groom $ (map findTitle es, shared) | (es,shared) <- common ] + putString "Possible duplicates:" + mapM_ putString $ map (show . map findTitle) dups + saveBib $ uniqDups ++ (bib \\ uniqDups) -- clump together the duplicates + where + uniqDups = nub $ concat $ dups + trueDups es = filter (\e -> any (not . (areRelated e)) es) es + dups = [ es | (es0,shared) <- common, + let es = trueDups es0, + not (null es), + sum (map length shared) >= threshold (minimum (map (length . project . findTitle) es))] + threshold x = (9 * x) `div` 10 + -- SC.printTree $ SC.select ("", clusterTree) + common = M.toList $ SC.commonStrings info + clusterTree = SC.construct info + info = [(project $ findTitle e,[e]) | e <- bib] + +------------------------------------------------------------------------- +-- Auto-renaming of attachments + +rename :: (String -> String) -> (String,String) -> MaybeIO (String,String) +rename new (oldfname,typ) + | oldfname == newfname = bail + | otherwise = do + oex <- doesFileExist oldfname + nex <- doesFileExist newfname + case (oex,nex) of + (True,False) -> do renameFile oldfname newfname + return (newfname,typ) + (False,_) -> putString ("old does not exist: " ++ oldfname) >> bail + (_,True) -> putString ("new already exists: " ++ newfname) >> bail + -- (_,True) -> do removeFile oldfname >> return (newfname,typ) + + where newfname = new typ + bail = return (oldfname,typ) + +renamer :: Entry -> MaybeIO Entry +renamer t@Entry{..} = do + files <- traverse (rename (findAttachName t)) files + return $ Entry{..} + +renameAttachments bib = do + bib' <- traverse renamer bib + saveBib bib' + +------------------------------------------------------------------------ +-- Check for orphans + +check :: (String,String) -> MaybeIO () +check (fname,typ) = do + ex <- doesFileExist fname + if (not ex) then putString $ "missing: " ++ fname else return () + +checker Entry{..} = mapM_ check files + +getDirectoryContents' d = map (d ) <$> getDirectoryContents d + +checkAttachments bib = do + fnames <- getDirectoryContents' "/home/bernardy/Papers" + let attachments = [ f | e <- bib, (f,t) <- files e] + + mapM_ putString (fnames \\ attachments) + +---------------------------------------------------------------------- +-- Merge another bibtex file + +mergeIn bib fname = do + bib2 <- uncheckedHarmless $ rightOrDie <$> loadBibliographyFrom fname + checkDup $ bib2 ++ bib + return () + + +{- +mergeBibs bib1 bib2 = + where bibM1 = M.fromList [(project $ findTitle e, e) | e <- bib1] +-} + + +----------------------------------------------------------------------- +-- Harvest Downloads + +harvest bib = do + contents <- getDirectoryContents' downloadsDirectory + let oldFiles = concatMap (map snd . files) bib + newFiles = contents \\ oldFiles + papers = [Entry {kind = "download", + seeAlso = [], + authors = [], + files = [(fname,guessType fname BS.empty)], + otherFields = [("title",fname),("date","2010")] + } | fname <- newFiles, takeExtension fname `elem` [".pdf",".ps"]] + saveBib $ papers ++ bib + +------------------------------------------------------------------------ +-- Driver + +saveBib b = safely "Saving bibfile" $ saveBibliography b + + +go (command: ~(arg1:_)) = do + bib <- uncheckedHarmless $ (rightOrDie <$> loadBibliography) + case command of + "check" -> checkAttachments bib + "rename" -> renameAttachments bib + "merge" -> mergeIn bib arg1 + "harvest" -> harvest bib + "dup" -> checkDup bib + +dryRun = run True +trueRun = run False + +main = do + args <- getArgs + case args of + ("dry":args) -> dryRun $ go args + _ -> trueRun $ go args diff --git a/BibAttach.hs b/BibAttach.hs new file mode 100644 --- /dev/null +++ b/BibAttach.hs @@ -0,0 +1,50 @@ +module BibAttach where + +import Control.Applicative hiding ((<|>),many) +import Control.Monad +import Control.Monad.Trans +import qualified Data.ByteString.Lazy as BS +import Data.Char +import Data.List +import Data.List.Split +import Data.Maybe +import Data.Tree +import System.Directory +import System.FilePath +import System.Process +import Data.Function +import System.FilePath + +import TypedBibData +import Config + +-------------------------------------- +-- Attachment manipulation + +sanitize = filter (\c -> c`notElem` ";:{}/\\" && ord c < 128) +-- there seems to be a problem with big chars in filenames at the moment. +-- see http://hackage.haskell.org/trac/ghc/ticket/3307 + +-- save a (binary) file, safely +saveFile name contents = do + putStrLn $ "Creating directory for " ++ name + createDirectoryIfMissing True (dropFileName name) + putStrLn $ "Writing..." + BS.writeFile name contents + return name + +findAttachName entry ext = attachmentsRoot (sanitize $ findTitle entry ++ "-" ++ findYear entry ++ "." ++ ext) + + +guessType :: FilePath -> BS.ByteString -> String +guessType fname contents + | BS.head contents == ord' '@' = "bib" + | magic == pdfMagic = "pdf" + | magic == psMagic = "ps" + | otherwise = drop 1 $ takeExtension fname + where magic = BS.take 4 contents + + pdfMagic = BS.pack $ map ord' "%PDF" + psMagic = BS.pack $ map ord' "%!PS" + ord' = fromIntegral . ord + diff --git a/BibDB.hs b/BibDB.hs new file mode 100644 --- /dev/null +++ b/BibDB.hs @@ -0,0 +1,41 @@ +module BibDB where + + +import Control.Applicative hiding ((<|>),many) +import Control.Monad +import Control.Monad.Trans +import qualified Data.ByteString +import Data.Char +import Data.List +import Data.List.Split +import Data.Maybe +import Data.Tree +import System.Directory +import System.FilePath +import Data.Function + +import Text.ParserCombinators.Parsec (parseFromFile) +import TypedBibData +import Config + +------------ +-- DB + + +loadBibliography = loadBibliographyFrom bibfile + +loadBibliographyFrom fileName = do + mBib <- fmap bibToForest <$> parseFromFile parseBib fileName + case mBib of + Left err -> return (Left err) + Right bib -> do putStrLn $ show (length $ bib) ++ " entries loaded." -- force it right here + return (Right bib) + +formatBib = concatMap formatEntry . map treeToEntry + +saveBibliography :: [TypedBibData.Entry] -> IO () +saveBibliography bib = do + writeFile bibfile (formatBib bib) + putStrLn $ show (length bib) ++ " entries saved to " ++ bibfile + + diff --git a/BibFile.hs b/BibFile.hs new file mode 100644 --- /dev/null +++ b/BibFile.hs @@ -0,0 +1,39 @@ +module BibFile where + +import Control.Applicative hiding ((<|>),many) +import Control.Monad +import Control.Monad.Trans +import qualified Data.ByteString +import Data.Char +import Data.List +import Data.List.Split +import Data.Maybe +import Data.Tree +import System.Directory +import System.FilePath +import Data.Function + +import Text.ParserCombinators.Parsec (parseFromFile) +import BibData + + +-------------------------------------- +-- Bib file manipulation + +bibfile = "/home/bernardy/project/gitroot/bibtex/jp.bib" + +loadBibliography = loadBibliographyFrom bibfile + +loadBibliographyFrom fname = do + mBib <- fmap bibToForest <$> parseFromFile parseBib bibfile + case mBib of + Left err -> do print "Failed to load library" + print err + return [] + Right bib -> do putStrLn $ show (length $ bib) ++ " entries loaded." -- force it right here + -- print $ last bib -- really force closing the file... ? + return bib + +saveBibliography bib = do + writeFile bibfile (concatMap formatEntry $ map treeToEntry bib) + putStrLn $ show (length bib) ++ " entries saved to " ++ bibfile diff --git a/Config.hs b/Config.hs new file mode 100644 --- /dev/null +++ b/Config.hs @@ -0,0 +1,38 @@ +module Config where + +import Paths_imbib +import System.IO.Unsafe +import System.FilePath +import System.Process +import System.Directory +import Data.ConfigFile +import Control.Applicative + +rightOrDie (Left err) = error (show err) +rightOrDie (Right x) = x + +startConfig = rightOrDie $ + set (emptyCP {accessfunc = interpolatingAccess 10}) "DEFAULT" "home" homeDirectory + +configFileName = ".imbib" + +configuration = unsafePerformIO $ do + c0f <- getDataFileName configFileName + c0 <- rightOrDie <$> readfile startConfig c0f + let user = homeDirectory configFileName + ex <- doesFileExist user + if ex then rightOrDie <$> readfile c0 user else return c0 + +getOption = rightOrDie . get configuration "DEFAULT" + +downloadsDirectory = getOption "watched" +attachmentsRoot = getOption "archive" +bibfile = getOption "library" +runEditor lineNumber file = runProcess' (getOption "editor") ['+':show lineNumber,file] +runViewer file = runProcess' (getOption "viewer") [file] + +-- The following should probably not change +homeDirectory = unsafePerformIO $ getHomeDirectory +iconFile = unsafePerformIO $ getDataFileName "icon.svg" + +runProcess' = \bin args -> runProcess bin args Nothing Nothing Nothing Nothing Nothing diff --git a/Imbibed.hs b/Imbibed.hs new file mode 100644 --- /dev/null +++ b/Imbibed.hs @@ -0,0 +1,296 @@ +{-# LANGUAGE RecordWildCards, TupleSections #-} + +{-- +TODO: +if URI is bib, use as such +Search google on title +merge other bibtex(s); duplicate detection +-} + +import Control.Applicative hiding ((<|>),many) +import Control.Monad +import Control.Monad.Trans +import qualified Data.ByteString +import qualified Data.ByteString.Lazy.UTF8 as UTF8 (toString) +import Data.Char +import Data.List +import Data.Maybe +import Graphics.UI.Gtk hiding (on, Entry) +import qualified Graphics.UI.Gtk as Gtk +import Graphics.UI.Gtk.ModelView as New +import Graphics.UI.Gtk.ModelView.ListStore +import Network.Curl.Download.Lazy +import Network.Curl.Opts +import System.Directory +import System.FilePath +import Text.BibTeX.Entry as Entry +import Text.BibTeX.Parse +import Data.Function +import System.Gnome.VFS.Monitor +import qualified System.Gnome.VFS.Init as VFS +import System.Glib.GError +import Text.ParserCombinators.Parsec (parse, parseFromFile) + +import TypedBibData +import BibDB +import BibAttach +import Config + + +{- +import Text.ParserCombinators.Parsec as Parsec hiding ... + +instance Alternative (GenParser Char ()) where + (<|>) = (Parsec.<|>) + ... +-} + +---------------------- +-- GUI + +main = do + bib <- rightOrDie <$> loadBibliography + + VFS.init + initGUI + + win <- windowNew + + model <- listStoreNewDND bib + (Just (DragSourceIface draggable dataGet dataDelete)) + (Just (DragDestIface possible recieved)) + + onDestroy win $ do + saveStore model + VFS.shutdown + mainQuit + + monitorAdd ("file://" ++ bibfile) (toEnum 0) $ \handle monitored changed evType -> do + -- ugh: toEnum 0 == MonitorFile + putStrLn $ "Bibfile changed; reloading " ++ show evType + mBib <- loadBibliography + case mBib of + Left err -> putStr $ show err + Right bib -> do oldBib <- listStoreToList model + when (bib /= oldBib) $ do + listStoreClear model + forM_ bib (listStoreAppend model) + + searchBox <- entryNew + + filt <- treeModelFilterNew model [] + treeModelFilterSetVisibleFunc filt $ Just $ \iter -> do + needle <- get searchBox entryText + let idx = listStoreIterToIndex iter + e <- listStoreGetValue model idx + return $ e `matchSearch` needle + + + onEditableChanged searchBox $ treeModelFilterRefilter filt + + view <- New.treeViewNewWithModel filt + + New.treeViewSetHeadersVisible view True + + -- columns + [col0,col1,col2] <- forM ["⎙","Cit","Title"] $ \h -> do + c <- New.treeViewColumnNew + New.treeViewColumnSetTitle c h + return c + + treeViewColumnSetResizable col1 True + treeViewColumnSetResizable col2 True + + [renderer0,renderer1,renderer2] <- forM [0..2] $ \_ -> New.cellRendererTextNew + + New.cellLayoutPackStart col0 renderer0 True + New.cellLayoutPackStart col1 renderer1 True + New.cellLayoutPackStart col2 renderer2 True + + Gtk.set col1 [treeViewColumnMinWidth := 180] + + forM [renderer1,renderer2] $ \r -> set r [ cellTextEllipsizeSet := True , cellTextEllipsize := EllipsizeEnd ] + + New.cellLayoutSetAttributes col0 renderer0 model $ \row -> [ New.cellText := if null $ findFullText row then "" else "✓"] + New.cellLayoutSetAttributes col1 renderer1 model $ \row -> [ New.cellText := findCite row ] + New.cellLayoutSetAttributes col2 renderer2 model $ \row -> [ New.cellText := renderTex $ findTitle row ] + + {- + Gtk.on renderer2 edited $ \path@(i:_) newText -> do + (k,v) <- listStoreGetValue model path + listStoreSetValue model path (k,newText) + -} + + New.treeViewAppendColumn view col0 + New.treeViewAppendColumn view col1 + New.treeViewAppendColumn view col2 + + -- enable interactive search + treeViewSetEnableSearch view True + treeViewSetSearchEqualFunc view $ Just $ \str iter -> do + p0 <- treeModelGetPath filt iter + [i] <- treeModelFilterConvertPathToChildPath filt p0 + entry <- listStoreGetValue model i + return $ entry `matchSearch` str + + -- make the widget a drag source + tl <- targetListNew + targetListAddTextTargets tl 0 + treeViewEnableModelDragSource view [Button1] tl [ActionCopy] + + -- make the widget a drag destination + tl <- targetListNew + targetListAddUriTargets tl 0 + targetListAddTextTargets tl 1 + treeViewEnableModelDragDest view tl [ActionCopy] + + -- See the discussion on the gtk2hs-users list: + -- Drag and drop support in filtered TreeView + -- (July 2010) + Gtk.on view dragDrop $ \ context point time -> do + putStrLn $ "dragDrop" + signalStopEmission view "drag_drop" + Just target <- dragDestFindTarget view context (Just tl) + -- print target + dragStatus context Nothing time + -- not so important as we do not need the data for motion: we never check this status. + dragGetData view context target time + return True + + Gtk.on view dragDataReceived $ \ context pt infoId time -> do + liftIO $ putStrLn $ "dragData" + liftIO $ signalStopEmission view "drag_data_received" + pt' <- liftIO $ treeViewConvertWidgetToBinWindowCoords view pt + mPath <- liftIO $ treeViewGetPathAtPos view pt' + done <- case mPath of + Nothing -> return False + Just (p0,_,_) -> do + p1 <- liftIO $ treeModelFilterConvertPathToChildPath filt p0 + recieved model p1 -- normally we'd call "possible" upon motion; but it's always possible. + liftIO $ dragFinish context done False time + + let entryFromPath p0 = do + [i] <- treeModelFilterConvertPathToChildPath filt p0 + listStoreGetValue model i + + + -- Handle "return" + afterRowActivated view $ \path col -> do + openFullText =<< entryFromPath path + + -- Handle clicks + Gtk.on view buttonPressEvent $ do + b <- eventButton + c <- eventClick + (x,y) <- eventCoordinates + let pt = (round x, round y) + mPath <- liftIO $ treeViewGetPathAtPos view pt + case mPath of + Nothing -> return False + Just (p0,_,_) -> liftIO $ do + case (b,c) of + (LeftButton,DoubleClick) -> do + openFullText =<< entryFromPath p0 + return True + (RightButton,DoubleClick) -> do + -- Open emacs at the adequate line to edit. + [i] <- treeModelFilterConvertPathToChildPath filt p0 + saveStore model + before <- take i <$> listStoreToList model + let lineNumber = length $ lines $ formatBib before + runEditor lineNumber bibfile + return True + _ -> return False + + layout <- vBoxNew False 0 + scr <- scrolledWindowNew Nothing Nothing + containerAdd scr view + boxPackStart layout searchBox PackNatural 0 + boxPackStart layout scr PackGrow 0 + containerAdd win layout + + catchGError (windowSetIconFromFile win iconFile) $ \(GError dom code msg) -> do + putStrLn $ "Could not load icon file: " ++ msg + windowSetDefaultSize win 640 360 + widgetShowAll win + mainGUI + +openFullText :: Entry -> IO () +openFullText t = do + let file = findFullText t + case file of + [] -> putStrLn "no pdf found!" + (f:_) -> do putStrLn $ "Opening " ++ f + runViewer f + return () + + +draggable store [_] = return True +draggable store _ = return False + +dataGet store [p] = do + t <- liftIO $ listStoreGetValue store p + let k = findNiceKey t + selectionDataSetText $ "\\cite{" ++ k ++ "}" + +dataDelete _ _ = return True + +receivedBib store text = do + putStrLn $ "Got bib: " + forM_ (lines text) putStrLn + let mBib = parse parseBib "dropped text" text + case mBib of + Left err -> print err >> return False + Right bib -> do print bib + mapM_ (listStorePrepend store) (bibToForest bib) + -- saveStore store + return True + +recievedFile i store uri = do + putStrLn $ "Downloading " ++ uri + mFile <- openLazyURIWithOpts [CurlFollowLocation True] uri + case mFile of + Left err -> putStrLn err >> return False + Right file -> do + putStrLn "Success!" + let fileType = guessType uri file + if fileType == "bib" then receivedBib store (UTF8.toString file) else do + entry <- listStoreGetValue store i + putStrLn "Saving..." + fname <- saveFile (findAttachName entry fileType) file + putStrLn "Updating store" + storeModify store i (addFile (fname, fileType)) + -- saveStore store + return True + +recieved store path@(i:_) = do + liftIO $ putStrLn "recieved!" + mURI <- selectionDataGetURIs + case mURI :: Maybe [String] of + -- Accept URI as download to link to the library + -- Normally this stuff should be done in the background. + -- I don't care. + Just [uri] -> liftIO $ recievedFile i store uri + _ -> do + -- Accept drop of text as bibtex + mText <- selectionDataGetText + case mText :: Maybe String of + Just text -> liftIO $ receivedBib store text + _ -> return False + +possible store path = do + liftIO $ putStrLn "Possible?" + return True -- accept all text & URI, a priori. + +-------------------------------------- +-- Store + +storeModify store i f = do + a <- listStoreGetValue store i + listStoreSetValue store i (f a) + +saveStore store = do + putStrLn "Syncing on disk" + bib <- listStoreToList store + saveBibliography bib + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/MaybeIO.hs b/MaybeIO.hs new file mode 100644 --- /dev/null +++ b/MaybeIO.hs @@ -0,0 +1,62 @@ +module MaybeIO ( + MaybeIO, + doesFileExist, + renameFile, removeFile, + putString, + getDirectoryContents, + uncheckedHarmless, safely, + run, + ) where + +import qualified System.Directory as R +import Prelude hiding (putStrLn) +import qualified Prelude as R +import Control.Monad (ap,liftM) +import Control.Applicative + +data MaybeIO a where + Return :: a -> MaybeIO a + (:>>=) :: MaybeIO a -> (a -> MaybeIO b) -> MaybeIO b + Safe :: IO a -> MaybeIO a + Harmful :: String -> IO () -> MaybeIO () + +instance Functor MaybeIO where + fmap = liftM + +instance Applicative MaybeIO where + pure = Return + (<*>) = ap + +run :: Bool -> MaybeIO a -> IO a +run dry mio = run' mio + where + run' :: forall a. MaybeIO a -> IO a + run' (Return a) = return a + run' (a :>>= b) = do x <- run' a + run' (b x) + run' (Safe i) = i + run' (Harmful msg i) = if dry then R.putStrLn ('|':msg) else i + +instance Monad MaybeIO where + (>>=) = (:>>=) + return = Return + +uncheckedHarmless = Safe +safely = Harmful + + +doesFileExist f = uncheckedHarmless $ R.doesFileExist f + +putString = uncheckedHarmless . R.putStrLn + +getDirectoryContents = uncheckedHarmless . R.getDirectoryContents + +renameFile :: String -> String -> MaybeIO () +renameFile old new = do + safely ("RENAME: " ++ old ++ " TO " ++ new) + (R.renameFile old new) + + +removeFile :: String -> MaybeIO () +removeFile f = do + safely ("DELETE: " ++ f) (R.removeFile f) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main :: IO () +main = defaultMain diff --git a/SuffixTreeCluster.hs b/SuffixTreeCluster.hs new file mode 100644 --- /dev/null +++ b/SuffixTreeCluster.hs @@ -0,0 +1,301 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.SuffixTreeCluster +-- Copyright : (c) Bryan O'Sullivan 2007, JP Bernardy 2010 +-- License : BSD-style +-- Maintainer : nobody +-- Stability : experimental +-- Portability : portable +-- +-- A suffix tree cluster implementation. +-- +-- Since many function names (but not the type name) clash with +-- "Prelude" names, this module is usually imported @qualified@, e.g. +-- +-- > import Data.SuffixTreeCluster (STree) +-- > import qualified Data.SuffixTreeCluster as T +-- +-- This implementation constructs the suffix tree lazily, so subtrees +-- are not created until they are traversed. +-- +-- Estimates are given for performance. The value /k/ is a constant; +-- /n/ is the length of a query string; and /t/ is the number of +-- elements (nodes and leaves) in a suffix tree. + +module SuffixTreeCluster + ( + -- * Types + Alphabet + , Edge + , Prefix + , STree(..) + + -- * Construction + , construct + + -- * Querying + , elem + , findEdge + , findTree + , findPath + + -- * Other useful functions + , mkPrefix + , prefix + , suffixes + , select + , commonStrings + + -- * Debug + , printTree + ) where + +import Prelude hiding (elem, foldl, foldr) +import qualified Data.Map as M +import Control.Arrow (second) +import qualified Data.ByteString as SB +import qualified Data.ByteString.Lazy as LB +import qualified Data.List as L +import Data.Maybe (listToMaybe, mapMaybe, catMaybes) +import Data.Monoid hiding (Sum) +-- import Text.Groom +import Data.Function (on) +import qualified Data.Tree as T + +-- | The length of a prefix list. This type is formulated to do cheap +-- work eagerly (to avoid constructing a pile of deferred thunks), +-- while deferring potentially expensive work (computing the length of +-- a list). +data Length a = Exactly {-# UNPACK #-} !Int + | Sum {-# UNPACK #-} !Int [a] + deriving (Show) + +-- | The list of symbols that 'constructWith' can possibly see in its +-- input. +type Alphabet a = [a] + +-- | The prefix string associated with an 'Edge'. Use 'mkPrefix' to +-- create a value of this type, and 'prefix' to deconstruct one. +newtype Prefix a = Prefix ([a], Length a) + +instance (Eq a) => Eq (Prefix a) where + a == b = prefix a == prefix b + +instance (Ord a) => Ord (Prefix a) where + compare a b = compare (prefix a) (prefix b) + +instance (Show a) => Show (Prefix a) where + show a = "mkPrefix " ++ show (prefix a) + +-- | An edge in the suffix tree. +type Edge a b = (Prefix a, STree a b) + +-- | /O(1)/. Construct a 'Prefix' value. +mkPrefix :: [a] -> Prefix a +mkPrefix xs = Prefix (xs, Sum 0 xs) + +pmap :: (a -> b) -> Prefix a -> Prefix b +pmap f = mkPrefix . map f . prefix + +instance Functor Prefix where + fmap = pmap + +-- | The suffix tree type. The implementation is exposed to ease the +-- development of custom traversal functions. Note that @('Prefix' a, +-- 'STree' a b)@ pairs are not stored in any order. +data STree a b = Node b [Edge a b] + deriving (Show) + +smap :: (a -> b) -> STree a c -> STree b c +smap f (Node b es) = Node b (map (\(p, t) -> (fmap f p, smap f t)) es) + +lmap :: (a -> b) -> STree c a -> STree c b +lmap f (Node b es) = Node (f b) (map (second (lmap f)) es) + +instance Functor (STree a) where + fmap = lmap + +-- | /O(n)/. Obtain the list stored in a 'Prefix'. +prefix :: Prefix a -> [a] +prefix (Prefix (ys, Exactly n)) = take n ys +prefix (Prefix (ys, Sum n xs)) = tk n ys + where tk 0 ys = zipWith (const id) xs ys + tk n (y:ys) = y : tk (n-1) ys + + + +-- | Increments the length of a prefix. +inc :: Length a -> Length a +inc (Exactly n) = Exactly (n+1) +inc (Sum n xs) = Sum (n+1) xs + +-- | /O(n)/. Returns all non-empty suffixes of the argument, longest +-- first. Behaves as follows: +-- +-- >suffixes xs == init (tails xs) +suffixes :: [a] -> [[a]] +suffixes (xs@(_:xs')) = (xs) : suffixes (xs') +suffixes _ = [] + +constr :: (Eq b, Monoid b, Ord a) => [(b,[[a]])] -> STree a b +constr is = Node label (suf xs) + where xs = filter (not . null . snd) $ map (second (filter (not . null))) is + label = (mconcat $ map fst is) + +construct :: (Eq b, Monoid b, Ord a) => [([a],b)] -> STree a b +construct is = constr [(b,L.tails a) | (a,b) <- is] + +suf :: (Eq b, Monoid b, Ord a) => [(b,[[a]])] -> [Edge a b] +suf ss = [(Prefix (a:sa, inc cpl), constr ssr) + | (a, n@((_,sa:_):_)) <- suffixMap ss, + let (cpl,ssr) = cst n] + +regroup :: (Eq b) => [(b, a)] -> [(b, [a])] +regroup xs = [(b,map snd as) | as@((b,_):_) <- L.groupBy ((==) `on` fst) xs] + +-- + +suffixMap :: (Eq b, Ord a) => [(b,[[a]])] -> [(a, [(b, [[a]])])] +suffixMap sss = map (second (regroup . reverse)) . + M.toList . L.foldl' step M.empty $ [(b,s) | (b,ss) <- sss, s <- ss] + where step m (b,x:xs) = M.alter (f (b,xs)) x m + step m _ = m + f x Nothing = Just [x] + f x (Just xs) = Just (x:xs) + +cst :: (Monoid b, Eq b, Eq a) => [(b, [[a]])] -> (Length a, [(b, [[a]])]) + +cst bss | or [null s | (_,ss) <- bss, s <- ss] = (Exactly 0, bss) +cst ss0@((_,[s]):ss) | all ((== [s]) . snd) ss = (Sum 0 s, [(b, []) | (b,_) <- ss0]) +cst awss@((_,(a:w):_):ss) + | null [c | (_,x) <- ss, (c:_) <- x, a /= c] + = let cpl' = inc cpl + in seq cpl' (cpl', rss) + | otherwise = (Exactly 0, awss) + where (cpl, rss) = cst $ map (second (map tail')) awss + tail' (_:t) = t -- so we see the pattern fail here instead of a generic tail. + + +suffix :: (Eq a) => [a] -> [a] -> Maybe [a] +suffix (p:ps) (x:xs) | p == x = suffix ps xs + | otherwise = Nothing +suffix _ xs = Just xs + +{-# SPECIALISE elem :: [Char] -> STree Char b -> Bool #-} +{-# SPECIALISE elem :: [[Char]] -> STree [Char] b -> Bool #-} +{-# SPECIALISE elem :: [SB.ByteString] -> STree SB.ByteString b -> Bool #-} +{-# SPECIALISE elem :: [LB.ByteString] -> STree LB.ByteString b -> Bool #-} +{-# SPECIALISE elem :: (Eq a) => [[a]] -> STree [a] b -> Bool #-} + +-- | /O(n)/. Indicates whether the suffix tree contains the given +-- sublist. Performance is linear in the length /n/ of the +-- sublist. +elem :: (Eq a) => [a] -> STree a b -> Bool +elem [] _ = True +elem xs (Node mb es) = any pfx es + where pfx (e, t) = maybe False (`elem` t) (suffix (prefix e) xs) + +lkup :: (Monoid b, Eq a) => [a] -> STree a b -> b +lkup [] (Node b es) = b +lkup xs (Node _ es) = mconcat $ map pfx es + where pfx (e, t) = maybe mempty (`lkup` t) (suffix (prefix e) xs) + +{-# SPECIALISE findEdge :: [Char] -> STree Char b + -> Maybe (Edge Char b, Int) #-} +{-# SPECIALISE findEdge :: [String] -> STree String b + -> Maybe (Edge String b, Int) #-} +{-# SPECIALISE findEdge :: [SB.ByteString] -> STree SB.ByteString b + -> Maybe (Edge SB.ByteString b, Int) #-} +{-# SPECIALISE findEdge :: [ LB.ByteString] -> STree LB.ByteString b + -> Maybe (Edge LB.ByteString b, Int) #-} +{-# SPECIALISE findEdge :: (Eq a) => [[a]] -> STree [a] b + -> Maybe (Edge [a] b, Int) #-} + +-- | /O(n)/. Finds the given subsequence in the suffix tree. On +-- failure, returns 'Nothing'. On success, returns the 'Edge' in the +-- suffix tree at which the subsequence ends, along with the number of +-- elements to drop from the prefix of the 'Edge' to get the \"real\" +-- remaining prefix. +-- +-- Here is an example: +-- +-- >> find "ssip" (construct "mississippi") +-- >Just ((mkPrefix "ppi",Leaf),1) +-- +-- This indicates that the edge @('mkPrefix' \"ppi\",'Leaf')@ matches, +-- and that we must strip 1 character from the string @\"ppi\"@ to get +-- the remaining prefix string @\"pi\"@. +-- +-- Performance is linear in the length /n/ of the query list. +findEdge :: (Eq a) => [a] -> STree a b -> Maybe (Edge a b, Int) +findEdge xs (Node mb es) = listToMaybe (mapMaybe pfx es) + where pfx e@(p, t) = let p' = prefix p + in suffix p' xs >>= \suf -> + case suf of + [] -> return (e, length (zipWith const xs p')) + s -> findEdge s t + +-- | /O(n)/. Finds the subtree rooted at the end of the given query +-- sequence. On failure, returns 'Nothing'. +-- +-- Performance is linear in the length /n/ of the query list. +findTree :: (Eq a) => [a] -> STree a b -> Maybe (STree a b) +findTree s t = (snd . fst) `fmap` findEdge s t + +-- | /O(n)/. Returns the path from the 'Edge' in the suffix tree at +-- which the given subsequence ends, up to the root of the tree. If +-- the subsequence is not found, returns the empty list. +-- +-- Performance is linear in the length of the query list. +findPath :: (Eq a) => [a] -> STree a b -> [Edge a b] +findPath = go [] + where go me xs (Node mb es) = pfx me es + where pfx _ [] = [] + pfx me (e@(p, t):es) = + case suffix (prefix p) xs of + Nothing -> pfx me es + Just [] -> e:me + Just s -> go (e:me) s t + + +-- select :: SC.STree a b -> Tree Int +selectPairs (p0,Node entries sub) = T.Node (p0,entries) $ + [select (p0 ++ prefix p,n) | (p,n) <- sub, isRelevantNode n] + +selectLen (T.Node (shared,entries) sub) = T.Node here (map selectLen sub) + where here | length shared < 7 = ([],mempty) + | otherwise = (shared,entries) + + +selectLongest (T.Node (shared,entries) sub) = T.Node here (map selectLongest sub) + where here | subsumed = ([],[]) + | otherwise = (shared,entries) + subsumed = all (`L.elem` (concatMap (snd . T.rootLabel) sub)) entries + + +select :: Eq b => ([a],STree a [b]) -> T.Tree ([a],[b]) +select = selectLongest . selectLen . selectPairs + +buildMap :: (Eq a, Ord b) => T.Tree ([a],[b]) -> M.Map [b] [[a]] +buildMap t = L.foldl' step M.empty $ filter (not . null . snd) $ T.flatten t + where step m (x,bs) = M.alter (lub x) bs m + +commonStrings :: (Eq b, Ord a, Ord b) => [([a],[b])] -> M.Map [b] [[a]] +commonStrings xs = buildMap $ select ([],construct xs) + +lub y Nothing = Just [y] +lub y (Just xs) + | (y `L.isSuffixOf`) `any` xs = Just xs + | otherwise = Just (y : filter (not . (`L.isSuffixOf` y)) xs) + +printTree :: Show a => T.Tree a -> IO () +printTree = putStrLn . T.drawTree . fmap show + +isRelevant [] = False +isRelevant [_] = False +isRelevant _ = True + +isRelevantNode (Node e _) = isRelevant e + +emptyPrefix :: Prefix a +emptyPrefix = mkPrefix [] diff --git a/TypedBibData.hs b/TypedBibData.hs new file mode 100644 --- /dev/null +++ b/TypedBibData.hs @@ -0,0 +1,155 @@ +{-# 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.Parsec as Parsec + + +------------------------------------- +-- Bib Data manipulation + +data Entry = Entry { + kind :: String, + authors :: [(String,String)], + files :: [(String,String)], -- ^ name, type + seeAlso :: [(String,String)], + otherFields :: [(String,String)] + } deriving (Show, Eq, Ord) + + +renderTex = filter (`notElem` "{}") + +sanitizeIdent = filter (\c -> (c >= 'a' && c <= 'z') || isDigit c || c `elem` ".-_?+") . + map ((\c -> if isSpace c then '_' else c) . toLower) + + +parseBib = skippingSpace $ skippingLeadingSpace Text.BibTeX.Parse.file + +pAuth :: Parser (String, String) +pAuth = do + many Parsec.space + p1 <- pAuthNamePart `Parsec.sepBy` (many Parsec.space) + do Parsec.char ',' + many Parsec.space + first <- pAuthName + return (first, intercalate " " p1) + <|> let (first,[last]) = splitAt (length p1 - 1) p1 in + return (intercalate " " first, last) + +pAuthName = concat <$> many (pAuthBlock True) +pAuthNamePart = concat <$> many1 (pAuthBlock False) + +pAuthBlock :: Bool -> Parser String +pAuthBlock spaceOk = + liftM3 (\open body close -> open : body ++ close : []) + (Parsec.char '{') pAuthName (Parsec.char '}') <|> + sequence + [Parsec.char '\\', + Parsec.oneOf "{}'`^&%\".,~# " <|> Parsec.letter] <|> + fmap (:[]) (Parsec.noneOf $ [' ' | not spaceOk] ++ "},") + + +-- When searching ignore special characters +project = map toLower . filter isAlphaNum + +-- | Does a node contain a string (for search) +contains :: Entry -> String -> Bool +contains t needle = or [needle `isInfixOf` project txt | txt <- findTitle t : map snd (authors t)] + +matchSearch entry pattern = all (contains entry) (map project $ words pattern) + +findCiteAuth :: Entry -> String +findCiteAuth Entry {..} = renderTex $ case map snd authors of + [] -> "????" + [a] -> a + [a,b] -> a ++ " and " ++ b + [a,b,c] -> a ++ ", " ++ b ++ " and " ++ c + (a:_) -> a ++ " et al." + +findYear :: Entry -> String +findYear = findField "year" + +findTitle :: Entry -> String +findTitle = findField "title" + +findField :: String -> Entry -> String +findField f t = findField' f t ?? "????" + +findField' f Entry {..} = map snd (filter ((== f) . fst) otherFields) + +findFirstAuthor :: Entry -> String +findFirstAuthor Entry{..} = map snd authors ?? "????" + +findCite t = findCiteAuth t ++ " " ++ findYear t +findNiceKey t = findField' "forcedkey" t ?? + (intercalate "_" $ map sanitizeIdent $ [findFirstAuthor t, title, findYear t]) + where title = ((filter ((> 1) . length) . map sanitizeIdent . words . findTitle $ t) + \\ ["for","le","an","to","be","on","make","the","how","why","its","from","towards"]) + ?? "????" + +findFullText Entry {..} = map fst . filter ((`elem` ["pdf","ps"]) . snd) $ files + +addFile f (Entry {..})= Entry {files = f:files,..} + +partitions :: [a -> Bool] -> [a] -> [[a]] +partitions [] l = [l] +partitions (x:xs) l = yes : partitions xs no + where (yes,no) = partition x l + +entryToTree :: Entry.T -> Entry +entryToTree Entry.Cons{..} = Entry {..} + where + [auths,fils,seeAlsos,otherFields] = partitions (map (\k -> (k ==) . fst) ["author","file","see"]) fields + kind = entryType + authors = [authorToTree a | (_,as) <- auths, a <- splitOn " and " as] + ident = identifier + files = [fileToTree f | (_,fs) <- fils, f <- splitOn ";" fs] + seeAlso = [seeAlsoToTree r | (_,rs) <- seeAlsos, not $ null rs, r <- splitOn ";" rs ] + +treeToEntry :: Entry -> Entry.T +treeToEntry t@Entry {..} = Entry.Cons{..} + where fields = ("author", intercalate " and " [first ++ " " ++ last | (first,last) <- authors]) : + [("file",intercalate ";" [":" ++ f ++ ":" ++ t | (f,t) <- files]) | not $ null files] ++ + otherFields ++ + [("see",intercalate ";" [how ++ ":" ++ what | (how,what) <- seeAlso]) | not $ null seeAlso] + entryType = kind + identifier = findNiceKey t + +fileToTree (':':fs) = (f, t) + where (f,':':t) = break (== ':') fs + +authorToTree :: String -> (String,String) +authorToTree s = case parse pAuth ("in " ++ s) s of + Left err -> error $ show err + Right r -> r + +seeAlsoToTree r = (how,what) + where (how,':':what) = break (== ':') r + +l ?? b = head $ l ++ [b] + +bibToForest = map entryToTree + +formatEntry :: Entry.T -> String +formatEntry (Entry.Cons entryType bibId items) = + let formatItem (name, value) = + "\t"++name++" = {"++value++"}" + in "@" ++ entryType ++ "{" ++ bibId ++ ",\n" ++ + intercalate ",\n" (map formatItem items) ++ + "\n},\n\n" + + +e1 `isSeeAlso` e2 = findNiceKey e1 `elem` (map snd (seeAlso e2)) + +areRelated e1 e2 = e1 == e2 || e1 `isSeeAlso` e2 || e2 `isSeeAlso` e1 diff --git a/icon.svg b/icon.svg new file mode 100644 --- /dev/null +++ b/icon.svg @@ -0,0 +1,117 @@ + + + + + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + diff --git a/imbib.cabal b/imbib.cabal new file mode 100644 --- /dev/null +++ b/imbib.cabal @@ -0,0 +1,61 @@ +name: imbib +version: 1.0.0 +category: Text +synopsis: Minimalistic reference manager. +description: + The tool to facilitates the workflow: webbrowser -> bibtex file -> directory of .pdfs. The design is minimalistic (eg. no editor is included; emacs can be fired up by double right-clicking an entry). + +license: GPL +license-file: LICENSE +author: Jean-Philippe Bernardy +maintainer: jeanphilippe.bernardy@gmail.com +Cabal-Version: >= 1.8 +tested-with: GHC==6.12.2 +build-type: Simple + +data-files: + icon.svg + .imbib + +executable imbib + main-is: Imbibed.hs + extensions: TypeSynonymInstances, RecordWildCards, FlexibleInstances + build-depends: base==4.* + build-depends: mtl==1.1.* + build-depends: parsec==2.1.* + build-depends: process==1.0.* + build-depends: filepath==1.1.* + build-depends: directory==1.0.* + build-depends: containers==0.* + build-depends: bibtex==0.* + build-depends: split==0.* + build-depends: gtk==0.11.* + build-depends: glib==0.11.* + build-depends: download-curl==0.* + build-depends: curl==1.3.* + build-depends: bytestring==0.* + build-depends: gnomevfs==0.11.* + build-depends: utf8-string==0.3.* + build-depends: ConfigFile==1.0.* + + other-modules: + BibDB Config MaybeIO TypedBibData BibAttach BibFile SuffixTreeCluster + + +executable imbibatch + main-is: Batch.hs + extensions: TypeSynonymInstances, RecordWildCards, FlexibleInstances, RankNTypes, GADTs + build-depends: base==4.* + build-depends: mtl==1.1.* + build-depends: parsec==2.1.* + build-depends: process==1.0.* + build-depends: filepath==1.1.* + build-depends: directory==1.0.* + build-depends: containers==0.* + build-depends: bibtex==0.* + build-depends: split==0.* + build-depends: bytestring==0.* + build-depends: ConfigFile==1.0.* + + +