{-# 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
  }

-- | 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 (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

-- | 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) -> 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
       ]

-- | 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 (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

-- | 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 (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 -- just pick the first one
    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

-- | Get (Cabal package) 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 (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

-- | Get extensions from the cabal file for this source path
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