Commit b3eccedf authored by Brent Yorgey's avatar Brent Yorgey

init: put in place most of the scaffolding to guess other-extensions field

Only remaining thing is to actually parse LANGUAGE pragmas in source files.
parent 79858f9d
......@@ -335,9 +335,13 @@ getModulesBuildToolsAndDeps pkgIx flags = do
)
pkgIx
exts <- return (otherExts flags)
?>> (return . Just . nub . concatMap extensions $ sourceFiles)
return $ flags { exposedModules = Just mods
, buildTools = tools
, dependencies = deps
, otherExts = exts
}
importsToDeps :: InitFlags -> [ModuleName] -> PackageIndex -> IO [P.Dependency]
......@@ -708,6 +712,10 @@ generateCabalFile fileName c =
Executable -> "Modules included in this executable, other than Main.")
True
, fieldS "other-extensions" (listField (otherExts c'))
(Just "LANGUAGE extensions used by modules in this package.")
True
, fieldS "build-depends" (listField (dependencies c'))
(Just "Other library packages from which modules are imported.")
True
......
......@@ -28,6 +28,7 @@ import qualified Distribution.PackageDescription as PD
( category, packageDescription )
import Distribution.Simple.Utils
( intercalate )
import Language.Haskell.Extension ( Extension )
import Distribution.Client.Types ( packageDescription, SourcePackageDb(..) )
import Control.Applicative ( pure, (<$>), (<*>) )
......@@ -54,10 +55,11 @@ data SourceFileEntry = SourceFileEntry
, moduleName :: ModuleName
, fileExtension :: String
, imports :: [ModuleName]
, extensions :: [Extension]
} deriving Show
sfToFileName :: FilePath -> SourceFileEntry -> FilePath
sfToFileName projectRoot (SourceFileEntry relPath m ext _)
sfToFileName projectRoot (SourceFileEntry relPath m ext _ _)
= projectRoot </> relPath </> toFilePath m <.> ext
-- |Search for source files in the given directory
......@@ -75,7 +77,7 @@ scanForModulesIn projectRoot srcRoot = scan srcRoot []
let modules = catMaybes [ guessModuleName hierarchy file
| file <- files
, isUpper (head file) ]
modules' <- mapM (findImports projectRoot) modules
modules' <- mapM (findImportsAndExts projectRoot) modules
recMods <- mapM (scanRecursive dir hierarchy) dirs
return $ concat (modules' : recMods)
tagIsDir parent entry = do
......@@ -84,7 +86,7 @@ scanForModulesIn projectRoot srcRoot = scan srcRoot []
guessModuleName hierarchy entry
| takeBaseName entry == "Setup" = Nothing
| ext `elem` sourceExtensions =
SourceFileEntry <$> pure relRoot <*> modName <*> pure ext <*> pure []
SourceFileEntry <$> pure relRoot <*> modName <*> pure ext <*> pure [] <*> pure []
| otherwise = Nothing
where
relRoot = makeRelative projectRoot srcRoot
......@@ -100,8 +102,8 @@ scanForModulesIn projectRoot srcRoot = scan srcRoot []
ignoreDir ('.':_) = True
ignoreDir dir = dir `elem` ["dist", "_darcs"]
findImports :: FilePath -> SourceFileEntry -> IO SourceFileEntry
findImports projectRoot sf = do
findImportsAndExts :: FilePath -> SourceFileEntry -> IO SourceFileEntry
findImportsAndExts projectRoot sf = do
s <- readFile (sfToFileName projectRoot sf)
let modules = mapMaybe
......@@ -120,7 +122,13 @@ findImports projectRoot sf = do
-- Haskell parser since cabal's dependencies must be kept at a
-- minimum.
return sf { imports = modules }
exts = undefined --- XXX todo: parse LANGUAGE pragmas.
. lines
$ s
return sf { imports = modules
, extensions = exts
}
where getModName :: [String] -> Maybe ModuleName
getModName [] = Nothing
......
......@@ -21,7 +21,7 @@ import Distribution.Verbosity
import qualified Distribution.Package as P
import Distribution.License
import Distribution.ModuleName
import Language.Haskell.Extension ( Language(..) )
import Language.Haskell.Extension ( Language(..), Extension )
import qualified Text.PrettyPrint as Disp
import qualified Distribution.Compat.ReadP as Parse
......@@ -58,6 +58,7 @@ data InitFlags =
, exposedModules :: Maybe [ModuleName]
, otherModules :: Maybe [ModuleName]
, otherExts :: Maybe [Extension]
, dependencies :: Maybe [P.Dependency]
, sourceDirs :: Maybe [String]
......@@ -100,6 +101,7 @@ instance Monoid InitFlags where
, language = mempty
, exposedModules = mempty
, otherModules = mempty
, otherExts = mempty
, dependencies = mempty
, sourceDirs = mempty
, buildTools = mempty
......@@ -126,6 +128,7 @@ instance Monoid InitFlags where
, language = combine language
, exposedModules = combine exposedModules
, otherModules = combine otherModules
, otherExts = combine otherExts
, dependencies = combine dependencies
, sourceDirs = combine sourceDirs
, buildTools = combine buildTools
......
......@@ -1147,6 +1147,14 @@ initCommand = CommandUI {
((Just . (:[])) `fmap` parse))
(maybe [] (fmap display)))
, option [] ["extension"]
"Use a LANGUAGE extension (in the other-extensions field)."
IT.otherExts
(\v flags -> flags { IT.otherExts = v })
(reqArg "EXTENSION" (readP_to_E ("Cannot parse extension: "++)
((Just . (:[])) `fmap` parse))
(maybe [] (fmap display)))
, option ['d'] ["dependency"]
"Package dependency."
IT.dependencies (\v flags -> flags { IT.dependencies = v })
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment