cabal-auto-expose (empty) → 0.1.0.0

raw patch · 4 files changed

+447/−0 lines, 4 filesdep +Cabaldep +basedep +directorysetup-changed

Dependencies added: Cabal, base, directory, extra, filepath

Files

• LICENSE +21/−0
• Setup.hs +2/−0
• cabal-auto-expose.cabal +34/−0
• src/Distribution/Simple/AutoExpose.hs +390/−0

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2020 Aditya Siram ++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,34 @@+cabal-version: 1.12+name: cabal-auto-expose+version: 0.1.0.0+synopsis: Build time library that autodetects exposed modules+description: Build time library used with a custom Setup.hs that autodetects exposed modules in the source directories of each build artifact.+category: distribution,bundle,modules,library+homepage: https://github.com/deech/cabal-auto-expose#readme+bug-reports: https://github.com/deech/cabal-auto-expose/issues+author: Aditya Siram+maintainer: Aditya Siram+copyright: 2020 Aditya Siram+license: MIT+license-file: LICENSE+build-type: Simple+source-repository head+  type: git+  location: https://github.com/deech/cabal-auto-expose++library+  default-language: Haskell2010+  default-extensions: ScopedTypeVariables+  exposed-modules:+    Distribution.Simple.AutoExpose+  other-modules:+    Paths_cabal_auto_expose+  hs-source-dirs:+    src+  ghc-options: -Wall+  build-depends:+    Cabal >= 3.2.0.0 && < 3.5.0.0,+    base >= 4.14 && < 4.15,+    filepath,+    directory,+    extra >= 1.7.7 && < 1.8

