{-# LANGUAGE CPP #-}

module HsDev.Project.Compat (
	showVer, componentName, testSuiteEnabled,
	flattenCondTree,
	parsePackageDesc
	) where

import Data.Maybe (maybeToList)
import Data.Text (Text, pack)
import qualified Distribution.PackageDescription as PD
import Distribution.Version (Version)
import Distribution.Text (display)

#if MIN_VERSION_Cabal(2,2,0)
import Distribution.PackageDescription.Parsec
import qualified Data.ByteString.Char8 as C8 (pack)
import GHC.Exts (toList)
#endif

#if MIN_VERSION_Cabal(3,0,0)
import Distribution.Parsec (showPError)
#elif MIN_VERSION_Cabal(2,2,0)
import Distribution.Parsec.Common (showPError)
#else
import Distribution.PackageDescription.Parse
#endif

#if MIN_VERSION_Cabal(2,0,0)
import Distribution.Types.CondTree
#else
import Distribution.PackageDescription (CondTree(..))
#endif

#if MIN_VERSION_Cabal(2,0,0)
import Distribution.Types.UnqualComponentName
#else
import Data.Version (showVersion)
#endif

showVer :: Version -> String
#if MIN_VERSION_Cabal(2,0,0)
showVer :: Version -> String
showVer = Version -> String
forall a. Pretty a => a -> String
display
#else
showVer = showVersion
#endif

#if MIN_VERSION_Cabal(2,0,0)
componentName :: UnqualComponentName -> Text
componentName :: UnqualComponentName -> Text
componentName = String -> Text
pack (String -> Text)
-> (UnqualComponentName -> String) -> UnqualComponentName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
unUnqualComponentName
#else
componentName :: String -> Text
componentName = pack
#endif

testSuiteEnabled :: PD.TestSuite -> Bool
#if MIN_VERSION_Cabal(2,0,0)
testSuiteEnabled :: TestSuite -> Bool
testSuiteEnabled TestSuite
_ = Bool
True
#else
testSuiteEnabled = PD.testEnabled
#endif

flattenCondTree :: Monoid a => (c -> a -> a) -> CondTree v c a -> a
flattenCondTree :: (c -> a -> a) -> CondTree v c a -> a
flattenCondTree c -> a -> a
f (PD.CondNode a
x c
cs [CondBranch v c a]
cmps) = c -> a -> a
f c
cs a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` [a] -> a
forall a. Monoid a => [a] -> a
mconcat ((CondBranch v c a -> [a]) -> [CondBranch v c a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondBranch v c a -> [a]
forall v. CondBranch v c a -> [a]
flattenBranch [CondBranch v c a]
cmps) where
#if MIN_VERSION_Cabal(2,0,0)
	flattenBranch :: CondBranch v c a -> [a]
flattenBranch (CondBranch Condition v
_ CondTree v c a
t Maybe (CondTree v c a)
mb) = CondTree v c a -> Maybe (CondTree v c a) -> [a]
forall v v. CondTree v c a -> Maybe (CondTree v c a) -> [a]
go CondTree v c a
t Maybe (CondTree v c a)
mb
#else
	flattenBranch (_, t, mb) = go t mb
#endif
	go :: CondTree v c a -> Maybe (CondTree v c a) -> [a]
go CondTree v c a
t Maybe (CondTree v c a)
mb = (c -> a -> a) -> CondTree v c a -> a
forall a c v. Monoid a => (c -> a -> a) -> CondTree v c a -> a
flattenCondTree c -> a -> a
f CondTree v c a
t a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (CondTree v c a -> a) -> [CondTree v c a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((c -> a -> a) -> CondTree v c a -> a
forall a c v. Monoid a => (c -> a -> a) -> CondTree v c a -> a
flattenCondTree c -> a -> a
f) (Maybe (CondTree v c a) -> [CondTree v c a]
forall a. Maybe a -> [a]
maybeToList Maybe (CondTree v c a)
mb)

parsePackageDesc :: String -> Either String PD.GenericPackageDescription
#if MIN_VERSION_Cabal(2,2,0)
parsePackageDesc :: String -> Either String GenericPackageDescription
parsePackageDesc String
s = case ([PWarning],
 Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> Either
     (Maybe Version, NonEmpty PError) GenericPackageDescription
forall a b. (a, b) -> b
snd (([PWarning],
  Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
 -> Either
      (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> (String
    -> ([PWarning],
        Either (Maybe Version, NonEmpty PError) GenericPackageDescription))
-> String
-> Either
     (Maybe Version, NonEmpty PError) GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseResult GenericPackageDescription
-> ([PWarning],
    Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult (ParseResult GenericPackageDescription
 -> ([PWarning],
     Either (Maybe Version, NonEmpty PError) GenericPackageDescription))
-> (String -> ParseResult GenericPackageDescription)
-> String
-> ([PWarning],
    Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription (ByteString -> ParseResult GenericPackageDescription)
-> (String -> ByteString)
-> String
-> ParseResult GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C8.pack (String
 -> Either
      (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> String
-> Either
     (Maybe Version, NonEmpty PError) GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ String
s of
	Left (Maybe Version
_, NonEmpty PError
errs) -> String -> Either String GenericPackageDescription
forall a b. a -> Either a b
Left (String -> Either String GenericPackageDescription)
-> String -> Either String GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (PError -> String) -> [PError] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PError -> String
showPError String
"cabal") ([PError] -> [String]) -> [PError] -> [String]
forall a b. (a -> b) -> a -> b
$ NonEmpty PError -> [Item (NonEmpty PError)]
forall l. IsList l => l -> [Item l]
toList NonEmpty PError
errs
	Right GenericPackageDescription
r -> GenericPackageDescription
-> Either String GenericPackageDescription
forall a b. b -> Either a b
Right GenericPackageDescription
r
#elif MIN_VERSION_Cabal(2,0,0)
parsePackageDesc s = case parseGenericPackageDescription s of
	ParseOk _ r -> Right r
	ParseFailed e -> Left $ show e
#else
parsePackageDesc s = case parsePackageDescription s of
	ParseOk _ r -> Right r
	ParseFailed e -> Left $ show e
#endif