-----------------------------------------------------------------------------
-- |
-- Module      :  Main
-- Copyright   :  (C) Peter Robinson 2010-2012
-- License     :  GPL-2
--
-- Maintainer  :  Peter Robinson <thaldyron@gmail.com>
-- Stability   :  experimental
-- Portability :  portable 
--
-----------------------------------------------------------------------------
module Main
where
import Control.Monad
import Control.Applicative
import Control.Concurrent
import Control.Exception
import Data.GraphViz
import Data.GraphViz.Attributes.Complete
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.List as L
import System
-- import System.IO.Error
import System.Directory
import Data.Maybe
import Data.Text.Lazy(Text)
import Data.Text.Lazy.Encoding 
import qualified Data.Text.Lazy as T
import System.Console.CmdArgs
import Prelude hiding(catch)

import Extract
import Entry
import Graph


-- command line arguments:
data MathGenealogy = MathGenealogy 
  { filePrefix   :: String 
  , keepDotFile  :: Bool
  , graphvizArgs :: String
  , noPDF        :: Bool
  , quiet        :: Bool
  , startURL     :: String
  }
  deriving(Eq,Data,Typeable,Show)

mathGenealogy = MathGenealogy
  { startURL     = def &= args &= typ "URL" 
  , filePrefix   = "output" &= typ "PREFIX" 
  , keepDotFile  = False 
  , graphvizArgs = " -Tpdf -Gcharset=utf8 " &= typ "<graphviz parameters>" &= opt " -Tpdf -Gcharset=utf8 "
  , noPDF        = False
  , quiet        = False
  } &= summary "Mathematics Genealogy Visualizer" 
    &= details[ "Run the program with a start-URL, for example:",
             "# mathgenealogy http://genealogy.math.ndsu.nodak.edu/id.php?id=18231"]

-- | GraphViz style attributes for edges and nodes.
-- See: http://hackage.haskell.org/packages/archive/graphviz/2999.12.0.4/doc/html/Data-GraphViz-Attributes.html
-- TODO: figure out if GraphViz supports CSS files or similar. 
edgeAtt = const [ Dir Forward
                , color LightBlue2
                ] 

nodeAtt (num,e) = 
  [ textLabel (T.pack (show e)) 
  , Shape BoxShape
  , if num == 1 then FontSize 18 else FontSize 14
  , styles [rounded,filled,bold]
  , color LightYellow1
  , FontName (T.pack "ZapfChancery-MediumItalic") -- "Helvetica")
  ]


main = do
  MathGenealogy filePrefix keepDotFile graphvizArgs noPdf quiet startURL 
      <- cmdArgs mathGenealogy
  when (null startURL) $ 
    throw (userError "Missing start-URL. Run 'mathgenealogy --help' for help.")

  gvExecutable <- (do m <- findExecutable "dot" 
                      if m == Nothing 
                        then throw (userError "Error - Couldn't find 'dot' program")
                        else return (fromJust m))
  putStrLn "Downloading data..."
  theGraph <- entryGraph <$> traverseEntries quiet [T.pack startURL]
  putStrLn "done. :)"
  let dotFileName = filePrefix ++ ".dot"         
  putStr $ "Writing DOT-file " ++ dotFileName ++ "..."
  let output = printDotGraph $ 
                 graphToDot nonClusteredParams{ fmtNode = nodeAtt 
                                              , fmtEdge = edgeAtt
                                              } theGraph
  B.writeFile dotFileName (encodeUtf8 output)
    `catch` (\(e::IOException) -> do { print e ; throw e })
  putStrLn "done. :)"

  unless noPdf $ do
    putStr "Generating graphics file..."
    let command = gvExecutable ++ " " ++ graphvizArgs ++ " " ++ dotFileName ++ " > " 
                              ++ filePrefix ++ ".pdf" 
    print command
    result <- system command
    when (isExitFailure result) $ do
      print $ "Error running the graphviz (dot) program. I tried: " ++ command
      throw $ userError "Existing."
    putStrLn "done. :)"
  unless keepDotFile $ removeFile dotFileName
  where
    isExitFailure (ExitFailure _) = True
    isExitFailure _               = False

    -- TODO: Build the graph here?
    traverseEntries :: Bool -> [Text] -> IO [Entry]
    traverseEntries quiet = traverseEntries' [] []
      where
        traverseEntries' acc _        []         = return $ L.nub acc
        traverseEntries' acc prevUrls (url:urls) = do
          e <- downloadEntry url
          threadDelay 1000000
          unless quiet $ print e
          let newUrls = urlAdvisors e
          traverseEntries' (e:acc) (url:prevUrls) ((newUrls L.\\ prevUrls) ++ urls)
    
downloadEntry :: Text -> IO Entry
downloadEntry = liftM parseEntry . getTags