module Distribution.ArchLinux.AUR (
AURInfo(..),
info,
search,
maintainer,
package
) where
import Network.HTTP
import Distribution.Version
import Distribution.Text
import Text.JSON
import Text.JSON.String
import Text.PrettyPrint
import Text.PrettyPrint.HughesPJClass
import qualified Data.Map as M
import Control.Monad
import System.FilePath
import Data.List
import Data.Char
import Distribution.ArchLinux.PkgBuild
info :: String -> IO (Either String AURInfo)
info m = eval (InfoRequest (Name m))
search :: String -> IO [AURInfo]
search m = do
v <- eval (SearchRequest (Name m))
return $ case v of
Left e -> []
Right a -> flatten a
maintainer :: String -> IO [AURInfo]
maintainer m = do
v <- eval (MaintainerRequest (Name m))
return $ case v of
Left e -> []
Right a -> maintainerPackages a
package :: String -> IO (Either String AURInfo, Either String AnnotatedPkgBuild)
package m = do
v <- info m
case v of
Left s -> return $ (Left s, Left "No PKGBUILD found")
Right p -> do
let name = packageName p
aurUrl = "http://aur.archlinux.org/packages" </> name </> name </> "PKGBUILD"
rsp <- simpleHTTP (getRequest aurUrl)
case rsp of
Left err -> return $ (Right p, Left (show err))
Right _ -> do
pkg <- getResponseBody rsp
case decodePackage pkg of
Left e -> return (Right p, Left e)
Right k -> return (Right p, Right k)
url :: Doc
url = text "http://aur.archlinux.org/rpc.php"
eval :: JSON a => AURRequest -> IO (Either String a)
eval m = do
rsp <- simpleHTTP (getRequest call)
json <- getResponseBody rsp
return . resultToEither . decode $ json
where
call = render $ url <?> pPrint m
data AURRequest
= SearchRequest Name
| MaintainerRequest Name
| InfoRequest Name
deriving Show
instance Pretty AURRequest where
pPrint (SearchRequest n) = text "type" <=> text "search" <&> text "arg" <=> pPrint n
pPrint (InfoRequest n) = text "type" <=> text "info" <&> text "arg" <=> pPrint n
pPrint (MaintainerRequest n) = text "type" <=> text "msearch" <&> text "arg" <=> pPrint n
newtype Name = Name String
deriving Show
instance Pretty Name where
pPrint (Name n) = text n
infixl 6 <=>, <&>, <?>
(<=>), (<&>), (<?>) :: Doc -> Doc -> Doc
p <=> q = p <> char '=' <> q
p <&> q = p <> char '&' <> q
p <?> q = p <> char '?' <> q
data AURMaintainer = AURMaintainer { maintainerPackages :: [AURInfo] } deriving Show
instance JSON AURMaintainer where
showJSON = undefined
readJSON (JSObject o) = do
case M.lookup "type" json of
Just (JSString t) | fromJSString t == "msearch" -> do
as <- forM results $ \(JSObject o) -> do
let obj = M.fromList (fromJSObject o) :: M.Map String JSValue
parseInfo obj
return (AURMaintainer as)
s -> fail $ "No type field in JSON response!" ++ show s
where
json = M.fromList (fromJSObject o) :: M.Map String JSValue
results = case M.lookup "results" json of
Nothing -> error $ "No results for info object"
Just (JSArray a) -> a
data AURInfo
= AURInfo {
packageID :: Integer
,packageURLinAUR :: String
,packageName :: String
,packageVersion :: Either String (Version,String)
,packageCategory :: Integer
,packageDesc :: String
,packageLocation :: Integer
,packageURL :: String
,packagePath :: FilePath
,packageLicense :: String
,packageVotes :: Integer
,packageOutOfDate :: Bool
}
deriving Show
instance JSON AURInfo where
showJSON = undefined
readJSON (JSObject o) = do
case M.lookup "type" json of
Just (JSString t) | fromJSString t == "info" -> parseInfo results
s -> fail $ "No type field in JSON response!" ++ show s
where
json = M.fromList (fromJSObject o) :: M.Map String JSValue
results = case M.lookup "results" json of
Nothing -> error $ "No results for info object"
Just (JSObject o) -> M.fromList (fromJSObject o) :: M.Map String JSValue
data AURSearch = AURSearch { flatten :: [AURInfo] }
instance JSON AURSearch where
showJSON = undefined
readJSON (JSObject o) = do
case M.lookup "type" json of
Just (JSString t) | fromJSString t == "search" -> do
as <- forM results $ \(JSObject o) -> do
let obj = M.fromList (fromJSObject o) :: M.Map String JSValue
parseInfo obj
return (AURSearch as)
s -> fail $ "No type field in JSON response!" ++ show s
where
json = M.fromList (fromJSObject o) :: M.Map String JSValue
results = case M.lookup "results" json of
Nothing -> error $ "No results for info object"
Just (JSArray a) -> a
parseInfo :: M.Map String JSValue -> Result AURInfo
parseInfo info_obj = do
JSString id_ <- label "ID"
JSString name_ <- label "Name"
JSString vers_ <- label "Version"
JSString cat_ <- label "CategoryID"
JSString desc_ <- label "Description"
JSString loc_ <- label "LocationID"
JSString url_ <- label "URL"
JSString path_ <- label "URLPath"
JSString lic_ <- label "License"
JSString vote_ <- label "NumVotes"
JSString date_ <- label "OutOfDate"
let vers__ = fromJSString vers_
(x,xs) = break (== '-') vers__
version | '-' `elem` vers__ = case simpleParse x of
Nothing -> Left vers__
Just v -> Right (v, tail xs)
| otherwise = Left vers__
id_ident = read (fromJSString id_)
return $ AURInfo {
packageID = id_ident
,packageURLinAUR = "http://aur.archlinux.org/packages.php?ID=" ++ show id_ident
,packageName = fromJSString name_
,packageVersion = version
,packageCategory = read (fromJSString cat_)
,packageDesc = fromJSString desc_
,packageLocation = read (fromJSString loc_)
,packageURL = fromJSString url_
,packagePath = fromJSString path_
,packageLicense = fromJSString lic_
,packageVotes = read (fromJSString vote_)
,packageOutOfDate = case fromJSString date_ of
"0" -> False
_ -> True
}
where
label k = case M.lookup k info_obj of
Nothing -> fail $ "No field " ++ show k
Just o -> return o