{-# LANGUAGE CPP #-}
module HIndent.CabalFile
( getCabalExtensionsForSourcePath
) where
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
{ _stanzaBuildInfo :: BuildInfo
, stanzaIsSourceFilePath :: FilePath -> Bool
}
toRelative :: FilePath -> FilePath -> Maybe FilePath
toRelative parent child = let
rel = makeRelative parent child
in if rel == child
then Nothing
else Just rel
mkStanza :: BuildInfo -> [ModuleName] -> [FilePath] -> Stanza
mkStanza bi mnames fpaths =
MkStanza bi $ \path -> let
modpaths = fmap toFilePath $ otherModules bi ++ mnames
inDir dir =
case toRelative dir path of
Nothing -> False
Just relpath ->
any (equalFilePath $ dropExtension relpath) modpaths ||
any (equalFilePath relpath) fpaths
in any inDir $ hsSourceDirs bi
packageStanzas :: PackageDescription -> [Stanza]
packageStanzas pd = let
libStanza :: Library -> Stanza
libStanza lib = mkStanza (libBuildInfo lib) (exposedModules lib) []
exeStanza :: Executable -> Stanza
exeStanza exe = mkStanza (buildInfo exe) [] [modulePath exe]
testStanza :: TestSuite -> Stanza
testStanza ts =
mkStanza
(testBuildInfo ts)
(case testInterface ts of
TestSuiteLibV09 _ mname -> [mname]
_ -> [])
(case testInterface ts of
TestSuiteExeV10 _ path -> [path]
_ -> [])
benchStanza :: Benchmark -> Stanza
benchStanza bn =
mkStanza (benchmarkBuildInfo bn) [] $
case benchmarkInterface bn of
BenchmarkExeV10 _ path -> [path]
_ -> []
in mconcat
[ maybeToList $ fmap libStanza $ library pd
, fmap exeStanza $ executables pd
, fmap testStanza $ testSuites pd
, fmap benchStanza $ benchmarks pd
]
findCabalFiles :: FilePath -> FilePath -> IO (Maybe ([FilePath], FilePath))
findCabalFiles dir rel = do
names <- getDirectoryContents dir
let cabalnames = filter (isSuffixOf ".cabal") names
case cabalnames of
[]
| dir == "/" -> return Nothing
[] -> findCabalFiles (takeDirectory dir) (takeFileName dir </> rel)
_ -> return $ Just (fmap (\n -> dir </> n) cabalnames, rel)
getGenericPackageDescription :: FilePath -> IO (Maybe GenericPackageDescription)
#if MIN_VERSION_Cabal(2, 2, 0)
getGenericPackageDescription cabalPath = do
cabaltext <- BS.readFile cabalPath
return $ parseGenericPackageDescriptionMaybe 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 srcpath = do
abssrcpath <- canonicalizePath srcpath
mcp <- findCabalFiles (takeDirectory abssrcpath) (takeFileName abssrcpath)
case mcp of
Just (cabalpaths, relpath) -> do
stanzass <-
for cabalpaths $ \cabalpath -> do
genericPackageDescription <- getGenericPackageDescription cabalpath
case genericPackageDescription of
Nothing -> return []
Just gpd -> do
return $ packageStanzas $ flattenPackageDescription gpd
return $
case filter (\stanza -> stanzaIsSourceFilePath stanza relpath) $
mconcat stanzass of
[] -> Nothing
(stanza:_) -> Just stanza
Nothing -> return Nothing
getCabalExtensions :: FilePath -> IO (Language, [Extension])
getCabalExtensions srcpath = do
mstanza <- getCabalStanza srcpath
return $
case mstanza of
Nothing -> (Haskell98, [])
Just (MkStanza bi _) -> do
(fromMaybe Haskell98 $ defaultLanguage bi, defaultExtensions bi)
convertLanguage :: Language -> HSE.Language
convertLanguage lang = read $ show lang
convertKnownExtension :: KnownExtension -> Maybe HSE.KnownExtension
convertKnownExtension ext =
case readEither $ show ext of
Left _ -> Nothing
Right hext -> Just hext
convertExtension :: Extension -> Maybe HSE.Extension
convertExtension (EnableExtension ke) =
fmap HSE.EnableExtension $ convertKnownExtension ke
convertExtension (DisableExtension ke) =
fmap HSE.DisableExtension $ convertKnownExtension ke
convertExtension (UnknownExtension s) = Just $ HSE.UnknownExtension s
getCabalExtensionsForSourcePath :: FilePath -> IO [HSE.Extension]
getCabalExtensionsForSourcePath srcpath = do
(lang, exts) <- getCabalExtensions srcpath
return $
fmap HSE.EnableExtension $
HSE.toExtensionList (convertLanguage lang) $ mapMaybe convertExtension exts