{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Distribution.PackageDescription.TH (
packageVariable,
packageVariableFrom,
packageString,
PackageDescription(..),
PackageIdentifier(..),
#if MIN_VERSION_Cabal(2,0,0)
module Distribution.Version
#else
Version(..)
#endif
) where
import Distribution.PackageDescription
import Distribution.Package
import Distribution.Version
#if MIN_VERSION_Cabal(3,0,0)
import Distribution.Pretty
#else
import Distribution.Text
import Distribution.Compat.ReadP
#endif
import Distribution.Verbosity (Verbosity, silent)
import Text.PrettyPrint
import System.Directory (getCurrentDirectory, getDirectoryContents)
import Data.List (isSuffixOf)
import Language.Haskell.TH (Q, Exp, stringE, runIO)
#if MIN_VERSION_Cabal(2,2,0)
import Distribution.PackageDescription.Parsec (readGenericPackageDescription)
readPkgDesc :: Verbosity -> FilePath -> IO GenericPackageDescription
readPkgDesc = Verbosity -> FilePath -> IO GenericPackageDescription
readGenericPackageDescription
#else
import Distribution.PackageDescription.Parse (readPackageDescription)
readPkgDesc = readPackageDescription
#endif
readPkgDesc :: Verbosity -> FilePath -> IO GenericPackageDescription
newtype DocString = DocString String
#if MIN_VERSION_Cabal(3,0,0)
instance Pretty DocString where
pretty :: DocString -> Doc
pretty (DocString FilePath
s) = FilePath -> Doc
text FilePath
s
#else
instance Text DocString where
parse = DocString `fmap` (readS_to_P read)
disp (DocString s) = text s
#endif
packageString :: String -> DocString
packageString :: FilePath -> DocString
packageString = FilePath -> DocString
DocString
#if MIN_VERSION_Cabal(3,0,0)
packageVariable :: Pretty a => (PackageDescription -> a) -> Q Exp
#else
packageVariable :: Text a => (PackageDescription -> a) -> Q Exp
#endif
packageVariable :: forall a. Pretty a => (PackageDescription -> a) -> Q Exp
packageVariable = forall b a. Pretty b => IO a -> (a -> b) -> Q Exp
renderField IO PackageDescription
currentPackageDescription
#if MIN_VERSION_Cabal(3,0,0)
packageVariableFrom :: Pretty a => FilePath -> (PackageDescription -> a) -> Q Exp
#else
packageVariableFrom :: Text a => FilePath -> (PackageDescription -> a) -> Q Exp
#endif
packageVariableFrom :: forall a.
Pretty a =>
FilePath -> (PackageDescription -> a) -> Q Exp
packageVariableFrom FilePath
s = forall b a. Pretty b => IO a -> (a -> b) -> Q Exp
renderField forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenericPackageDescription -> PackageDescription
packageDescription (Verbosity -> FilePath -> IO GenericPackageDescription
readPkgDesc Verbosity
silent FilePath
s)
#if MIN_VERSION_Cabal(3,0,0)
renderField :: Pretty b => IO a -> (a -> b) -> Q Exp
renderField :: forall b a. Pretty b => IO a -> (a -> b) -> Q Exp
renderField IO a
pd a -> b
f = forall a. IO a -> (a -> FilePath) -> Q Exp
renderFieldS IO a
pd (forall a. Pretty a => a -> FilePath
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
#else
renderField :: Text b => IO a -> (a -> b) -> Q Exp
renderField pd f = renderFieldS pd (display . f)
#endif
renderFieldS :: IO a -> (a -> String) -> Q Exp
renderFieldS :: forall a. IO a -> (a -> FilePath) -> Q Exp
renderFieldS IO a
pd a -> FilePath
f = forall a. IO a -> Q a
runIO IO a
pd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Quote m => FilePath -> m Exp
stringE forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilePath
f
currentPackageDescription :: IO PackageDescription
currentPackageDescription :: IO PackageDescription
currentPackageDescription = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenericPackageDescription -> PackageDescription
packageDescription forall a b. (a -> b) -> a -> b
$ do
FilePath
dir <- IO FilePath
getCurrentDirectory
[FilePath]
cs <- FilePath -> IO [FilePath]
cabalFiles FilePath
dir
case [FilePath]
cs of
(FilePath
c:[FilePath]
_) -> Verbosity -> FilePath -> IO GenericPackageDescription
readPkgDesc Verbosity
silent FilePath
c
[] -> forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"Couldn't find a cabal file in the current working directory (" forall a. [a] -> [a] -> [a]
++ FilePath
dir forall a. [a] -> [a] -> [a]
++ FilePath
")"
cabalFiles :: FilePath -> IO [FilePath]
cabalFiles :: FilePath -> IO [FilePath]
cabalFiles FilePath
dir = do
[FilePath]
files <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath
".cabal" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) [FilePath]
files