--------------------------------------------------------------------
-- |
-- Module    : Generate gnuplot graphs of hackage activity
-- Copyright : (c) Don Stewart 2008
-- License   : BSD3
--
-- Maintainer: Don Stewart <dons@galois.com>
-- Stability : provisional
-- Portability:
--
--------------------------------------------------------------------

import Data.List
import Data.Maybe
import System.Directory
import System.FilePath
import System.Locale
import System.Time
import System.Time.Parse
import Text.HTML.Download
import Graphics.Gnuplot.Simple
import qualified Data.IntMap as I

url = "http://hackage.haskell.org/packages/archive/log"

main = do
    xs <- gettime
    let ys = [ (i,d) | ((_,d), i) <- zip xs [1..] ]
        zs = sliding ys [1.. length ys]

    plotList [Key Nothing
             ,YRange (0,maximum (map snd zs) + 1)
             ,XLabel "Days since launch of Hackage"
             ,YLabel "Unique uploads"
             ,Title "Daily uploads (90 day moving average) to http://hackage.haskell.org"
             ,PNG "/tmp/hackage-daily-graph.png"] (map snd zs)

    print "Output written to: /tmp/hackage-daily-graph.png"

-- sliding average window
window :: Int
window = 90

--
-- compute the 7-day sliding average, starting with a sparse sequence
--
-- sliding :: [(Int,Int)] -> [Int] -> [(Int,Double)]
sliding [] _    = []
sliding xs days = [ (i,slidingAv i) | i <- days' ]
  where
    m     = window `div` 2 -- 1/2 n

    days' = drop m . take (max 0 (length days - window+m+1)) $ days
    table = I.fromList xs :: I.IntMap Int -- to handle missing elems easily

    slidingAv :: Int -> Double
    slidingAv i = fromIntegral (sum seqN) / fromIntegral window
        where seqN = map (\j -> I.findWithDefault 0 j table) [i-m..i+(window-m-1)]

gettime :: IO [(CalendarTime, Int)]
gettime = do
    pwd <- getCurrentDirectory
    src <- openURL url

    let dates = catMaybes . sort . map parse . lines $ src

    let days = groupBy day $ dates

    return [ (head d, length d) | d <- days ]

  where
    parse = parseCalendarTime defaultTimeLocale "%c"
    month a b = ctYear a == ctYear b && ctMonth a == ctMonth b
    day   a b = month a b && ctDay a == ctDay b