{-# LANGUAGE OverloadedStrings, CPP #-}

module HsDev.Tools.Cabal (
	CabalPackage(..),
	cabalList,

	-- * Reexports
	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

		-- foo: bar → (foo, bar)
		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
':')
		-- [ ... ] → Nothing, ... → Just ...
		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