{-# LANGUAGE OverloadedStrings, CPP #-}
module HsDev.Tools.Cabal (
CabalPackage(..),
cabalList,
Version, License(..)
) where
import Control.Arrow
import Control.Monad
import Data.Aeson
import Data.Char (isSpace)
import Data.Maybe
import Distribution.License
import Distribution.Text
import Distribution.Version
import HsDev.Tools.Base
import HsDev.Util
data CabalPackage = CabalPackage {
CabalPackage -> String
cabalPackageName :: String,
CabalPackage -> Maybe String
cabalPackageSynopsis :: Maybe String,
CabalPackage -> Maybe Version
cabalPackageDefaultVersion :: Maybe Version,
CabalPackage -> [Version]
cabalPackageInstalledVersions :: [Version],
CabalPackage -> Maybe String
cabalPackageHomepage :: Maybe String,
CabalPackage -> Maybe License
cabalPackageLicense :: Maybe License }
deriving (CabalPackage -> CabalPackage -> Bool
(CabalPackage -> CabalPackage -> Bool)
-> (CabalPackage -> CabalPackage -> Bool) -> Eq CabalPackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CabalPackage -> CabalPackage -> Bool
$c/= :: CabalPackage -> CabalPackage -> Bool
== :: CabalPackage -> CabalPackage -> Bool
$c== :: CabalPackage -> CabalPackage -> Bool
Eq, ReadPrec [CabalPackage]
ReadPrec CabalPackage
Int -> ReadS CabalPackage
ReadS [CabalPackage]
(Int -> ReadS CabalPackage)
-> ReadS [CabalPackage]
-> ReadPrec CabalPackage
-> ReadPrec [CabalPackage]
-> Read CabalPackage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CabalPackage]
$creadListPrec :: ReadPrec [CabalPackage]
readPrec :: ReadPrec CabalPackage
$creadPrec :: ReadPrec CabalPackage
readList :: ReadS [CabalPackage]
$creadList :: ReadS [CabalPackage]
readsPrec :: Int -> ReadS CabalPackage
$creadsPrec :: Int -> ReadS CabalPackage
Read, Int -> CabalPackage -> ShowS
[CabalPackage] -> ShowS
CabalPackage -> String
(Int -> CabalPackage -> ShowS)
-> (CabalPackage -> String)
-> ([CabalPackage] -> ShowS)
-> Show CabalPackage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CabalPackage] -> ShowS
$cshowList :: [CabalPackage] -> ShowS
show :: CabalPackage -> String
$cshow :: CabalPackage -> String
showsPrec :: Int -> CabalPackage -> ShowS
$cshowsPrec :: Int -> CabalPackage -> ShowS
Show)
instance ToJSON CabalPackage where
toJSON :: CabalPackage -> Value
toJSON CabalPackage
cp = [Pair] -> Value
object [
Text
"name" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CabalPackage -> String
cabalPackageName CabalPackage
cp,
Text
"synopsis" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CabalPackage -> Maybe String
cabalPackageSynopsis CabalPackage
cp,
Text
"default-version" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Version -> String) -> Maybe Version -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> String
forall a. Pretty a => a -> String
display (CabalPackage -> Maybe Version
cabalPackageDefaultVersion CabalPackage
cp),
Text
"installed-versions" Text -> [String] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Version -> String) -> [Version] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Version -> String
forall a. Pretty a => a -> String
display (CabalPackage -> [Version]
cabalPackageInstalledVersions CabalPackage
cp),
Text
"homepage" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CabalPackage -> Maybe String
cabalPackageHomepage CabalPackage
cp,
Text
"license" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (License -> String) -> Maybe License -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap License -> String
forall a. Pretty a => a -> String
display (CabalPackage -> Maybe License
cabalPackageLicense CabalPackage
cp)]
instance FromJSON CabalPackage where
parseJSON :: Value -> Parser CabalPackage
parseJSON = String
-> (Object -> Parser CabalPackage) -> Value -> Parser CabalPackage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"cabal-package" ((Object -> Parser CabalPackage) -> Value -> Parser CabalPackage)
-> (Object -> Parser CabalPackage) -> Value -> Parser CabalPackage
forall a b. (a -> b) -> a -> b
$ \Object
v -> String
-> Maybe String
-> Maybe Version
-> [Version]
-> Maybe String
-> Maybe License
-> CabalPackage
CabalPackage (String
-> Maybe String
-> Maybe Version
-> [Version]
-> Maybe String
-> Maybe License
-> CabalPackage)
-> Parser String
-> Parser
(Maybe String
-> Maybe Version
-> [Version]
-> Maybe String
-> Maybe License
-> CabalPackage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"name") Parser
(Maybe String
-> Maybe Version
-> [Version]
-> Maybe String
-> Maybe License
-> CabalPackage)
-> Parser (Maybe String)
-> Parser
(Maybe Version
-> [Version] -> Maybe String -> Maybe License -> CabalPackage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Object
v Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"synopsis") Parser
(Maybe Version
-> [Version] -> Maybe String -> Maybe License -> CabalPackage)
-> Parser (Maybe Version)
-> Parser
([Version] -> Maybe String -> Maybe License -> CabalPackage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
((Maybe (Maybe Version) -> Maybe Version
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Version) -> Maybe Version)
-> (Maybe String -> Maybe (Maybe Version))
-> Maybe String
-> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe Version) -> Maybe String -> Maybe (Maybe Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe Version
forall a. Parsec a => String -> Maybe a
simpleParse) (Maybe String -> Maybe Version)
-> Parser (Maybe String) -> Parser (Maybe Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"default-version")) Parser ([Version] -> Maybe String -> Maybe License -> CabalPackage)
-> Parser [Version]
-> Parser (Maybe String -> Maybe License -> CabalPackage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
((String -> Maybe Version) -> [String] -> [Version]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Version
forall a. Parsec a => String -> Maybe a
simpleParse ([String] -> [Version]) -> Parser [String] -> Parser [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser [String]
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"installed-versions")) Parser (Maybe String -> Maybe License -> CabalPackage)
-> Parser (Maybe String) -> Parser (Maybe License -> CabalPackage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Object
v Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"homepage") Parser (Maybe License -> CabalPackage)
-> Parser (Maybe License) -> Parser CabalPackage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
((Maybe (Maybe License) -> Maybe License
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe License) -> Maybe License)
-> (Maybe String -> Maybe (Maybe License))
-> Maybe String
-> Maybe License
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe License) -> Maybe String -> Maybe (Maybe License)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe License
forall a. Parsec a => String -> Maybe a
simpleParse) (Maybe String -> Maybe License)
-> Parser (Maybe String) -> Parser (Maybe License)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"license"))
cabalList :: [String] -> ToolM [CabalPackage]
cabalList :: [String] -> ToolM [CabalPackage]
cabalList [String]
queries = do
#if mingw32_HOST_OS
rs <- liftM (split (all isSpace) . lines) $ tool_ "powershell" [
"-Command",
unwords (["&", "{", "chcp 65001 | out-null;", "cabal list"] ++ queries ++ ["}"])]
#else
[[String]]
rs <- (String -> [[String]])
-> ExceptT String IO String -> ExceptT String IO [[String]]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((String -> Bool) -> [String] -> [[String]]
forall a. (a -> Bool) -> [a] -> [[a]]
split ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace) ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) (ExceptT String IO String -> ExceptT String IO [[String]])
-> ExceptT String IO String -> ExceptT String IO [[String]]
forall a b. (a -> b) -> a -> b
$ String -> [String] -> ExceptT String IO String
tool_ String
"cabal" (String
"list" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
queries)
#endif
[CabalPackage] -> ToolM [CabalPackage]
forall (m :: * -> *) a. Monad m => a -> m a
return ([CabalPackage] -> ToolM [CabalPackage])
-> [CabalPackage] -> ToolM [CabalPackage]
forall a b. (a -> b) -> a -> b
$ ((String, [(String, String)]) -> CabalPackage)
-> [(String, [(String, String)])] -> [CabalPackage]
forall a b. (a -> b) -> [a] -> [b]
map (String, [(String, String)]) -> CabalPackage
toPackage ([(String, [(String, String)])] -> [CabalPackage])
-> [(String, [(String, String)])] -> [CabalPackage]
forall a b. (a -> b) -> a -> b
$ ([String] -> Maybe (String, [(String, String)]))
-> [[String]] -> [(String, [(String, String)])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [String] -> Maybe (String, [(String, String)])
parseFields [[String]]
rs
where
toPackage :: (String, [(String, String)]) -> CabalPackage
toPackage :: (String, [(String, String)]) -> CabalPackage
toPackage (String
name, [(String, String)]
fs) = CabalPackage :: String
-> Maybe String
-> Maybe Version
-> [Version]
-> Maybe String
-> Maybe License
-> CabalPackage
CabalPackage {
cabalPackageName :: String
cabalPackageName = String
name,
cabalPackageSynopsis :: Maybe String
cabalPackageSynopsis = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"Synopsis" [(String, String)]
fs,
cabalPackageDefaultVersion :: Maybe Version
cabalPackageDefaultVersion = (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"Default available version" [(String, String)]
fs Maybe String -> (String -> Maybe Version) -> Maybe Version
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Version
forall a. Parsec a => String -> Maybe a
simpleParse),
cabalPackageInstalledVersions :: [Version]
cabalPackageInstalledVersions = [Version] -> Maybe [Version] -> [Version]
forall a. a -> Maybe a -> a
fromMaybe [] (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"Installed versions" [(String, String)]
fs Maybe String -> (String -> Maybe [Version]) -> Maybe [Version]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Maybe Version) -> [String] -> Maybe [Version]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> Maybe Version
forall a. Parsec a => String -> Maybe a
simpleParse (String -> Maybe Version) -> ShowS -> String -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim) ([String] -> Maybe [Version])
-> (String -> [String]) -> String -> Maybe [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',')),
cabalPackageHomepage :: Maybe String
cabalPackageHomepage = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"Homepage" [(String, String)]
fs,
cabalPackageLicense :: Maybe License
cabalPackageLicense = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"License" [(String, String)]
fs Maybe String -> (String -> Maybe License) -> Maybe License
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe License
forall a. Parsec a => String -> Maybe a
simpleParse }
parseFields :: [String] -> Maybe (String, [(String, String)])
parseFields :: [String] -> Maybe (String, [(String, String)])
parseFields [] = Maybe (String, [(String, String)])
forall a. Maybe a
Nothing
parseFields ((Char
'*':String
name):[String]
fs) = (String, [(String, String)]) -> Maybe (String, [(String, String)])
forall a. a -> Maybe a
Just (ShowS
trim String
name, (String -> Maybe (String, String))
-> [String] -> [(String, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe (String, String)
parseField' [String]
fs) where
parseField' :: String -> Maybe (String, String)
parseField' :: String -> Maybe (String, String)
parseField' String
str = case String -> (String, Maybe String)
parseField String
str of
(String
fname, Just String
fval) -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
fname, String
fval)
(String, Maybe String)
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
parseFields [String]
_ = Maybe (String, [(String, String)])
forall a. Maybe a
Nothing
parseField :: String -> (String, Maybe String)
parseField :: String -> (String, Maybe String)
parseField = (ShowS
trim ShowS
-> (String -> Maybe String)
-> (String, String)
-> (String, Maybe String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (String -> Maybe String
parseValue (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1)) ((String, String) -> (String, Maybe String))
-> (String -> (String, String)) -> String -> (String, Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')
parseValue :: String -> Maybe String
parseValue :: String -> Maybe String
parseValue (Char
'[':String
_) = Maybe String
forall a. Maybe a
Nothing
parseValue String
v = String -> Maybe String
forall a. a -> Maybe a
Just String
v