{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} module Distribution.Hackage.Imports.Generate where import Distribution.Hackage.DB (Hackage, Version, readHackage) import Distribution.PackageDescription ( GenericPackageDescription(packageDescription, condLibrary), PackageDescription(library), Library(exposedModules), CondTree(CondNode, condTreeData) ) import Distribution.ModuleName (ModuleName) import qualified Distribution.ModuleName import Distribution.Version (Version(versionBranch)) import Distribution.Text (disp) import qualified Data.Map.Lazy import Control.Arrow (second) import Text.PrettyPrint (Doc, text, ($+$), render) import GHC.Exts (sortWith, Down(Down)) import Data.Monoid ((<>), mempty) import Data.Foldable (foldl') import System.FilePath (FilePath, ()) import Data.String (fromString) import Data.Char (toUpper) import Data.Foldable (traverse_) import Data.List (intercalate) type PackageName = String class ToString a where toString :: a -> String instance ToString String where toString = id stringToFilePath :: String -> FilePath stringToFilePath = id getExposedModules :: GenericPackageDescription -> [ModuleName] getExposedModules gpd = let libs1 = case library (packageDescription gpd) of Nothing -> [] Just l -> exposedModules l libs2 = case condLibrary gpd of Nothing -> [] Just (CondNode{condTreeData=l}) -> exposedModules l in libs1 ++ libs2 getExposedModulesAllVersions :: Hackage -> PackageName -> [(Version, [ModuleName])] getExposedModulesAllVersions hackage pn = case Data.Map.Lazy.lookup pn hackage of Nothing -> [] Just gpdm -> (second getExposedModules) <$> Data.Map.Lazy.toList gpdm genImportList :: (ModuleName -> Doc) -> ModuleName -> PackageName -> [(Version, [ModuleName])] -> Doc genImportList f moduleName packageName l = languageCpp $+$ moduleHeader $+$ guard $+$ body $+$ endIf $+$ "#endif" where languageCpp = "{-# LANGUAGE CPP #-}" guard = "#ifdef MIN_VERSION_" <> packageNameDoc packageNameDoc = text (replace_dash <$> toString packageName) moduleHeader = "module " <> disp moduleName <> " () where" endIf = case l of [] -> mempty _ -> "#endif" body = (foldl' ($+$) mempty $ zipWith g ("#if":(repeat "#elif")) (sortWith Down l)) g macro (version, module_list) = preprocessorLine $+$ modules where preprocessorLine = macro <> " MIN_VERSION_" <> packageNameDoc <> "(" <> v1 <> "," <> v2 <> "," <> v3 <> ")" modules = foldl' ($+$) mempty (f <$> module_list) [v1, v2, v3] = (text . show) <$> (take 3 (versionBranch version ++ [0..])) genImportListFromHackage :: Hackage -> ModuleName -> PackageName -> Doc genImportListFromHackage hackage moduleName packageName = genImportList toImportLine moduleName packageName (getExposedModulesAllVersions hackage packageName) where toImportLine :: ModuleName -> Doc toImportLine mn = "import " <> disp mn <> " ()" writeImportListToFile :: Hackage -> FilePath -> [String] -> PackageName -> IO () writeImportListToFile hackage basePath baseModuleStrList packageName = writeFile moduleFileName $ render (genImportListFromHackage hackage moduleName packageName) where capitalisedPackageName = let (s:ss) = toString packageName in fromString (((toUpper s):(replace_dash <$> ss))) capitalisedPackageFileName = capitalisedPackageName <> ".hs" moduleFileName = (foldl' () basePath (map stringToFilePath baseModuleStrList)) capitalisedPackageFileName moduleName = Distribution.ModuleName.fromString ((intercalate "." baseModuleStrList) <> "." <> capitalisedPackageName) replace_dash :: Char -> Char replace_dash c = case c of '-' -> '_' x -> x writeImportListsToDir :: Foldable f => FilePath -> [String] -> f PackageName -> IO () writeImportListsToDir basePath baseModuleStrList packageNames = do hackage <- readHackage traverse_ (writeImportListToFile hackage basePath baseModuleStrList) packageNames writeGHCPackageImportListsToDir :: FilePath -> [String] -> IO () writeGHCPackageImportListsToDir basePath baseModuleStrList = writeImportListsToDir basePath baseModuleStrList ghcPackages ghcPackages :: [PackageName] ghcPackages = [ "array", "base", "binary", "bytestring", "Cabal", "containers", "deepseq", "directory", "filepath", "ghc", "ghc-boot", "ghc-compact", "ghc-prim", "haskell98", "haskell2010", "hoopl", "hpc", "old-locale", "old-time", "integer-gmp", "process", "template-haskell", "time", "unix", "Win32" ] {- getExposedModulesAllVersionsIO :: PackageName -> IO [(Version, [ModuleName])] getExposedModulesAllVersionsIO pn = do hackage <- readHackage pure $ getExposedModulesAllVersions hackage pn -}