{-# 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(3, 6, 0)
import Distribution.Utils.Path (getSymbolicPath)
#endif
#if MIN_VERSION_Cabal(2, 2, 0)
import Distribution.PackageDescription.Parsec
#else
import Distribution.PackageDescription.Parse
#endif
import HIndent.Language
import HIndent.LanguageExtension
import HIndent.LanguageExtension.Conversion
import HIndent.LanguageExtension.Types
import Language.Haskell.Extension hiding (Extension)
import System.Directory
import System.FilePath

data Stanza = MkStanza
  { Stanza -> BuildInfo
_stanzaBuildInfo :: BuildInfo
  , Stanza -> FilePath -> Bool
stanzaIsSourceFilePath :: FilePath -> Bool
  }

-- | Find the relative path of a child path in a parent, if it is a child
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

-- | Create a Stanza from `BuildInfo` and names of modules and paths
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 a b. (a -> b) -> [a] -> [b]
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
  where

#if MIN_VERSION_Cabal(3, 6, 0)
        hsSourceDirs' :: BuildInfo -> [FilePath]
hsSourceDirs' = ((SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath) ([SymbolicPath PackageDir SourceDir] -> [FilePath])
-> (BuildInfo -> [SymbolicPath PackageDir SourceDir])
-> BuildInfo
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs
#else
        hsSourceDirs' = hsSourceDirs
#endif
-- | Extract `Stanza`s from a package
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
libStanza (Library -> Stanza) -> Maybe Library -> Maybe Stanza
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> Maybe Library
library PackageDescription
pd
        , Executable -> Stanza
exeStanza (Executable -> Stanza) -> [Executable] -> [Stanza]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [Executable]
executables PackageDescription
pd
        , TestSuite -> Stanza
testStanza (TestSuite -> Stanza) -> [TestSuite] -> [Stanza]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [TestSuite]
testSuites PackageDescription
pd
        , Benchmark -> Stanza
benchStanza (Benchmark -> Stanza) -> [Benchmark] -> [Stanza]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [Benchmark]
benchmarks PackageDescription
pd
        ]

-- | Find cabal files that are "above" the source path
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 a. a -> IO a
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 a. a -> IO a
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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
dir FilePath -> FilePath -> FilePath
</>) [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 a. a -> IO a
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
-- | Find the `Stanza` that refers to this source path
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
            Just GenericPackageDescription
gpd -> do
              [Stanza] -> IO [Stanza]
forall a. a -> IO a
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 a. a -> IO a
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 -> FilePath -> Bool
`stanzaIsSourceFilePath` 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 -- just pick the first one
    Maybe ([FilePath], FilePath)
Nothing -> Maybe Stanza -> IO (Maybe Stanza)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stanza
forall a. Maybe a
Nothing

-- | Get language and extensions from the cabal file for this source path
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 a. a -> IO a
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
_) ->
          ( 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
          , (Extension -> Maybe Extension) -> [Extension] -> [Extension]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Extension -> Maybe Extension
fromCabalExtension ([Extension] -> [Extension]) -> [Extension] -> [Extension]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
defaultExtensions BuildInfo
bi)

-- | Get extensions from the cabal file for this source path
getCabalExtensionsForSourcePath :: FilePath -> IO [Extension]
getCabalExtensionsForSourcePath :: FilePath -> IO [Extension]
getCabalExtensionsForSourcePath FilePath
srcpath = do
  (Language
lang, [Extension]
exts) <- FilePath -> IO (Language, [Extension])
getCabalExtensions FilePath
srcpath
  [Extension] -> IO [Extension]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Extension] -> IO [Extension]) -> [Extension] -> IO [Extension]
forall a b. (a -> b) -> a -> b
$ [Extension]
exts [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ Language -> [Extension]
implicitExtensions (HasCallStack => Language -> Language
Language -> Language
convertLanguage Language
lang)