    {-# 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 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 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) -> Maybe Library -> Maybe Stanza
    forall a b. (a -> b) -> Maybe a -> Maybe b
    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 a b. (a -> b) -> [a] -> [b]
    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 a b. (a -> b) -> [a] -> [b]
    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 a b. (a -> b) -> [a] -> [b]
    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 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
    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 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
    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 a. a -> IO a
    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 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
    _) -> 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 a b. (a -> b) -> Maybe a -> Maybe b
    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 a b. (a -> b) -> Maybe a -> Maybe b
    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 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
    $
        (KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
    forall a b. (a -> b) -> [a] -> [b]
    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