module Autopack
( defaultMainAutoModules
) where
import Data.Functor ((<&>))
import Data.List (nub, stripPrefix)
import Data.Maybe (maybeToList)
import Distribution.ModuleName (ModuleName, fromComponents)
import Distribution.Simple (UserHooks (..), defaultMainWithHooks, simpleUserHooks)
import Distribution.Types.BuildInfo (BuildInfo (..))
import Distribution.Types.CondTree (CondTree (..))
import Distribution.Types.GenericPackageDescription (GenericPackageDescription (..))
import Distribution.Types.Library (Library (..))
import System.Directory.Recursive (getDirRecursive)
import System.FilePath (dropExtension, splitDirectories, takeExtension)
defaultMainAutoModules :: IO ()
defaultMainAutoModules :: IO ()
defaultMainAutoModules = UserHooks -> IO ()
UserHooks -> IO ()
defaultMainWithHooks (UserHooks -> IO ()) -> UserHooks -> IO ()
forall a b. (a -> b) -> a -> b
$
(GenericPackageDescription -> IO [ModuleName])
-> UserHooks -> UserHooks
modulesHooks GenericPackageDescription -> IO [ModuleName]
getModules UserHooks
simpleUserHooks
where
getModules :: GenericPackageDescription -> IO [ModuleName]
getModules :: GenericPackageDescription -> IO [ModuleName]
getModules pkgDescr :: GenericPackageDescription
pkgDescr = do
let dirs :: [FilePath]
dirs = (CondTree ConfVar [Dependency] Library -> [FilePath])
-> [CondTree ConfVar [Dependency] Library] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [FilePath]
hsSourceDirs (BuildInfo -> [FilePath])
-> (CondTree ConfVar [Dependency] Library -> BuildInfo)
-> CondTree ConfVar [Dependency] Library
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo (Library -> BuildInfo)
-> (CondTree ConfVar [Dependency] Library -> Library)
-> CondTree ConfVar [Dependency] Library
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] Library -> Library
forall v c a. CondTree v c a -> a
condTreeData) ([CondTree ConfVar [Dependency] Library] -> [FilePath])
-> [CondTree ConfVar [Dependency] Library] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
Maybe (CondTree ConfVar [Dependency] Library)
-> [CondTree ConfVar [Dependency] Library]
forall a. Maybe a -> [a]
maybeToList (Maybe (CondTree ConfVar [Dependency] Library)
-> [CondTree ConfVar [Dependency] Library])
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [CondTree ConfVar [Dependency] Library]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
pkgDescr
[FilePath]
files <- [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
getDirRecursive [FilePath]
dirs
let hsFiles :: [FilePath]
hsFiles = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\f :: FilePath
f -> FilePath -> FilePath
takeExtension FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ".hs") [FilePath]
files
[ModuleName] -> IO [ModuleName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ModuleName] -> IO [ModuleName])
-> [ModuleName] -> IO [ModuleName]
forall a b. (a -> b) -> a -> b
$ (FilePath -> ModuleName) -> [FilePath] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> FilePath -> ModuleName
toModuleName [FilePath]
dirs) [FilePath]
hsFiles
toModuleName :: [FilePath] -> FilePath -> ModuleName
toModuleName :: [FilePath] -> FilePath -> ModuleName
toModuleName dirs :: [FilePath]
dirs file :: FilePath
file = do
let strippedFile :: FilePath
strippedFile = [FilePath] -> FilePath
removeDirPrefix [FilePath]
dirs
let noExtFile :: FilePath
noExtFile = FilePath -> FilePath
dropExtension FilePath
strippedFile
[FilePath] -> ModuleName
fromComponents ([FilePath] -> ModuleName) -> [FilePath] -> ModuleName
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitDirectories FilePath
noExtFile
where
removeDirPrefix :: [FilePath] -> FilePath
removeDirPrefix :: [FilePath] -> FilePath
removeDirPrefix [] = FilePath
file
removeDirPrefix (d :: FilePath
d:ds :: [FilePath]
ds) = case FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
d FilePath
file of
Just newFile :: FilePath
newFile -> Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop 1 FilePath
newFile
Nothing -> [FilePath] -> FilePath
removeDirPrefix [FilePath]
ds
modulesHooks
:: (GenericPackageDescription -> IO [ModuleName])
-> UserHooks
-> UserHooks
modulesHooks :: (GenericPackageDescription -> IO [ModuleName])
-> UserHooks -> UserHooks
modulesHooks getModules :: GenericPackageDescription -> IO [ModuleName]
getModules hooks :: UserHooks
hooks = UserHooks
hooks
{ confHook :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
confHook = \(gPackDescr :: GenericPackageDescription
gPackDescr, hBuildInfo :: HookedBuildInfo
hBuildInfo) flags :: ConfigFlags
flags -> do
[ModuleName]
modules <- GenericPackageDescription -> IO [ModuleName]
getModules GenericPackageDescription
gPackDescr
let newGPackDescr :: GenericPackageDescription
newGPackDescr = GenericPackageDescription
gPackDescr
{ condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
condLibrary = GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
gPackDescr Maybe (CondTree ConfVar [Dependency] Library)
-> (CondTree ConfVar [Dependency] Library
-> CondTree ConfVar [Dependency] Library)
-> Maybe (CondTree ConfVar [Dependency] Library)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \condLib :: CondTree ConfVar [Dependency] Library
condLib -> CondTree ConfVar [Dependency] Library
condLib
{ condTreeData :: Library
condTreeData = (CondTree ConfVar [Dependency] Library -> Library
forall v c a. CondTree v c a -> a
condTreeData CondTree ConfVar [Dependency] Library
condLib)
{ exposedModules :: [ModuleName]
exposedModules = [ModuleName] -> [ModuleName]
forall a. Eq a => [a] -> [a]
nub ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$
Library -> [ModuleName]
exposedModules (CondTree ConfVar [Dependency] Library -> Library
forall v c a. CondTree v c a -> a
condTreeData CondTree ConfVar [Dependency] Library
condLib) [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ [ModuleName]
modules
}
}
}
UserHooks
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
confHook UserHooks
hooks (GenericPackageDescription
newGPackDescr, HookedBuildInfo
hBuildInfo) ConfigFlags
flags
}