{-# 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 {
        cabalPackageName :: String,
        cabalPackageSynopsis :: Maybe String,
        cabalPackageDefaultVersion :: Maybe Version,
        cabalPackageInstalledVersions :: [Version],
        cabalPackageHomepage :: Maybe String,
        cabalPackageLicense :: Maybe License }
                deriving (Eq, Read, Show)

instance ToJSON CabalPackage where
        toJSON cp = object [
                "name" .= cabalPackageName cp,
                "synopsis" .= cabalPackageSynopsis cp,
                "default-version" .= fmap display (cabalPackageDefaultVersion cp),
                "installed-versions" .= map display (cabalPackageInstalledVersions cp),
                "homepage" .= cabalPackageHomepage cp,
                "license" .= fmap display (cabalPackageLicense cp)]

instance FromJSON CabalPackage where
        parseJSON = withObject "cabal-package" $ \v -> CabalPackage <$>
                (v .:: "name") <*>
                (v .:: "synopsis") <*>
                ((join . fmap simpleParse) <$> (v .:: "default-version")) <*>
                (mapMaybe simpleParse <$> (v .:: "installed-versions")) <*>
                (v .:: "homepage") <*>
                ((join . fmap simpleParse) <$> (v .:: "license"))

cabalList :: [String] -> ToolM [CabalPackage]
cabalList queries = do
#if mingw32_HOST_OS
        rs <- liftM (split (all isSpace) . lines) $ tool_ "powershell" [
                "-Command",
                unwords (["&", "{", "chcp 65001 | out-null;", "cabal list"] ++ queries ++ ["}"])]
#else
        rs <- liftM (split (all isSpace) . lines) $ tool_ "cabal" ("list" : queries)
#endif
        return $ map toPackage $ mapMaybe parseFields rs
        where
                toPackage :: (String, [(String, String)]) -> CabalPackage
                toPackage (name, fs) = CabalPackage {
                        cabalPackageName = name,
                        cabalPackageSynopsis = lookup "Synopsis" fs,
                        cabalPackageDefaultVersion = (lookup "Default available version" fs >>= simpleParse),
                        cabalPackageInstalledVersions = fromMaybe [] (lookup "Installed versions" fs >>= mapM (simpleParse . trim) . split (== ',')),
                        cabalPackageHomepage = lookup "Homepage" fs,
                        cabalPackageLicense = lookup "License" fs >>= simpleParse }

                parseFields :: [String] -> Maybe (String, [(String, String)])
                parseFields [] = Nothing
                parseFields (('*':name):fs) = Just (trim name, mapMaybe parseField' fs) where
                        parseField' :: String -> Maybe (String, String)
                        parseField' str = case parseField str of
                                (fname, Just fval) -> Just (fname, fval)
                                _ -> Nothing
                parseFields _ = Nothing

                -- foo: bar → (foo, bar)
                parseField :: String -> (String, Maybe String)
                parseField = (trim *** (parseValue . trim . drop 1)) . break (== ':')
                -- [ ... ] → Nothing, ... → Just ...
                parseValue :: String -> Maybe String
                parseValue ('[':_) = Nothing
                parseValue v = Just v