ovechka.hs

module Main (main) where

import           Control.Applicative
import           Control.Monad
import           Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as ByteString (readInt)
import qualified Data.ByteString.Unsafe as ByteString
import qualified Data.HashMap.Strict as Map
import           Data.Char (ord)
import           System.IO
import           System.IO.Error


tar :: FilePath
tar = "/home/maksenov/.cabal/packages/hackage.haskell.org/00-index.tar"

main :: IO ()
main = do
  xs <- Map.toList . Map.fromListWith max . map parseRecord <$> parseFile tar
  mapM_ print xs

parseFile :: FilePath -> IO [ByteString]
parseFile filepath = do
  h <- openFile filepath ReadMode
  while (ByteString.hGet h 135) ((== 135) . ByteString.length) $ \bs ->
    let (path, _) = ByteString.breakByte 0 bs
        size      = parseSize bs
    in do
      hSeek h RelativeSeek
        ((512 - 135) + ((size `quot` 512) + (if size `rem` 512 > 0 then 1 else 0)) * 512);
      return path
     `catchIOError`
      \_ -> return path

parseSize :: ByteString -> Integer
parseSize =
    ByteString.foldl' (\a x -> a * 8 + fi x - fi (ord '0')) 0
  . ByteString.unsafeTake 11
  . ByteString.unsafeDrop 124

fi :: (Integral a, Integral b) => a -> b
fi = fromIntegral


parseRecord :: ByteString -> (ByteString, (Int, Int, Int, Int))
parseRecord xs =
  case ByteString.breakByte (fi (ord '/')) xs of
    (ys, xs') -> case ByteString.breakByte (fi (ord '/')) (ByteString.drop 1 xs') of
      (zs, _) -> (ys, parseVersion zs)

parseVersion :: ByteString -> (Int, Int, Int, Int)
parseVersion as =
  case ByteString.readInt as of
    Just (a, bs) -> case ByteString.readInt (ByteString.drop 1 bs) of
      Just (b, cs) -> case ByteString.readInt (ByteString.drop 1 cs) of
        Just (c, ds) -> case ByteString.readInt (ByteString.drop 1 ds) of
          Just (d, _) -> (a, b, c, d)
          Nothing     -> (a, b, c, 0)
        Nothing     -> (a, b, 0, 0)
      Nothing     -> (a, 0, 0, 0)
    Nothing     -> (0, 0, 0, 0)


while :: Monad m => m a -> (a -> Bool) -> (a -> m b) -> m [b]
while ma p amb = go
 where
  go = do
    a <- ma
    if p a
      then do
        b <- amb a
        liftM (b :) go
      else
        return []
{-# INLINE while #-}