{-# 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
/= :: VerDB -> VerDB -> Bool
$c/= :: VerDB -> VerDB -> Bool
== :: VerDB -> VerDB -> Bool
$c== :: VerDB -> VerDB -> Bool
Eq, Int -> VerDB -> ShowS
[VerDB] -> ShowS
VerDB -> String
(Int -> VerDB -> ShowS)
-> (VerDB -> String) -> ([VerDB] -> ShowS) -> Show VerDB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerDB] -> ShowS
$cshowList :: [VerDB] -> ShowS
show :: VerDB -> String
$cshow :: VerDB -> String
showsPrec :: Int -> VerDB -> ShowS
$cshowsPrec :: Int -> VerDB -> ShowS
Show)
data HowToObtain = InstalledOnly | AllRegistered
getVerDB :: HowToObtain -> IO VerDB
getVerDB :: HowToObtain -> IO VerDB
getVerDB HowToObtain
how = [(String, Ver)] -> VerDB
VerDB ([(String, Ver)] -> VerDB)
-> ((ExitCode, [(String, Maybe [Int])]) -> [(String, Ver)])
-> (ExitCode, [(String, Maybe [Int])])
-> VerDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExitCode, [(String, Maybe [Int])]) -> [(String, Ver)]
forall a a. (a, [(a, Maybe [Int])]) -> [(a, Ver)]
justOnly ((ExitCode, [(String, Maybe [Int])]) -> VerDB)
-> IO (ExitCode, [(String, Maybe [Int])]) -> IO VerDB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (ExitCode, [(String, Maybe [Int])])
verInfos
where
script :: String
script = case HowToObtain
how of
HowToObtain
InstalledOnly -> String
"cabal list --installed"
HowToObtain
AllRegistered -> String
"cabal list"
verInfos :: IO (ExitCode, [(String, Maybe [Int])])
verInfos = ResourceT IO (ExitCode, [(String, Maybe [Int])])
-> IO (ExitCode, [(String, Maybe [Int])])
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (ExitCode, [(String, Maybe [Int])])
-> IO (ExitCode, [(String, Maybe [Int])]))
-> ResourceT IO (ExitCode, [(String, Maybe [Int])])
-> IO (ExitCode, [(String, Maybe [Int])])
forall a b. (a -> b) -> a -> b
$ String
-> ConduitT ByteString Void (ResourceT IO) [(String, Maybe [Int])]
-> ResourceT IO (ExitCode, [(String, Maybe [Int])])
forall (m :: * -> *) a.
MonadIO m =>
String -> ConduitT ByteString Void m a -> m (ExitCode, a)
sourceCmdWithConsumer String
script ConduitT ByteString Void (ResourceT IO) [(String, Maybe [Int])]
forall o.
ConduitT ByteString o (ResourceT IO) [(String, 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 (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) [(String, Maybe [Int])]
cabalListParser = Parser ByteString [(String, Maybe [Int])]
-> ConduitT ByteString o (ResourceT IO) [(String, Maybe [Int])]
forall a (m :: * -> *) b o.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a o m b
sinkParser Parser ByteString [(String, Maybe [Int])]
verinfos
toList :: VerDB -> [(PkgName, Ver)]
toList :: VerDB -> [(String, Ver)]
toList (VerDB [(String, Ver)]
alist) = [(String, Ver)]
alist
toMap :: VerDB -> Map PkgName Ver
toMap :: VerDB -> Map String Ver
toMap (VerDB [(String, Ver)]
alist) = [(String, Ver)] -> Map String Ver
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String, Ver)]
alist
verinfos :: Parser [VerInfo]
verinfos :: Parser ByteString [(String, Maybe [Int])]
verinfos = Parser ByteString (String, Maybe [Int])
-> Parser ByteString [(String, Maybe [Int])]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString (String, Maybe [Int])
verinfo
verinfo :: Parser VerInfo
verinfo :: Parser ByteString (String, Maybe [Int])
verinfo = do
String
name <- ByteString -> Parser ByteString
string ByteString
"* " Parser ByteString
-> Parser ByteString String -> Parser ByteString String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString String
nonEols Parser ByteString String
-> Parser ByteString () -> Parser ByteString String
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 (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
endOfLine
[()]
_ <- Parser ByteString () -> Parser ByteString [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ByteString ()
skip
Parser ByteString ()
endOfLine
(String, Maybe [Int]) -> Parser ByteString (String, Maybe [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, Maybe [Int]
lat)
where
latestLabel :: Parser ByteString
latestLabel = ByteString -> Parser ByteString
string ByteString
" Default available version: "
Parser ByteString -> Parser ByteString -> Parser ByteString
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 String -> Parser ByteString [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString String
nonEols Parser ByteString [String]
-> Parser ByteString () -> Parser ByteString ()
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 String -> Parser ByteString String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString String
nonEols Parser ByteString String
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
endOfLine Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
more
Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Parser ByteString ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
more :: Parser ByteString ()
more = () () -> Parser ByteString [()] -> Parser ByteString ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString () -> Parser ByteString [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ByteString -> Parser ByteString
string ByteString
" " Parser ByteString
-> Parser ByteString String -> Parser ByteString String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString String
nonEols Parser ByteString String
-> Parser ByteString () -> Parser ByteString ()
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 String -> Parser ByteString (Maybe [Int])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Parser Char
char Char
'[' Parser Char -> Parser ByteString String -> Parser ByteString String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString String
nonEols)
Parser ByteString (Maybe [Int])
-> Parser ByteString (Maybe [Int])
-> Parser ByteString (Maybe [Int])
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 String
nonEols = Parser Char -> Parser ByteString String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Parser Char -> Parser ByteString String)
-> Parser Char -> Parser ByteString String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Char
satisfy (String -> Char -> Bool
notInClass String
"\r\n")