{-# LANGUAGE CPP #-}
module HIndent.CabalFile
( getCabalExtensionsForSourcePath
) where
import Control.Monad
import qualified Data.ByteString as BS
import Data.List
import Data.Maybe
import Data.Traversable
import Distribution.ModuleName
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
#if MIN_VERSION_Cabal(2, 2, 0)
import Distribution.PackageDescription.Parsec
#else
import Distribution.PackageDescription.Parse
#endif
import Language.Haskell.Extension
import qualified Language.Haskell.Exts.Extension as HSE
import System.Directory
import System.FilePath
import Text.Read
data Stanza = MkStanza
{ Stanza -> BuildInfo
_stanzaBuildInfo :: BuildInfo
, Stanza -> FilePath -> Bool
stanzaIsSourceFilePath :: FilePath -> Bool
}
toRelative :: FilePath -> FilePath -> Maybe FilePath
toRelative :: FilePath -> FilePath -> Maybe FilePath
toRelative FilePath
parent FilePath
child = let
rel :: FilePath
rel = FilePath -> FilePath -> FilePath
makeRelative FilePath
parent FilePath
child
in if FilePath
rel FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
child
then Maybe FilePath
forall a. Maybe a
Nothing
else FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
rel
mkStanza :: BuildInfo -> [ModuleName] -> [FilePath] -> Stanza
mkStanza :: BuildInfo -> [ModuleName] -> [FilePath] -> Stanza
mkStanza BuildInfo
bi [ModuleName]
mnames [FilePath]
fpaths =
BuildInfo -> (FilePath -> Bool) -> Stanza
MkStanza BuildInfo
bi ((FilePath -> Bool) -> Stanza) -> (FilePath -> Bool) -> Stanza
forall a b. (a -> b) -> a -> b
$ \FilePath
path -> let
modpaths :: [FilePath]
modpaths = (ModuleName -> FilePath) -> [ModuleName] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModuleName -> FilePath
toFilePath ([ModuleName] -> [FilePath]) -> [ModuleName] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ [ModuleName]
mnames
inDir :: FilePath -> Bool
inDir FilePath
dir =
case FilePath -> FilePath -> Maybe FilePath
toRelative FilePath
dir FilePath
path of
Maybe FilePath
Nothing -> Bool
False
Just FilePath
relpath ->
(FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
equalFilePath (FilePath -> FilePath -> Bool) -> FilePath -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
dropExtension FilePath
relpath) [FilePath]
modpaths Bool -> Bool -> Bool
||
(FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
equalFilePath FilePath
relpath) [FilePath]
fpaths
in (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any FilePath -> Bool
inDir ([FilePath] -> Bool) -> [FilePath] -> Bool
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
bi
packageStanzas :: PackageDescription -> [Stanza]
packageStanzas :: PackageDescription -> [Stanza]
packageStanzas PackageDescription
pd = let
libStanza :: Library -> Stanza
libStanza :: Library -> Stanza
libStanza Library
lib = BuildInfo -> [ModuleName] -> [FilePath] -> Stanza
mkStanza (Library -> BuildInfo
libBuildInfo Library
lib) (Library -> [ModuleName]
exposedModules Library
lib) []
exeStanza :: Executable -> Stanza
exeStanza :: Executable -> Stanza
exeStanza Executable
exe = BuildInfo -> [ModuleName] -> [FilePath] -> Stanza
mkStanza (Executable -> BuildInfo
buildInfo Executable
exe) [] [Executable -> FilePath
modulePath Executable
exe]
testStanza :: TestSuite -> Stanza
testStanza :: TestSuite -> Stanza
testStanza TestSuite
ts =
BuildInfo -> [ModuleName] -> [FilePath] -> Stanza
mkStanza
(TestSuite -> BuildInfo
testBuildInfo TestSuite
ts)
(case TestSuite -> TestSuiteInterface
testInterface TestSuite
ts of
TestSuiteLibV09 Version
_ ModuleName
mname -> [ModuleName
mname]
TestSuiteInterface
_ -> [])
(case TestSuite -> TestSuiteInterface
testInterface TestSuite
ts of
TestSuiteExeV10 Version
_ FilePath
path -> [FilePath
path]
TestSuiteInterface
_ -> [])
benchStanza :: Benchmark -> Stanza
benchStanza :: Benchmark -> Stanza
benchStanza Benchmark
bn =
BuildInfo -> [ModuleName] -> [FilePath] -> Stanza
mkStanza (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bn) [] ([FilePath] -> Stanza) -> [FilePath] -> Stanza
forall a b. (a -> b) -> a -> b
$
case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bn of
BenchmarkExeV10 Version
_ FilePath
path -> [FilePath
path]
BenchmarkInterface
_ -> []
in [[Stanza]] -> [Stanza]
forall a. Monoid a => [a] -> a
mconcat
[ Maybe Stanza -> [Stanza]
forall a. Maybe a -> [a]
maybeToList (Maybe Stanza -> [Stanza]) -> Maybe Stanza -> [Stanza]
forall a b. (a -> b) -> a -> b
$ (Library -> Stanza) -> Maybe Library -> Maybe Stanza
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Library -> Stanza
libStanza (Maybe Library -> Maybe Stanza) -> Maybe Library -> Maybe Stanza
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Maybe Library
library PackageDescription
pd
, (Executable -> Stanza) -> [Executable] -> [Stanza]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Executable -> Stanza
exeStanza ([Executable] -> [Stanza]) -> [Executable] -> [Stanza]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
executables PackageDescription
pd
, (TestSuite -> Stanza) -> [TestSuite] -> [Stanza]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestSuite -> Stanza
testStanza ([TestSuite] -> [Stanza]) -> [TestSuite] -> [Stanza]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [TestSuite]
testSuites PackageDescription
pd
, (Benchmark -> Stanza) -> [Benchmark] -> [Stanza]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Benchmark -> Stanza
benchStanza ([Benchmark] -> [Stanza]) -> [Benchmark] -> [Stanza]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Benchmark]
benchmarks PackageDescription
pd
]
findCabalFiles :: FilePath -> FilePath -> IO (Maybe ([FilePath], FilePath))
findCabalFiles :: FilePath -> FilePath -> IO (Maybe ([FilePath], FilePath))
findCabalFiles FilePath
dir FilePath
rel = do
[FilePath]
names <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
[FilePath]
cabalnames <-
(FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
dir FilePath -> FilePath -> FilePath
</>)) ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".cabal") [FilePath]
names
case [FilePath]
cabalnames of
[]
| FilePath
dir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"/" -> Maybe ([FilePath], FilePath) -> IO (Maybe ([FilePath], FilePath))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([FilePath], FilePath)
forall a. Maybe a
Nothing
[] -> FilePath -> FilePath -> IO (Maybe ([FilePath], FilePath))
findCabalFiles (FilePath -> FilePath
takeDirectory FilePath
dir) (FilePath -> FilePath
takeFileName FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
rel)
[FilePath]
_ -> Maybe ([FilePath], FilePath) -> IO (Maybe ([FilePath], FilePath))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([FilePath], FilePath) -> IO (Maybe ([FilePath], FilePath)))
-> Maybe ([FilePath], FilePath)
-> IO (Maybe ([FilePath], FilePath))
forall a b. (a -> b) -> a -> b
$ ([FilePath], FilePath) -> Maybe ([FilePath], FilePath)
forall a. a -> Maybe a
Just ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FilePath
n -> FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
n) [FilePath]
cabalnames, FilePath
rel)
getGenericPackageDescription :: FilePath -> IO (Maybe GenericPackageDescription)
#if MIN_VERSION_Cabal(2, 2, 0)
getGenericPackageDescription :: FilePath -> IO (Maybe GenericPackageDescription)
getGenericPackageDescription FilePath
cabalPath = do
ByteString
cabaltext <- FilePath -> IO ByteString
BS.readFile FilePath
cabalPath
Maybe GenericPackageDescription
-> IO (Maybe GenericPackageDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GenericPackageDescription
-> IO (Maybe GenericPackageDescription))
-> Maybe GenericPackageDescription
-> IO (Maybe GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
cabaltext
#else
getGenericPackageDescription cabalPath = do
cabaltext <- readFile cabalPath
case parsePackageDescription cabaltext of
ParseOk _ gpd -> return $ Just gpd
_ -> return Nothing
#endif
getCabalStanza :: FilePath -> IO (Maybe Stanza)
getCabalStanza :: FilePath -> IO (Maybe Stanza)
getCabalStanza FilePath
srcpath = do
FilePath
abssrcpath <- FilePath -> IO FilePath
canonicalizePath FilePath
srcpath
Maybe ([FilePath], FilePath)
mcp <- FilePath -> FilePath -> IO (Maybe ([FilePath], FilePath))
findCabalFiles (FilePath -> FilePath
takeDirectory FilePath
abssrcpath) (FilePath -> FilePath
takeFileName FilePath
abssrcpath)
case Maybe ([FilePath], FilePath)
mcp of
Just ([FilePath]
cabalpaths, FilePath
relpath) -> do
[[Stanza]]
stanzass <-
[FilePath] -> (FilePath -> IO [Stanza]) -> IO [[Stanza]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [FilePath]
cabalpaths ((FilePath -> IO [Stanza]) -> IO [[Stanza]])
-> (FilePath -> IO [Stanza]) -> IO [[Stanza]]
forall a b. (a -> b) -> a -> b
$ \FilePath
cabalpath -> do
Maybe GenericPackageDescription
genericPackageDescription <- FilePath -> IO (Maybe GenericPackageDescription)
getGenericPackageDescription FilePath
cabalpath
case Maybe GenericPackageDescription
genericPackageDescription of
Maybe GenericPackageDescription
Nothing -> [Stanza] -> IO [Stanza]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just GenericPackageDescription
gpd -> do
[Stanza] -> IO [Stanza]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Stanza] -> IO [Stanza]) -> [Stanza] -> IO [Stanza]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Stanza]
packageStanzas (PackageDescription -> [Stanza]) -> PackageDescription -> [Stanza]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
flattenPackageDescription GenericPackageDescription
gpd
Maybe Stanza -> IO (Maybe Stanza)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Stanza -> IO (Maybe Stanza))
-> Maybe Stanza -> IO (Maybe Stanza)
forall a b. (a -> b) -> a -> b
$
case (Stanza -> Bool) -> [Stanza] -> [Stanza]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Stanza
stanza -> Stanza -> FilePath -> Bool
stanzaIsSourceFilePath Stanza
stanza FilePath
relpath) ([Stanza] -> [Stanza]) -> [Stanza] -> [Stanza]
forall a b. (a -> b) -> a -> b
$
[[Stanza]] -> [Stanza]
forall a. Monoid a => [a] -> a
mconcat [[Stanza]]
stanzass of
[] -> Maybe Stanza
forall a. Maybe a
Nothing
(Stanza
stanza:[Stanza]
_) -> Stanza -> Maybe Stanza
forall a. a -> Maybe a
Just Stanza
stanza
Maybe ([FilePath], FilePath)
Nothing -> Maybe Stanza -> IO (Maybe Stanza)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stanza
forall a. Maybe a
Nothing
getCabalExtensions :: FilePath -> IO (Language, [Extension])
getCabalExtensions :: FilePath -> IO (Language, [Extension])
getCabalExtensions FilePath
srcpath = do
Maybe Stanza
mstanza <- FilePath -> IO (Maybe Stanza)
getCabalStanza FilePath
srcpath
(Language, [Extension]) -> IO (Language, [Extension])
forall (m :: * -> *) a. Monad m => a -> m a
return ((Language, [Extension]) -> IO (Language, [Extension]))
-> (Language, [Extension]) -> IO (Language, [Extension])
forall a b. (a -> b) -> a -> b
$
case Maybe Stanza
mstanza of
Maybe Stanza
Nothing -> (Language
Haskell98, [])
Just (MkStanza BuildInfo
bi FilePath -> Bool
_) -> do
(Language -> Maybe Language -> Language
forall a. a -> Maybe a -> a
fromMaybe Language
Haskell98 (Maybe Language -> Language) -> Maybe Language -> Language
forall a b. (a -> b) -> a -> b
$ BuildInfo -> Maybe Language
defaultLanguage BuildInfo
bi, BuildInfo -> [Extension]
defaultExtensions BuildInfo
bi)
convertLanguage :: Language -> HSE.Language
convertLanguage :: Language -> Language
convertLanguage Language
lang = FilePath -> Language
forall a. Read a => FilePath -> a
read (FilePath -> Language) -> FilePath -> Language
forall a b. (a -> b) -> a -> b
$ Language -> FilePath
forall a. Show a => a -> FilePath
show Language
lang
convertKnownExtension :: KnownExtension -> Maybe HSE.KnownExtension
convertKnownExtension :: KnownExtension -> Maybe KnownExtension
convertKnownExtension KnownExtension
ext =
case FilePath -> Either FilePath KnownExtension
forall a. Read a => FilePath -> Either FilePath a
readEither (FilePath -> Either FilePath KnownExtension)
-> FilePath -> Either FilePath KnownExtension
forall a b. (a -> b) -> a -> b
$ KnownExtension -> FilePath
forall a. Show a => a -> FilePath
show KnownExtension
ext of
Left FilePath
_ -> Maybe KnownExtension
forall a. Maybe a
Nothing
Right KnownExtension
hext -> KnownExtension -> Maybe KnownExtension
forall a. a -> Maybe a
Just KnownExtension
hext
convertExtension :: Extension -> Maybe HSE.Extension
convertExtension :: Extension -> Maybe Extension
convertExtension (EnableExtension KnownExtension
ke) =
(KnownExtension -> Extension)
-> Maybe KnownExtension -> Maybe Extension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KnownExtension -> Extension
HSE.EnableExtension (Maybe KnownExtension -> Maybe Extension)
-> Maybe KnownExtension -> Maybe Extension
forall a b. (a -> b) -> a -> b
$ KnownExtension -> Maybe KnownExtension
convertKnownExtension KnownExtension
ke
convertExtension (DisableExtension KnownExtension
ke) =
(KnownExtension -> Extension)
-> Maybe KnownExtension -> Maybe Extension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KnownExtension -> Extension
HSE.DisableExtension (Maybe KnownExtension -> Maybe Extension)
-> Maybe KnownExtension -> Maybe Extension
forall a b. (a -> b) -> a -> b
$ KnownExtension -> Maybe KnownExtension
convertKnownExtension KnownExtension
ke
convertExtension (UnknownExtension FilePath
s) = Extension -> Maybe Extension
forall a. a -> Maybe a
Just (Extension -> Maybe Extension) -> Extension -> Maybe Extension
forall a b. (a -> b) -> a -> b
$ FilePath -> Extension
HSE.UnknownExtension FilePath
s
getCabalExtensionsForSourcePath :: FilePath -> IO [HSE.Extension]
getCabalExtensionsForSourcePath :: FilePath -> IO [Extension]
getCabalExtensionsForSourcePath FilePath
srcpath = do
(Language
lang, [Extension]
exts) <- FilePath -> IO (Language, [Extension])
getCabalExtensions FilePath
srcpath
[Extension] -> IO [Extension]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Extension] -> IO [Extension]) -> [Extension] -> IO [Extension]
forall a b. (a -> b) -> a -> b
$
(KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KnownExtension -> Extension
HSE.EnableExtension ([KnownExtension] -> [Extension])
-> [KnownExtension] -> [Extension]
forall a b. (a -> b) -> a -> b
$
Language -> [Extension] -> [KnownExtension]
HSE.toExtensionList (Language -> Language
convertLanguage Language
lang) ([Extension] -> [KnownExtension])
-> [Extension] -> [KnownExtension]
forall a b. (a -> b) -> a -> b
$ (Extension -> Maybe Extension) -> [Extension] -> [Extension]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Extension -> Maybe Extension
convertExtension [Extension]
exts