{-# LANGUAGE OverloadedStrings #-}

module Distribution.Cab.VerDB (
  -- * Types
    PkgName
  , VerDB
  , HowToObtain(..)
  -- * Creating
  , getVerDB
  -- * Converting
  , toList
  , toMap
  ) where

import Control.Applicative
import Control.Arrow (second)
import Control.Monad.Trans.Resource (runResourceT)
import Data.Attoparsec.ByteString.Char8
import Data.Conduit.Attoparsec
import Data.Conduit.Process
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Distribution.Cab.Version

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

type PkgName = String

type VerInfo = (PkgName, Maybe [Int])

newtype VerDB = VerDB [(PkgName,Ver)] deriving (VerDB -> VerDB -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerDB -> VerDB -> Bool
$c/= :: VerDB -> VerDB -> Bool
== :: VerDB -> VerDB -> Bool
$c== :: VerDB -> VerDB -> Bool
Eq, Int -> VerDB -> ShowS
[VerDB] -> ShowS
VerDB -> PkgName
forall a.
(Int -> a -> ShowS) -> (a -> PkgName) -> ([a] -> ShowS) -> Show a
showList :: [VerDB] -> ShowS
$cshowList :: [VerDB] -> ShowS
show :: VerDB -> PkgName
$cshow :: VerDB -> PkgName
showsPrec :: Int -> VerDB -> ShowS
$cshowsPrec :: Int -> VerDB -> ShowS
Show)

data HowToObtain = InstalledOnly | AllRegistered

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

getVerDB :: HowToObtain -> IO VerDB
getVerDB :: HowToObtain -> IO VerDB
getVerDB HowToObtain
how = [(PkgName, Ver)] -> VerDB
VerDB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a}. (a, [(a, Maybe [Int])]) -> [(a, Ver)]
justOnly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (ExitCode, [(PkgName, Maybe [Int])])
verInfos
  where
    script :: PkgName
script = case HowToObtain
how of
        HowToObtain
InstalledOnly -> PkgName
"cabal list --installed"
        HowToObtain
AllRegistered -> PkgName
"cabal list"
    verInfos :: IO (ExitCode, [(PkgName, Maybe [Int])])
verInfos = forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadIO m =>
PkgName -> ConduitT ByteString Void m a -> m (ExitCode, a)
sourceCmdWithConsumer PkgName
script forall {o}.
ConduitT ByteString o (ResourceT IO) [(PkgName, Maybe [Int])]
cabalListParser
    justOnly :: (a, [(a, Maybe [Int])]) -> [(a, Ver)]
justOnly = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ([Int] -> Ver
toVer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
    cabalListParser :: ConduitT ByteString o (ResourceT IO) [(PkgName, Maybe [Int])]
cabalListParser = forall a (m :: * -> *) b o.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a o m b
sinkParser Parser [(PkgName, Maybe [Int])]
verinfos

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

-- | Converting 'VerDB' to alist.
--
-- >>> db <- getVerDB InstalledOnly
-- >>> elem "base" . map fst . toList $ db
-- True
toList :: VerDB -> [(PkgName, Ver)]
toList :: VerDB -> [(PkgName, Ver)]
toList (VerDB [(PkgName, Ver)]
alist) = [(PkgName, Ver)]
alist

-- | Converting 'VerDB' to 'Map'.
toMap :: VerDB -> Map PkgName Ver
toMap :: VerDB -> Map PkgName Ver
toMap (VerDB [(PkgName, Ver)]
alist) = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(PkgName, Ver)]
alist

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

verinfos :: Parser [VerInfo]
verinfos :: Parser [(PkgName, Maybe [Int])]
verinfos = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser (PkgName, Maybe [Int])
verinfo

verinfo :: Parser VerInfo
verinfo :: Parser (PkgName, Maybe [Int])
verinfo = do
    PkgName
name <- ByteString -> Parser ByteString
string ByteString
"* " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString PkgName
nonEols forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfLine
    Parser ()
synpsis
    Maybe [Int]
lat <- Parser ByteString
latestLabel forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (Maybe [Int])
latest forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfLine
    [()]
_ <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ()
skip
    Parser ()
endOfLine
    forall (m :: * -> *) a. Monad m => a -> m a
return (PkgName
name, Maybe [Int]
lat)
  where
    latestLabel :: Parser ByteString
latestLabel = ByteString -> Parser ByteString
string ByteString
"    Default available version: " -- cabal 0.10
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
string ByteString
"    Latest version available: "  -- cabal 0.8
    skip :: Parser ()
skip = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString PkgName
nonEols forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
endOfLine
    synpsis :: Parser ()
synpsis = ByteString -> Parser ByteString
string ByteString
"    Synopsis:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString PkgName
nonEols forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
endOfLine forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
more
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      where
        more :: Parser ()
more = () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ByteString -> Parser ByteString
string ByteString
"     " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString PkgName
nonEols forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
endOfLine)
    latest :: Parser ByteString (Maybe [Int])
latest = forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Parser Char
char Char
'[' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString PkgName
nonEols)
         forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Int]
dotted

dotted :: Parser [Int]
dotted :: Parser [Int]
dotted = forall a. Integral a => Parser a
decimal forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Char -> Parser Char
char Char
'.'

nonEols :: Parser String
nonEols :: Parser ByteString PkgName
nonEols = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Char
satisfy (PkgName -> Char -> Bool
notInClass PkgName
"\r\n")