{-# 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
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 s :: 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 :: (PackageDescription -> a) -> Q Exp
packageVariable = IO PackageDescription -> (PackageDescription -> a) -> Q Exp
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 :: FilePath -> (PackageDescription -> a) -> Q Exp
packageVariableFrom s :: FilePath
s = IO PackageDescription -> (PackageDescription -> a) -> Q Exp
forall b a. Pretty b => IO a -> (a -> b) -> Q Exp
renderField (IO PackageDescription -> (PackageDescription -> a) -> Q Exp)
-> IO PackageDescription -> (PackageDescription -> a) -> Q Exp
forall a b. (a -> b) -> a -> b
$ (GenericPackageDescription -> PackageDescription)
-> IO GenericPackageDescription -> IO PackageDescription
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 :: IO a -> (a -> b) -> Q Exp
renderField pd :: IO a
pd f :: a -> b
f = IO a -> (a -> FilePath) -> Q Exp
forall a. IO a -> (a -> FilePath) -> Q Exp
renderFieldS IO a
pd (b -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (b -> FilePath) -> (a -> b) -> a -> FilePath
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 :: IO a -> (a -> FilePath) -> Q Exp
renderFieldS pd :: IO a
pd f :: a -> FilePath
f = IO a -> Q a
forall a. IO a -> Q a
runIO IO a
pd Q a -> (a -> Q Exp) -> Q Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Q Exp
stringE (FilePath -> Q Exp) -> (a -> FilePath) -> a -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilePath
f
currentPackageDescription :: IO PackageDescription
currentPackageDescription :: IO PackageDescription
currentPackageDescription = (GenericPackageDescription -> PackageDescription)
-> IO GenericPackageDescription -> IO PackageDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenericPackageDescription -> PackageDescription
packageDescription (IO GenericPackageDescription -> IO PackageDescription)
-> IO GenericPackageDescription -> IO 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
(c :: FilePath
c:_) -> Verbosity -> FilePath -> IO GenericPackageDescription
readPkgDesc Verbosity
silent FilePath
c
[] -> FilePath -> IO GenericPackageDescription
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO GenericPackageDescription)
-> FilePath -> IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ "Couldn't find a cabal file in the current working directory (" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ")"
cabalFiles :: FilePath -> IO [FilePath]
cabalFiles :: FilePath -> IO [FilePath]
cabalFiles dir :: FilePath
dir = do
[FilePath]
files <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (".cabal" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) [FilePath]
files