{-# LANGUAGE OverloadedStrings #-}
module Distribution.Cab.VerDB (
PkgName
, VerDB
, HowToObtain(..)
, getVerDB
, 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
(VerDB -> VerDB -> Bool) -> (VerDB -> VerDB -> Bool) -> Eq VerDB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerDB -> VerDB -> Bool
== :: VerDB -> VerDB -> Bool
$c/= :: VerDB -> VerDB -> Bool
/= :: VerDB -> VerDB -> Bool
Eq, Int -> VerDB -> ShowS
[VerDB] -> ShowS
VerDB -> PkgName
(Int -> VerDB -> ShowS)
-> (VerDB -> PkgName) -> ([VerDB] -> ShowS) -> Show VerDB
forall a.
(Int -> a -> ShowS) -> (a -> PkgName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerDB -> ShowS
showsPrec :: Int -> VerDB -> ShowS
$cshow :: VerDB -> PkgName
show :: VerDB -> PkgName
$cshowList :: [VerDB] -> ShowS
showList :: [VerDB] -> ShowS
Show)
data HowToObtain = InstalledOnly | AllRegistered
getVerDB :: HowToObtain -> IO VerDB
getVerDB :: HowToObtain -> IO VerDB
getVerDB HowToObtain
how = [(PkgName, Ver)] -> VerDB
VerDB ([(PkgName, Ver)] -> VerDB)
-> ((ExitCode, [(PkgName, Maybe [Int])]) -> [(PkgName, Ver)])
-> (ExitCode, [(PkgName, Maybe [Int])])
-> VerDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExitCode, [(PkgName, Maybe [Int])]) -> [(PkgName, Ver)]
forall {a} {a}. (a, [(a, Maybe [Int])]) -> [(a, Ver)]
justOnly ((ExitCode, [(PkgName, Maybe [Int])]) -> VerDB)
-> IO (ExitCode, [(PkgName, Maybe [Int])]) -> IO VerDB
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 = ResourceT IO (ExitCode, [(PkgName, Maybe [Int])])
-> IO (ExitCode, [(PkgName, Maybe [Int])])
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (ExitCode, [(PkgName, Maybe [Int])])
-> IO (ExitCode, [(PkgName, Maybe [Int])]))
-> ResourceT IO (ExitCode, [(PkgName, Maybe [Int])])
-> IO (ExitCode, [(PkgName, Maybe [Int])])
forall a b. (a -> b) -> a -> b
$ PkgName
-> ConduitT ByteString Void (ResourceT IO) [(PkgName, Maybe [Int])]
-> ResourceT IO (ExitCode, [(PkgName, Maybe [Int])])
forall (m :: * -> *) a.
MonadIO m =>
PkgName -> ConduitT ByteString Void m a -> m (ExitCode, a)
sourceCmdWithConsumer PkgName
script ConduitT ByteString Void (ResourceT IO) [(PkgName, Maybe [Int])]
forall {o}.
ConduitT ByteString o (ResourceT IO) [(PkgName, Maybe [Int])]
cabalListParser
justOnly :: (a, [(a, Maybe [Int])]) -> [(a, Ver)]
justOnly = ((a, Maybe [Int]) -> (a, Ver)) -> [(a, Maybe [Int])] -> [(a, Ver)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe [Int] -> Ver) -> (a, Maybe [Int]) -> (a, Ver)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ([Int] -> Ver
toVer ([Int] -> Ver) -> (Maybe [Int] -> [Int]) -> Maybe [Int] -> Ver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Int] -> [Int]
forall a. HasCallStack => Maybe a -> a
fromJust)) ([(a, Maybe [Int])] -> [(a, Ver)])
-> ((a, [(a, Maybe [Int])]) -> [(a, Maybe [Int])])
-> (a, [(a, Maybe [Int])])
-> [(a, Ver)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Maybe [Int]) -> Bool)
-> [(a, Maybe [Int])] -> [(a, Maybe [Int])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe [Int] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Int] -> Bool)
-> ((a, Maybe [Int]) -> Maybe [Int]) -> (a, Maybe [Int]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Maybe [Int]) -> Maybe [Int]
forall a b. (a, b) -> b
snd) ([(a, Maybe [Int])] -> [(a, Maybe [Int])])
-> ((a, [(a, Maybe [Int])]) -> [(a, Maybe [Int])])
-> (a, [(a, Maybe [Int])])
-> [(a, Maybe [Int])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [(a, Maybe [Int])]) -> [(a, Maybe [Int])]
forall a b. (a, b) -> b
snd
cabalListParser :: ConduitT ByteString o (ResourceT IO) [(PkgName, Maybe [Int])]
cabalListParser = Parser ByteString [(PkgName, Maybe [Int])]
-> ConduitT ByteString o (ResourceT IO) [(PkgName, Maybe [Int])]
forall a (m :: * -> *) b o.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a o m b
sinkParser Parser ByteString [(PkgName, Maybe [Int])]
verinfos
toList :: VerDB -> [(PkgName, Ver)]
toList :: VerDB -> [(PkgName, Ver)]
toList (VerDB [(PkgName, Ver)]
alist) = [(PkgName, Ver)]
alist
toMap :: VerDB -> Map PkgName Ver
toMap :: VerDB -> Map PkgName Ver
toMap (VerDB [(PkgName, Ver)]
alist) = [(PkgName, Ver)] -> Map PkgName Ver
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(PkgName, Ver)]
alist
verinfos :: Parser [VerInfo]
verinfos :: Parser ByteString [(PkgName, Maybe [Int])]
verinfos = Parser ByteString (PkgName, Maybe [Int])
-> Parser ByteString [(PkgName, Maybe [Int])]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString (PkgName, Maybe [Int])
verinfo
verinfo :: Parser VerInfo
verinfo :: Parser ByteString (PkgName, Maybe [Int])
verinfo = do
PkgName
name <- ByteString -> Parser ByteString
string ByteString
"* " Parser ByteString
-> Parser ByteString PkgName -> Parser ByteString PkgName
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString PkgName
nonEols Parser ByteString PkgName
-> Parser ByteString () -> Parser ByteString PkgName
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
endOfLine
Parser ByteString ()
synpsis
Maybe [Int]
lat <- Parser ByteString
latestLabel Parser ByteString
-> Parser ByteString (Maybe [Int])
-> Parser ByteString (Maybe [Int])
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (Maybe [Int])
latest Parser ByteString (Maybe [Int])
-> Parser ByteString () -> Parser ByteString (Maybe [Int])
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
endOfLine
[()]
_ <- Parser ByteString () -> Parser ByteString [()]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ByteString ()
skip
Parser ByteString ()
endOfLine
(PkgName, Maybe [Int]) -> Parser ByteString (PkgName, Maybe [Int])
forall a. a -> Parser ByteString a
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: "
Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
string ByteString
" Latest version available: "
skip :: Parser ByteString ()
skip = Parser ByteString PkgName -> Parser ByteString [PkgName]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString PkgName
nonEols Parser ByteString [PkgName]
-> Parser ByteString () -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
endOfLine
synpsis :: Parser ByteString ()
synpsis = ByteString -> Parser ByteString
string ByteString
" Synopsis:" Parser ByteString
-> Parser ByteString PkgName -> Parser ByteString PkgName
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString PkgName
nonEols Parser ByteString PkgName
-> Parser ByteString () -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
endOfLine Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
more
Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Parser ByteString ()
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
more :: Parser ByteString ()
more = () () -> Parser ByteString [()] -> Parser ByteString ()
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString () -> Parser ByteString [()]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ByteString -> Parser ByteString
string ByteString
" " Parser ByteString
-> Parser ByteString PkgName -> Parser ByteString PkgName
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString PkgName
nonEols Parser ByteString PkgName
-> Parser ByteString () -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
endOfLine)
latest :: Parser ByteString (Maybe [Int])
latest = Maybe [Int]
forall a. Maybe a
Nothing Maybe [Int]
-> Parser ByteString PkgName -> Parser ByteString (Maybe [Int])
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Parser Char
char Char
'[' Parser Char
-> Parser ByteString PkgName -> Parser ByteString PkgName
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString PkgName
nonEols)
Parser ByteString (Maybe [Int])
-> Parser ByteString (Maybe [Int])
-> Parser ByteString (Maybe [Int])
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just ([Int] -> Maybe [Int])
-> Parser ByteString [Int] -> Parser ByteString (Maybe [Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [Int]
dotted
dotted :: Parser [Int]
dotted :: Parser ByteString [Int]
dotted = Parser Int
forall a. Integral a => Parser a
decimal Parser Int -> Parser Char -> Parser ByteString [Int]
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 = Parser Char -> Parser ByteString PkgName
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Parser Char -> Parser ByteString PkgName)
-> Parser Char -> Parser ByteString PkgName
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Char
satisfy (PkgName -> Char -> Bool
notInClass PkgName
"\r\n")