@@ -0,0 +1,390 @@+-- | Import this module in your @Setup.hs@ to auto detect library modules in+-- your project The API does not conceal it's internals but in most cases you+-- should only need the functions and datatype under+-- 'Quick Start Functions' ("Distribution.Simple.AutoExpose#QuickStartFunctions").+-- For more granular access the ones under+-- 'Internal Functions' ("Distribution.Simple.AutoExpose#InternalFunctions") are+-- available but subject to change.++module Distribution.Simple.AutoExpose where++import Control.Exception(catch,IOException)+import Control.Monad((>=>),filterM)+import Control.Monad.Extra(ifM,notM,whenJust)+import Data.List(intercalate,nub)+import Distribution.Compat.Lens((%~))+import Distribution.ModuleName(ModuleName,fromString,validModuleComponent)+import Distribution.PackageDescription(hsSourceDirs,buildInfo,testBuildInfo,benchmarkBuildInfo,executables,testSuites,benchmarks,libBuildInfo,subLibraries,library,Library,GenericPackageDescription(..),HookedBuildInfo,Executable,TestSuite,Benchmark,condTreeData,packageDescription)+import Distribution.Simple.BuildPaths(autogenPathsModuleName)+import Distribution.Simple.PreProcess(knownSuffixHandlers)+import Distribution.Simple.Setup(BuildFlags, ReplFlags, HscolourFlags, HaddockFlags, CopyFlags, InstallFlags, TestFlags, BenchmarkFlags, RegisterFlags, DoctestFlags, ConfigFlags,fromFlag, configVerbosity)+import Distribution.Simple.UserHooks(UserHooks,Args,hookedPreProcessors, buildHook,replHook,hscolourHook,doctestHook,haddockHook,copyHook,instHook,testHook,benchHook,regHook,unregHook,confHook)+import Distribution.Simple.Utils(findPackageDesc,notice)+import Distribution.Types.LocalBuildInfo(LocalBuildInfo)+import Distribution.Types.PackageDescription(PackageDescription,package)+import GHC.Stack(HasCallStack)+import System.Directory(makeAbsolute,listDirectory,doesDirectoryExist,withCurrentDirectory,pathIsSymbolicLink,getTemporaryDirectory)+import System.FilePath(splitDirectories, dropExtension, takeExtension,equalFilePath,makeRelative,(</>),(<.>))+import qualified Distribution.Simple(defaultMainWithHooks,simpleUserHooks)+import qualified Distribution.Types.BuildInfo.Lens as L+import qualified Distribution.Types.Library.Lens as L+import Distribution.Pretty(prettyShow)+import Distribution.Types.PackageId(PackageIdentifier(pkgName,pkgVersion))+import Distribution.Types.Version()+import Distribution.PackageDescription.PrettyPrint(writeGenericPackageDescription)++-- * Quick Start Functions #QuickStartFunctions#++-- | The common case top level function where this library is the only custom part of your project+--+-- > import qualified Distribution.Simple.AutoExpose+-- > main = AutoExpose.defaultMain+defaultMain :: IO ()+defaultMain = defaultMainWithHooks Distribution.Simple.simpleUserHooks++-- | If you have already using custom 'UserHooks' use this in your Setup.hs's 'main'+--+-- > import qualified Distribution.Simple.AutoExpose as AutoExpose+-- > main = AutoExpose.defaultMainWithHooks myHooks+defaultMainWithHooks :: UserHooks -> IO ()+defaultMainWithHooks uhs = Distribution.Simple.defaultMainWithHooks (autoExposeHooks Nothing uhs)++-- | The common case top level function where this library is the only custom part of your project+--+-- It also generates an explicit Cabal file at @\/<system-temp-directory>\/<package-name>-<package-version>-generated.cabal@+--+-- > import qualified Distribution.Simple.AutoExpose+-- > main = AutoExpose.defaultMainGenerateCabal+defaultMainGenerateCabal :: IO ()+defaultMainGenerateCabal = do+  defaultCabalWriter <- defaultWriteGeneratedCabal+  defaultMainWithHooksGenerateCabal defaultCabalWriter Distribution.Simple.simpleUserHooks++-- | If you have already using custom 'UserHooks' use this in your Setup.hs's 'main' and also+-- provide a way to generate an explicit Cabal file.+--+-- > import qualified Distribution.Simple.AutoExpose as AutoExpose+-- > main = do+-- >   cabalWriter <- defaultWriteGeneratedCabal+-- >   AutoExpose.defaultMainWithHooksGenerateCabal cabalWriter myHooks+defaultMainWithHooksGenerateCabal :: WriteGeneratedCabal -> UserHooks -> IO ()+defaultMainWithHooksGenerateCabal writeGeneratedCabal uhs =+  Distribution.Simple.defaultMainWithHooks (autoExposeHooks (Just writeGeneratedCabal) uhs)++-- | A datatype that wraps a function that outputs the name of the+-- explicity generated Cabal file and an absolute path to a directory+-- into which to write it.+data WriteGeneratedCabal =+  WriteGeneratedCabal+  { writeGeneratedCabalPath :: FilePath+  , writeGeneratedCabalName :: GenericPackageDescription -> FilePath+  }++-- | Write the Cabal file to the system temp directory by default using+-- 'defaultGeneratedCabalName' for the filename.+defaultWriteGeneratedCabal :: IO WriteGeneratedCabal+defaultWriteGeneratedCabal = do+  tmp <- getTemporaryDirectory+  pure (WriteGeneratedCabal tmp defaultGeneratedCabalName)++-- * Internal Functions #InternalFunctions#++-- | Search for file paths that look like valid modules and convert to the+--   components to the Cabal internal 'ModuleName'.+moduleNamesToExpose+  :: [String] -- ^ File extensions of valid Haskell modules, includes pre-processor extensions+  -> [FilePath] -- ^ File paths to search+  -> [ModuleName]+moduleNamesToExpose extensions =+  map (fromString . intercalate ".")+  . filter (all validModuleComponent)+  . map toModuleComponents+  . filter hasExtension+  where+    hasExtension :: FilePath -> Bool+    hasExtension f =+      elem+        (drop 1 (takeExtension f)) -- 'takeExtension' preserves the '.' so drop it+        extensions+    toModuleComponents :: FilePath -> [String]+    toModuleComponents =+      splitDirectories . dropExtension++-- | Recursively collect the files in a directory, optionally excluding some+-- files. Symlinks are ignored and collected paths are relative to the search+-- directory, eg. if the search directory is @\/home\/user\/myproject\/src@ the path+-- @\/home\/user\/myproject\/src\/A\/B\/C.hs@ is returned as @A\/B\/C.hs@ so it can+-- converted by 'moduleNamesToExpose' to a valid module name.+getDirectoryContents+  :: HasCallStack+  => FilePath -- ^ Directory to search (path must be absolute)+  -> [FilePath] -- ^ Paths to ignore (paths must be absolute)+  -> IO [FilePath] -- ^ File paths made relative to the search directory+getDirectoryContents dir excludedDirs = do+  (map (makeRelative dir)) <$> go [dir] []+  where+    go :: [FilePath] -> [FilePath] -> IO [FilePath]+    go (f:fs) accum+      | any (equalFilePath f) excludedDirs = go fs accum+      | otherwise =+          ifM (doesDirectoryExist f)+            (catch+              (withCurrentDirectory f $ do+                 contents <-+                   (listDirectory >=> filterM (notM . pathIsSymbolicLink) >=> mapM makeAbsolute) f+                 go (contents ++ fs) accum)+              (\(_ :: IOException) -> go fs accum))+            (go fs (f:accum))+    go [] accum = pure accum++-- | Captures the detected Haskell modules and signatures in a library+data ExposedLib =+  ExposedLib+  { exposedLibModules :: [ModuleName]+  , exposedLibSignatures :: [ModuleName]+  }+  deriving Show++-- | The common pieces of 'GenericPackageDescription' and 'PackageDescription'+-- which we need to auto detect Haskell modules /and/ signatures. We can't make+-- do with just the 'PackageDescription' because the 'confHook' which+-- instantiates the library with signatures only has access to+-- 'GenericPackageDescription'.+data PackageDescriptionSubset =+  PackageDescriptionSubset+  { packageDescriptionSubsetLibrary :: Maybe Library+  , packageDescriptionSubsetSubLibraries :: [Library]+  , packageDescriptionSubsetExecutables :: [Executable]+  , packageDescriptionSubsetTestSuites :: [TestSuite]+  , packageDescriptionSubsetBenchmarks :: [Benchmark]+  }+  deriving Show++genericPackageDescriptionToSubset :: GenericPackageDescription -> PackageDescriptionSubset+genericPackageDescriptionToSubset gpd =+  PackageDescriptionSubset+    (fmap condTreeData (condLibrary gpd))+    (map (condTreeData . snd) (condSubLibraries gpd))+    (map (condTreeData . snd) (condExecutables gpd))+    (map (condTreeData . snd) (condTestSuites gpd))+    (map (condTreeData . snd) (condBenchmarks gpd))++packageDescriptionToSubset :: PackageDescription -> PackageDescriptionSubset+packageDescriptionToSubset pd =+  PackageDescriptionSubset+    (library pd)+    (subLibraries pd)+    (executables pd)+    (testSuites pd)+    (benchmarks pd)++-- | Source directories for all non-library components (benchmarks, executables+-- etc.) so that we can exclude their modules if they appear inside the library's+-- source directory+nonLibraryHsSourcePaths :: PackageDescriptionSubset -> [[FilePath]]+nonLibraryHsSourcePaths pds =+  map hsSourceDirs $+     (map buildInfo (packageDescriptionSubsetExecutables pds))+  ++ (map testBuildInfo (packageDescriptionSubsetTestSuites pds))+  ++ (map benchmarkBuildInfo (packageDescriptionSubsetBenchmarks pds))++-- | Associate each item in a list will it's left and right elements, eg.+-- > indexWithNeighbors [1,2,3,4] == [(1,[2,3,4]),(2,[1,3,4]),(3,[1,2,4]),(4,[1,2,3])]+--+-- Used to associate a source directory with possibly inner directories that+-- should be ignored with searching for Haskell modules.+indexWithNeighbors :: [a] -> [(a,[a])]+indexWithNeighbors (a:as) = reverse (go [] a as [])+  where+    go [] x (r:rs) accum = go [x] r rs ((x,(r:rs)):accum)+    go ls x (r:rs) accum = go (ls++[x]) r rs ((x,(ls++(r:rs))):accum)+    go ls x [] accum = (x,ls):accum+indexWithNeighbors [] = []++-- | Drill into the source trees for a component and find modules+-- excluding the source trees for other components+getExposedModules+  :: HasCallStack+  => [String] -- ^ Known Haskell and/or preprocessor extensions+  -> [FilePath] -- ^ The source trees for this component+  -> [[FilePath]] -- ^ The source trees for all the other components+  -> IO [ModuleName] -- ^ Detect modules in this component+getExposedModules exts hsSrcDirs otherHsSrcDirs = do+  absHsSrcDirs <- mapM makeAbsolute hsSrcDirs+  absOtherHsSrcDirs <- mapM makeAbsolute (concat otherHsSrcDirs)+  contents <-+    concat+    <$> ( mapM (\(srcDir,excludeDirs) -> getDirectoryContents srcDir excludeDirs)+          $ map (\(srcDir,otherSrcDirs) -> (srcDir,otherSrcDirs ++ absOtherHsSrcDirs))+          $ indexWithNeighbors absHsSrcDirs+        )+  pure $ moduleNamesToExpose exts contents++-- | Get a list of detected Haskell modules and signatures in the main library+getExposedLib+  :: HasCallStack+  => PackageDescriptionSubset+  -> UserHooks -- ^ So we can grab the 'hookedPreProcessors' extensions+  -> IO ExposedLib+getExposedLib pds uhs =+  let excluded =+        map libSrcDir (packageDescriptionSubsetSubLibraries pds) ++ (nonLibraryHsSourcePaths pds)+      libExposedModules l =+        getExposedModules (sourceExtensions ++ ppExts) (libSrcDir l) excluded+      libExposedSignatures l =+        getExposedModules hsigExtensions (libSrcDir l) excluded+  in case (packageDescriptionSubsetLibrary pds) of+       Nothing -> pure (ExposedLib [] [])+       Just l -> pure ExposedLib <*> (libExposedModules l) <*> (libExposedSignatures l)+  where+    ppExts :: [String]+    ppExts = (nub . map fst) ((hookedPreProcessors uhs) ++ knownSuffixHandlers)+    libSrcDir :: Library -> [FilePath]+    libSrcDir = nub . hsSourceDirs . libBuildInfo++-- | Since the @hs-source-dirs@ fields in a @.cabal@ file take a source tree+-- path relative to the @.cabal@ file itself we need to make sure the current+-- working directory in which to search for module detection is the directory in+-- which the @.cabal@ file resides.+withCabalFileDirectory+  :: HasCallStack+  => IO a -- ^ The IO action that auto detects modules & signatures+  -> IO a+withCabalFileDirectory action = do+  cabalFilePath <- findPackageDesc "."+  case cabalFilePath of+    Left err -> error err+    Right _ -> withCurrentDirectory "." action++-- | Update the exposed modules and signatures of a 'Library'+updateLibrary :: ExposedLib -> Library -> Library+updateLibrary exposedLib =+  (L.exposedModules %~ (nub . (++) (exposedLibModules exposedLib)))+  . (L.signatures %~ (nub . (++) (exposedLibSignatures exposedLib)))++-- | Update the 'PackageDescription' of this package to include auto detected+-- library modules. Also just to be nice fill in the 'Paths_...' module in+-- 'otherModules' field of the library's 'BuildInfo'.+updatePackageDescription :: HasCallStack => PackageDescription -> UserHooks -> IO PackageDescription+updatePackageDescription pd uhs =+  withCabalFileDirectory $ do+    exposedLib <- getExposedLib (packageDescriptionToSubset pd) uhs+    let newMainLibrary =+         (L.libBuildInfo . L.otherModules %~ (nub . (++) [(autogenPathsModuleName pd)]))+         . updateLibrary exposedLib+    pure (pd { library = fmap newMainLibrary (library pd) })++-- | Update the 'GenericPackageDescription' of this package so the library can+-- be properly instantiated with Backpack signatures at configure time when the+-- 'confHook' is run.+updateGenericPackageDescription :: HasCallStack => GenericPackageDescription -> UserHooks -> IO GenericPackageDescription+updateGenericPackageDescription gpd uhs =+  let updateCondTreeLib exposedLib condLib =+        condLib { condTreeData = updateLibrary exposedLib (condTreeData condLib) }+  in withCabalFileDirectory $ do+      exposedLib <- getExposedLib (genericPackageDescriptionToSubset gpd) uhs+      pure $+        gpd { condLibrary = fmap (updateCondTreeLib exposedLib) (condLibrary gpd) }++-- | The default name to use when generating an explicit Cabal file+-- It defaults to @<package-name>-<package-version>-generated.cabal@+defaultGeneratedCabalName  :: GenericPackageDescription -> FilePath+defaultGeneratedCabalName gpd =+  let gpdPkg = package . packageDescription+  in (prettyShow (pkgName (gpdPkg gpd)))+     ++ "-"+     ++ (prettyShow (pkgVersion (gpdPkg gpd)))+     ++ "-generated"+     <.> "cabal"++autoExposeConfHook+  :: UserHooks+  -> Maybe WriteGeneratedCabal+  -> (GenericPackageDescription, HookedBuildInfo)+  -> ConfigFlags+  -> IO LocalBuildInfo+autoExposeConfHook userHooks writeGeneratedCabalM (gpd,hbi) cfs = do+  newGpd <- updateGenericPackageDescription gpd userHooks+  whenJust writeGeneratedCabalM+    (\(WriteGeneratedCabal outputDir generatedCabalName) -> do+        let f = outputDir </> (generatedCabalName newGpd)+        notice (fromFlag (configVerbosity cfs)) ("Writing generated Cabal file: " ++ f)+        writeGenericPackageDescription f newGpd+    )+  (confHook userHooks) (newGpd,hbi) cfs++-- | Modify a set of 'UserHooks' so that all relevant hooks see a+-- 'PackageDescription' or 'GenericPackageDescription' with auto detected+-- modules and signatures filled in.+--+-- Also optionally write an explicit Cabal file at 'confHook' time.+autoExposeHooks :: Maybe WriteGeneratedCabal -> UserHooks -> UserHooks+autoExposeHooks writeGeneratedCabalM userHooks =+  userHooks+  { confHook = autoExposeConfHook userHooks writeGeneratedCabalM+  , buildHook = bh+  , replHook = rh+  , hscolourHook = hscolourH+  , doctestHook = dth+  , haddockHook = hh+  , copyHook = ch+  , instHook = ih+  , testHook = th+  , benchHook = benchH+  , regHook = regH+  , unregHook = unregH+  }+  where+    bh :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()+    bh pd lbi uhs fs = do+      newPd <- updatePackageDescription pd uhs+      (buildHook userHooks) newPd lbi uhs fs+    rh :: PackageDescription -> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()+    rh pd lbi uhs fs opts = do+      newPd <- updatePackageDescription pd uhs+      (replHook userHooks) newPd lbi uhs fs opts+    hscolourH :: PackageDescription -> LocalBuildInfo -> UserHooks -> HscolourFlags -> IO ()+    hscolourH pd lbi uhs fs = do+      newPd <- updatePackageDescription pd uhs+      (hscolourHook userHooks) newPd lbi uhs fs+    dth :: PackageDescription -> LocalBuildInfo -> UserHooks -> DoctestFlags -> IO ()+    dth pd lbi uhs fs = do+      newPd <- updatePackageDescription pd uhs+      (doctestHook userHooks) newPd lbi uhs fs+    hh :: PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()+    hh pd lbi uhs fs = do+      newPd <- updatePackageDescription pd uhs+      (haddockHook userHooks) newPd lbi uhs fs+    ch :: PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO ()+    ch pd lbi uhs fs = do+      newPd <- updatePackageDescription pd uhs+      (copyHook userHooks) newPd lbi uhs fs+    ih :: PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO ()+    ih pd lbi uhs fs = do+      newPd <- updatePackageDescription pd uhs+      (instHook userHooks) newPd lbi uhs fs+    th :: Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> TestFlags -> IO ()+    th args pd lbi uhs fs = do+      newPd <- updatePackageDescription pd uhs+      (testHook userHooks) args newPd lbi uhs fs+    benchH :: Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> BenchmarkFlags -> IO ()+    benchH args pd lbi uhs fs = do+      newPd <- updatePackageDescription pd uhs+      (benchHook userHooks) args newPd lbi uhs fs+    regH :: PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO ()+    regH pd lbi uhs fs = do+      newPd <- updatePackageDescription pd uhs+      (regHook userHooks) newPd lbi uhs fs+    unregH :: PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO ()+    unregH pd lbi uhs fs = do+      newPd <- updatePackageDescription pd uhs+      (unregHook userHooks) newPd lbi uhs fs++-- | The supported Haskell source extensions, currently 'hs' and 'lhs'+sourceExtensions :: [String]+sourceExtensions = ["hs","lhs"]++-- | Backpack signature extensions, currently 'hsig' and 'lhsig'+hsigExtensions :: [String]+hsigExtensions = ["hsig","lhsig"]+