Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 73 lines (57 sloc) 2.13 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
{-# LANGUAGE OverloadedStrings #-}

module VerDB (
    VerDB, getVerDB, lookupLatestVersion, getVerAlist
  ) where

import Control.Applicative hiding (many)
import Control.Arrow (second)
import Data.Attoparsec.Char8
import Data.Attoparsec.Enumerator
import Data.ByteString (ByteString)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Process

----------------------------------------------------------------

type VerInfo = (String, Maybe [Int])

data VerDB = VerDB (Map String [Int])

----------------------------------------------------------------

getVerDB :: IO VerDB
getVerDB = VerDB . M.fromList <$> getVerAlist True

getVerAlist :: Bool -> IO [(String,[Int])]
getVerAlist installedOnly = justOnly <$> verInfos
  where
    script = if installedOnly
             then "cabal list --installed"
             else "cabal list"
    verInfos = infoFromProcess script cabalListParser
    justOnly = map (second fromJust) . filter (isJust . snd)

----------------------------------------------------------------

lookupLatestVersion :: String -> VerDB -> Maybe [Int]
lookupLatestVersion pkgid (VerDB db) = M.lookup pkgid db

----------------------------------------------------------------

cabalListParser :: Iteratee ByteString IO [VerInfo]
cabalListParser = iterParser verinfos

verinfos :: Parser [VerInfo]
verinfos = many1 verinfo

verinfo :: Parser VerInfo
verinfo = do
    name <- string "* " *> nonEols <* endOfLine
    synpsis
    lat <- latestLabel *> latest <* endOfLine
    many skip
    endOfLine
    return (name, lat)
  where
    latestLabel = string " Default available version: " -- cabal 0.10
              <|> string " Latest version available: " -- cabal 0.8
    skip = many1 nonEols *> endOfLine
    synpsis = string " Synopsis:" *> nonEols *> endOfLine *> more
          <|> return ()
      where
        more = () <$ many (string " " *> nonEols *> endOfLine)
    latest = Nothing <$ (char '[' *> nonEols)
         <|> Just <$> dotted

dotted :: Parser [Int]
dotted = decimal `sepBy` char '.'

nonEols :: Parser String
nonEols = many1 $ satisfy (notInClass "\r\n")
Something went wrong with that request. Please try again.