UploadLog.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  ImportClient.UploadLog
-- Copyright   :  (c) Ross Paterson 2007
--                    Duncan Coutts 2008
-- License     :  BSD-like
--
-- Maintainer  :  duncan@community.haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Support for reading the upload log of the old hackage server.
-----------------------------------------------------------------------------
module Distribution.Client.UploadLog (
    Entry(..),
    read,
    collectUploadInfo,
    collectMaintainerInfo,
  ) where

import Distribution.Server.Users.Types
         ( UserName )

import Distribution.Package
         ( PackageId, PackageName, packageName, PackageIdentifier(..))
import Distribution.Text
         ( Text(..), simpleParse )
import Distribution.ParseUtils ( parsePackageNameQ )
import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint          as Disp
import Text.PrettyPrint
         ( (<+>) )
import Distribution.Simple.Utils
         ( comparing, equating )

import Data.Time.Clock
         ( UTCTime )
import Data.Time.LocalTime
         ( zonedTimeToUTC )
import Data.Time.Format
         ( readsTime, formatTime )
import System.Locale
         ( defaultTimeLocale )
import Data.List
         ( sortBy, groupBy, nub )

import Prelude hiding (read)

data Entry = Entry UTCTime UserName PackageIdentifier
  deriving (Eq, Ord, Show)

instance Text Entry where
  disp (Entry time user pkgid) =
        Disp.text (formatTime defaultTimeLocale "%c" time)
    <+> disp user <+> disp pkgid
  parse = do
    time <- Parse.readS_to_P (readsTime defaultTimeLocale "%c")
    Parse.skipSpaces
    user <- parse
    Parse.skipSpaces
    pkg  <- parsePackageNameQ
    Parse.skipSpaces
    ver  <- parse
    let pkgid = PackageIdentifier pkg ver
    return (Entry (zonedTimeToUTC time) user pkgid)

-- | Returns a list of log entries, however some packages have been uploaded
-- more than once, so each entry is paired with any older entries for the same
-- package.
--
read :: String -> Either String [Entry]
read = check [] . map parseLine . lines
  where
    check es' []           = Right (reverse es')
    check es' (Right e:es) = check (e:es') es
    check _   (Left err:_) = Left err
    parseLine line = maybe (Left err) Right (simpleParse line)
      where err = "Failed to parse log line:\n" ++ show line

collectUploadInfo :: [Entry] -> [(PackageId, UTCTime, UserName)]
collectUploadInfo =
    map (uploadInfo . sortBy (comparing entryTime))
  . groupBy (equating entryPackageId)
  . sortBy (comparing entryPackageId)
  where
    entryPackageId (Entry _  _ pkgid) = pkgid
    entryTime      (Entry t  _ _)     = t

    uploadInfo :: [Entry] -> (PackageId, UTCTime, UserName)
    uploadInfo entries =
      case last entries of
        Entry time uname pkgid -> (pkgid, time, uname)

collectMaintainerInfo :: [Entry] -> [(PackageName, [UserName])]
collectMaintainerInfo =
    map maintainersInfo
  . groupBy (equating entryPackageName)
  . sortBy (comparing entryPackageName)
  where
    entryPackageName (Entry _  _ pkgid) = packageName pkgid

    maintainersInfo :: [Entry] -> (PackageName, [UserName])
    maintainersInfo entries =
        (packageName pkgid, maintainers)
      where
        Entry _ _ pkgid = head entries
        maintainers     = nub [ uname | Entry _ uname _ <- entries ]