{-# 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