{-# language CPP #-}

module Graphmod.CabalSupport (parseCabalFile,Unit(..),UnitName(..)) where

import Graphmod.Utils(ModName,fromHierarchy)

import Data.Maybe(maybeToList)
import System.FilePath((</>))

-- Interface to cabal.
import Distribution.Verbosity(silent)
import Distribution.PackageDescription
        ( GenericPackageDescription, PackageDescription(..)
        , Library(..), Executable(..), BuildInfo(..) )
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
import Distribution.ModuleName(ModuleName,components)

#if MIN_VERSION_Cabal(3,6,0)
import Distribution.Utils.Path (SymbolicPath, PackageDir, SourceDir, getSymbolicPath)
#endif

#if MIN_VERSION_Cabal(2,0,0)

#if MIN_VERSION_Cabal(3,8,1)
import Distribution.Simple.PackageDescription(readGenericPackageDescription)
#elif MIN_VERSION_Cabal(2,2,0)
import Distribution.PackageDescription.Parsec(readGenericPackageDescription)
#else
import Distribution.PackageDescription.Parse(readGenericPackageDescription)
#endif

import Distribution.Types.UnqualComponentName (UnqualComponentName)

#if MIN_VERSION_Cabal(2,2,0)
import Distribution.Pretty (prettyShow)

pretty :: UnqualComponentName -> String
pretty :: UnqualComponentName -> String
pretty = forall a. Pretty a => a -> String
prettyShow
#else
import Distribution.Text (disp)
import Text.PrettyPrint (render)

pretty :: UnqualComponentName -> String
pretty = render . disp
#endif


#else
import Distribution.PackageDescription.Parse(readPackageDescription)
import Distribution.Verbosity (Verbosity)

readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription
readGenericPackageDescription = readPackageDescription

pretty :: String -> String
pretty = id
#endif

-- Note that this isn't nested under the above #if because we need
-- the backwards-compatible version to be available for all Cabal
-- versions prior to 3.6
#if MIN_VERSION_Cabal(3,6,0)
sourceDirToFilePath :: SymbolicPath PackageDir SourceDir -> FilePath
sourceDirToFilePath :: SymbolicPath PackageDir SourceDir -> String
sourceDirToFilePath = forall from to. SymbolicPath from to -> String
getSymbolicPath
#else
sourceDirToFilePath :: FilePath -> FilePath
sourceDirToFilePath = id
#endif

parseCabalFile :: FilePath -> IO [Unit]
parseCabalFile :: String -> IO [Unit]
parseCabalFile String
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenericPackageDescription -> [Unit]
findUnits (Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
silent String
f)


-- | This is our abstraction for something in a cabal file.
data Unit = Unit
  { Unit -> UnitName
unitName    :: UnitName
  , Unit -> [String]
unitPaths   :: [FilePath]
  , Unit -> [ModName]
unitModules :: [ModName]
  , Unit -> [String]
unitFiles   :: [FilePath]
  } deriving Int -> Unit -> ShowS
[Unit] -> ShowS
Unit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unit] -> ShowS
$cshowList :: [Unit] -> ShowS
show :: Unit -> String
$cshow :: Unit -> String
showsPrec :: Int -> Unit -> ShowS
$cshowsPrec :: Int -> Unit -> ShowS
Show

data UnitName = UnitLibrary | UnitExecutable String
                deriving Int -> UnitName -> ShowS
[UnitName] -> ShowS
UnitName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnitName] -> ShowS
$cshowList :: [UnitName] -> ShowS
show :: UnitName -> String
$cshow :: UnitName -> String
showsPrec :: Int -> UnitName -> ShowS
$cshowsPrec :: Int -> UnitName -> ShowS
Show


libUnit :: Library -> Unit
libUnit :: Library -> Unit
libUnit Library
lib = Unit { unitName :: UnitName
unitName     = UnitName
UnitLibrary
                   , unitPaths :: [String]
unitPaths    = SymbolicPath PackageDir SourceDir -> String
sourceDirToFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs (Library -> BuildInfo
libBuildInfo Library
lib)
                   , unitModules :: [ModName]
unitModules  = forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> ModName
toMod (Library -> [ModuleName]
exposedModules Library
lib)
                                                      -- other modules?
                   , unitFiles :: [String]
unitFiles    = []
                   }

exeUnit :: Executable -> Unit
exeUnit :: Executable -> Unit
exeUnit Executable
exe = Unit { unitName :: UnitName
unitName    = String -> UnitName
UnitExecutable (UnqualComponentName -> String
pretty forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe)
                   , unitPaths :: [String]
unitPaths   = SymbolicPath PackageDir SourceDir -> String
sourceDirToFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs (Executable -> BuildInfo
buildInfo Executable
exe)
                   , unitModules :: [ModName]
unitModules = [] -- other modules?
                   , unitFiles :: [String]
unitFiles   = case BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs (Executable -> BuildInfo
buildInfo Executable
exe) of
                                     [] -> [ Executable -> String
modulePath Executable
exe ]
                                     [SymbolicPath PackageDir SourceDir]
ds -> [ SymbolicPath PackageDir SourceDir -> String
sourceDirToFilePath SymbolicPath PackageDir SourceDir
d String -> ShowS
</> Executable -> String
modulePath Executable
exe | SymbolicPath PackageDir SourceDir
d <- [SymbolicPath PackageDir SourceDir]
ds ]
                   }

toMod :: ModuleName -> ModName
toMod :: ModuleName -> ModName
toMod ModuleName
m = case ModuleName -> [String]
components ModuleName
m of
            [] -> forall a. HasCallStack => String -> a
error String
"Empty module name."
            [String]
xs -> ([String] -> Qualifier
fromHierarchy (forall a. [a] -> [a]
init [String]
xs), forall a. [a] -> a
last [String]
xs)

findUnits :: GenericPackageDescription -> [Unit]
findUnits :: GenericPackageDescription -> [Unit]
findUnits GenericPackageDescription
g = forall a. Maybe a -> [a]
maybeToList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Library -> Unit
libUnit (PackageDescription -> Maybe Library
library PackageDescription
pkg))  forall a. [a] -> [a] -> [a]
++
                           forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Executable -> Unit
exeUnit (PackageDescription -> [Executable]
executables PackageDescription
pkg)
  where
  pkg :: PackageDescription
pkg = GenericPackageDescription -> PackageDescription
flattenPackageDescription GenericPackageDescription
g -- we just ignore flags