diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,17 @@ +## Changes in 0.34.3 + - Ignore duplicate source directories (see #356) + - Do not infer duplicate modules (see #408, #406, #353) + - Reject empty `then` / `else` sections (see #362) + - Omit conditionals that are always `false` from generated `.cabal` file + (see #404) + - Infer correct `cabal-version` when `Path_` is used with `RebindableSyntax` + and `OverloadedStrings` or `OverloadedLists` (see #400) + - Do not use indentation from any existing `.cabal` file if it is invalid + (e.g. `0`) (fixes #252) + - Accept lists for `tested-with` (see #407) + - Render current directory as `./` instead of `./.` for forward compatibility + with future version of Cabal + ## Changes in 0.34.2 - Accept subcomponents as dependencies (close #382) diff --git a/hpack.cabal b/hpack.cabal --- a/hpack.cabal +++ b/hpack.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hpack -version: 0.34.2 +version: 0.34.3 synopsis: A modern format for Haskell packages description: See README at category: Development @@ -36,7 +36,7 @@ , containers , cryptonite , deepseq - , directory + , directory >=1.2.5.0 , filepath , http-client , http-client-tls @@ -63,6 +63,7 @@ Hpack.Defaults Hpack.Haskell Hpack.License + Hpack.Module Hpack.Options Hpack.Render.Dsl Hpack.Render.Hints @@ -74,6 +75,7 @@ Hpack.Syntax.ParseDependencies Hpack.Utf8 Hpack.Util + Path Paths_hpack default-language: Haskell2010 @@ -92,7 +94,7 @@ , containers , cryptonite , deepseq - , directory + , directory >=1.2.5.0 , filepath , hpack , http-client @@ -130,7 +132,7 @@ , containers , cryptonite , deepseq - , directory + , directory >=1.2.5.0 , filepath , hspec ==2.* , http-client @@ -161,6 +163,7 @@ Hpack.DefaultsSpec Hpack.HaskellSpec Hpack.LicenseSpec + Hpack.ModuleSpec Hpack.OptionsSpec Hpack.Render.DslSpec Hpack.Render.HintsSpec @@ -182,6 +185,7 @@ Hpack.Defaults Hpack.Haskell Hpack.License + Hpack.Module Hpack.Options Hpack.Render Hpack.Render.Dsl @@ -195,5 +199,6 @@ Hpack.Utf8 Hpack.Util Hpack.Yaml + Path Paths_hpack default-language: Haskell2010 diff --git a/src/Hpack/Config.hs b/src/Hpack/Config.hs --- a/src/Hpack/Config.hs +++ b/src/Hpack/Config.hs @@ -56,6 +56,7 @@ , Library(..) , Executable(..) , Conditional(..) +, Cond(..) , Flag(..) , SourceRepository(..) , BuildType(..) @@ -65,12 +66,11 @@ , CcOption , LdOption , Path(..) +, Module(..) #ifdef TEST , renameDependencies , Empty(..) -, getModules , pathsModuleFromPackageName -, Cond(..) , LibrarySection(..) , fromLibrarySectionInConditional @@ -89,13 +89,14 @@ import Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map import qualified Data.HashMap.Lazy as HashMap -import Data.List (nub, (\\), sortBy, intercalate) +import Data.List ((\\), sortBy, intercalate) import Data.Maybe import Data.Semigroup (Semigroup(..)) import Data.Ord import Data.String import Data.Text (Text) import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8) import Data.Scientific (Scientific) import System.Directory import System.FilePath @@ -108,6 +109,8 @@ import Distribution.Pretty (prettyShow) import qualified Distribution.SPDX.License as SPDX +import qualified Data.Yaml.Pretty as Yaml +import Data.Aeson (object, (.=)) import Data.Aeson.Config.Types import Data.Aeson.Config.FromValue hiding (decodeValue) import qualified Data.Aeson.Config.FromValue as Config @@ -122,7 +125,10 @@ import Hpack.Syntax.BuildTools import Hpack.License import Hpack.CabalFile (parseVersion) +import Hpack.Module +import qualified Path + import qualified Paths_hpack as Hpack (version) package :: String -> String -> Package @@ -141,7 +147,7 @@ , packageBuildType = Simple , packageLicense = Nothing , packageLicenseFile = [] - , packageTestedWith = Nothing + , packageTestedWith = [] , packageFlags = [] , packageExtraSourceFiles = [] , packageExtraDocFiles = [] @@ -197,10 +203,10 @@ data LibrarySection = LibrarySection { librarySectionExposed :: Maybe Bool , librarySectionVisibility :: Maybe String -, librarySectionExposedModules :: Maybe (List String) -, librarySectionGeneratedExposedModules :: Maybe (List String) -, librarySectionOtherModules :: Maybe (List String) -, librarySectionGeneratedOtherModules :: Maybe (List String) +, librarySectionExposedModules :: Maybe (List Module) +, librarySectionGeneratedExposedModules :: Maybe (List Module) +, librarySectionOtherModules :: Maybe (List Module) +, librarySectionGeneratedOtherModules :: Maybe (List Module) , librarySectionReexportedModules :: Maybe (List String) , librarySectionSignatures :: Maybe (List String) } deriving (Eq, Show, Generic, FromValue) @@ -223,8 +229,8 @@ data ExecutableSection = ExecutableSection { executableSectionMain :: Maybe FilePath -, executableSectionOtherModules :: Maybe (List String) -, executableSectionGeneratedOtherModules :: Maybe (List String) +, executableSectionOtherModules :: Maybe (List Module) +, executableSectionGeneratedOtherModules :: Maybe (List Module) } deriving (Eq, Show, Generic, FromValue) instance Monoid ExecutableSection where @@ -424,25 +430,54 @@ instance FromValue a => FromValue (ParseConditionalSection a) where fromValue v - | hasKey "then" v || hasKey "else" v = ThenElseConditional <$> fromValue v + | hasKey "then" v || hasKey "else" v = ThenElseConditional <$> fromValue v <* giveHint | otherwise = FlatConditional <$> fromValue v + where + giveHint = case v of + Object o -> case (,,) <$> HashMap.lookup "then" o <*> HashMap.lookup "else" o <*> HashMap.lookup "condition" o of + Just (Object then_, Object else_, String condition) -> do + when (HashMap.null then_) $ "then" `emptyTryInstead` flatElse + when (HashMap.null else_) $ "else" `emptyTryInstead` flatThen + where + flatThen = flatConditional condition then_ + flatElse = flatConditional (negate_ condition) else_ + _ -> return () + _ -> return () + negate_ condition = "!(" <> condition <> ")" + + flatConditional condition sect = object [("when" .= HashMap.insert "condition" (String condition) sect)] + + emptyTryInstead :: String -> Value -> Parser () + emptyTryInstead name sect = do + fail $ "an empty " <> show name <> " section is not allowed, try the following instead:\n\n" ++ encodePretty sect + + encodePretty = T.unpack . decodeUtf8 . Yaml.encodePretty c + where + c :: Yaml.Config + c = Yaml.setConfCompare f Yaml.defConfig + where + f a b = case (a, b) of + ("condition", "condition") -> EQ + ("condition", _) -> LT + (_, "condition") -> GT + _ -> compare a b + hasKey :: Text -> Value -> Bool hasKey key (Object o) = HashMap.member key o hasKey _ _ = False newtype Condition = Condition { - _conditionCondition :: Cond + conditionCondition :: Cond } deriving (Eq, Show, Generic, FromValue) -newtype Cond = Cond String +data Cond = CondBool Bool | CondExpression String deriving (Eq, Show) instance FromValue Cond where fromValue v = case v of - String s -> return (Cond $ T.unpack s) - Bool True -> return (Cond "true") - Bool False -> return (Cond "false") + String c -> return (CondExpression $ T.unpack c) + Bool c -> return (CondBool c) _ -> typeMismatch "Boolean or String" v data ThenElse cSources cxxSources jsSources a = ThenElse { @@ -528,7 +563,7 @@ , packageConfigBuildType :: Maybe BuildType , packageConfigLicense :: Maybe (Maybe String) , packageConfigLicenseFile :: Maybe (List String) -, packageConfigTestedWith :: Maybe String +, packageConfigTestedWith :: Maybe (List String) , packageConfigFlags :: Maybe (Map String FlagSection) , packageConfigExtraSourceFiles :: Maybe (List FilePath) , packageConfigExtraDocFiles :: Maybe (List FilePath) @@ -710,7 +745,7 @@ , makeVersion [2,0] <$ guard (has librarySignatures) , makeVersion [2,0] <$ guard (has libraryGeneratedModules) , makeVersion [3,0] <$ guard (has libraryVisibility) - , sectionCabalVersion sect + , sectionCabalVersion (concatMap getLibraryModules) sect ] where has field = any (not . null . field) sect @@ -728,20 +763,29 @@ executableCabalVersion :: Section Executable -> Maybe Version executableCabalVersion sect = maximum [ makeVersion [2,0] <$ guard (executableHasGeneratedModules sect) - , sectionCabalVersion sect + , sectionCabalVersion (concatMap getExecutableModules) sect ] executableHasGeneratedModules :: Section Executable -> Bool executableHasGeneratedModules = any (not . null . executableGeneratedModules) - sectionCabalVersion :: Section a -> Maybe Version - sectionCabalVersion sect = maximum $ [ + sectionCabalVersion :: (Section a -> [Module]) -> Section a -> Maybe Version + sectionCabalVersion getMentionedModules sect = maximum $ [ makeVersion [2,2] <$ guard (sectionSatisfies (not . null . sectionCxxSources) sect) , makeVersion [2,2] <$ guard (sectionSatisfies (not . null . sectionCxxOptions) sect) , makeVersion [2,0] <$ guard (sectionSatisfies (any hasMixins . unDependencies . sectionDependencies) sect) , makeVersion [3,0] <$ guard (sectionSatisfies (any hasSubcomponents . Map.keys . unDependencies . sectionDependencies) sect) + , makeVersion [2,2] <$ guard ( + uses "RebindableSyntax" + && (uses "OverloadedStrings" || uses "OverloadedLists") + && pathsModule `elem` getMentionedModules sect) ] ++ map versionFromSystemBuildTool systemBuildTools where + defaultExtensions = sectionAll sectionDefaultExtensions sect + uses = (`elem` defaultExtensions) + + pathsModule = pathsModuleFromPackageName packageName + versionFromSystemBuildTool name | name `elem` known_1_10 = Nothing | name `elem` known_1_14 = Just (makeVersion [1,14]) @@ -793,8 +837,6 @@ p sect , any (any (sectionSatisfies p)) (sectionConditionals sect) ] - sectionAll :: (Semigroup b, Monoid b) => (Section a -> b) -> Section a -> b - sectionAll f sect = f sect <> foldMap (foldMap $ sectionAll f) (sectionConditionals sect) hasMixins :: DependencyInfo -> Bool hasMixins (DependencyInfo mixins _) = not (null mixins) @@ -802,6 +844,9 @@ hasSubcomponents :: String -> Bool hasSubcomponents = elem ':' +sectionAll :: (Semigroup b, Monoid b) => (Section a -> b) -> Section a -> b +sectionAll f sect = f sect <> foldMap (foldMap $ sectionAll f) (sectionConditionals sect) + decodeValue :: FromValue a => ProgramName -> FilePath -> Value -> Warnings (Errors IO) a decodeValue (ProgramName programName) file value = do (r, unknown) <- lift . ExceptT . return $ first (prefix ++) (Config.decodeValue value) @@ -849,7 +894,7 @@ , packageBuildType :: BuildType , packageLicense :: Maybe String , packageLicenseFile :: [FilePath] -, packageTestedWith :: Maybe String +, packageTestedWith :: [String] , packageFlags :: [Flag] , packageExtraSourceFiles :: [Path] , packageExtraDocFiles :: [Path] @@ -872,17 +917,17 @@ data Library = Library { libraryExposed :: Maybe Bool , libraryVisibility :: Maybe String -, libraryExposedModules :: [String] -, libraryOtherModules :: [String] -, libraryGeneratedModules :: [String] +, libraryExposedModules :: [Module] +, libraryOtherModules :: [Module] +, libraryGeneratedModules :: [Module] , libraryReexportedModules :: [String] , librarySignatures :: [String] } deriving (Eq, Show) data Executable = Executable { executableMain :: Maybe FilePath -, executableOtherModules :: [String] -, executableGeneratedModules :: [String] +, executableOtherModules :: [Module] +, executableGeneratedModules :: [Module] } deriving (Eq, Show) data BuildTool = BuildTool String String | LocalBuildTool String @@ -919,7 +964,7 @@ } deriving (Eq, Show, Functor, Foldable, Traversable) data Conditional a = Conditional { - conditionalCondition :: String + conditionalCondition :: Cond , conditionalThen :: a , conditionalElse :: Maybe a } deriving (Eq, Show, Functor, Foldable, Traversable) @@ -1063,12 +1108,15 @@ toSect :: (Monad m, Monoid a) => WithCommonOptions CSources CxxSources JsSources a -> Warnings m (Section a) toSect = toSection packageName_ executableNames . first ((mempty <$ globalOptions) <>) - toLib = toSect >=> liftIO . toLibrary dir packageName_ - toExecutables = maybe (return mempty) (traverse $ toSect >=> liftIO . toExecutable dir packageName_) + toSections :: (Monad m, Monoid a) => Maybe (Map String (WithCommonOptions CSources CxxSources JsSources a)) -> Warnings m (Map String (Section a)) + toSections = maybe (return mempty) (traverse toSect) - mLibrary <- traverse toLib packageConfigLibrary - internalLibraries <- maybe (return mempty) (traverse toLib) packageConfigInternalLibraries + toLib = liftIO . toLibrary dir packageName_ + toExecutables = toSections >=> traverse (liftIO . toExecutable dir packageName_) + mLibrary <- traverse (toSect >=> toLib) packageConfigLibrary + internalLibraries <- toSections packageConfigInternalLibraries >>= traverse toLib + executables <- toExecutables executableMap tests <- toExecutables packageConfigTests benchmarks <- toExecutables packageConfigBenchmarks @@ -1124,7 +1172,7 @@ , packageBuildType = fromMaybe defaultBuildType packageConfigBuildType , packageLicense = join packageConfigLicense , packageLicenseFile = licenseFiles - , packageTestedWith = packageConfigTestedWith + , packageTestedWith = fromMaybeList packageConfigTestedWith , packageFlags = flags , packageExtraSourceFiles = extraSourceFiles , packageExtraDocFiles = extraDocFiles @@ -1234,23 +1282,36 @@ where traverseConditionals = traverse . traverse . traverseSectionAndConditionals fConditionals fConditionals -getMentionedLibraryModules :: LibrarySection -> [String] +getMentionedLibraryModules :: LibrarySection -> [Module] getMentionedLibraryModules (LibrarySection _ _ exposedModules generatedExposedModules otherModules generatedOtherModules _ _) = fromMaybeList (exposedModules <> generatedExposedModules <> otherModules <> generatedOtherModules) -listModules :: FilePath -> Section a -> IO [String] +getLibraryModules :: Library -> [Module] +getLibraryModules Library{..} = libraryExposedModules ++ libraryOtherModules + +getExecutableModules :: Executable -> [Module] +getExecutableModules Executable{..} = executableOtherModules + +listModules :: FilePath -> Section a -> IO [Module] listModules dir Section{..} = concat <$> mapM (getModules dir) sectionSourceDirs +removeConditionalsThatAreAlwaysFalse :: Section a -> Section a +removeConditionalsThatAreAlwaysFalse sect = sect { + sectionConditionals = filter p $ sectionConditionals sect + } + where + p = (/= CondBool False) . conditionalCondition + inferModules :: FilePath -> String - -> (a -> [String]) - -> (b -> [String]) - -> ([String] -> [String] -> a -> b) - -> ([String] -> a -> b) + -> (a -> [Module]) + -> (b -> [Module]) + -> ([Module] -> [Module] -> a -> b) + -> ([Module] -> a -> b) -> Section a -> IO (Section b) -inferModules dir packageName_ getMentionedModules getInferredModules fromData fromConditionals = traverseSectionAndConditionals +inferModules dir packageName_ getMentionedModules getInferredModules fromData fromConditionals = fmap removeConditionalsThatAreAlwaysFalse . traverseSectionAndConditionals (fromConfigSection fromData [pathsModuleFromPackageName packageName_]) (fromConfigSection (\ [] -> fromConditionals) []) [] @@ -1268,9 +1329,7 @@ toLibrary dir name = inferModules dir name getMentionedLibraryModules getLibraryModules fromLibrarySectionTopLevel fromLibrarySectionInConditional where - getLibraryModules :: Library -> [String] - getLibraryModules Library{..} = libraryExposedModules ++ libraryOtherModules - + fromLibrarySectionTopLevel :: [Module] -> [Module] -> LibrarySection -> Library fromLibrarySectionTopLevel pathsModule inferableModules LibrarySection{..} = Library librarySectionExposed librarySectionVisibility exposedModules otherModules generatedModules reexportedModules signatures where @@ -1279,7 +1338,7 @@ reexportedModules = fromMaybeList librarySectionReexportedModules signatures = fromMaybeList librarySectionSignatures -determineModules :: [String] -> [String] -> Maybe (List String) -> Maybe (List String) -> Maybe (List String) -> Maybe (List String) -> ([String], [String], [String]) +determineModules :: [Module] -> [Module] -> Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module) -> ([Module], [Module], [Module]) determineModules pathsModule inferable mExposed mGeneratedExposed mOther mGeneratedOther = (exposed, others, generated) where @@ -1287,7 +1346,7 @@ exposed = maybe inferable fromList mExposed ++ fromMaybeList mGeneratedExposed others = maybe ((inferable \\ exposed) ++ pathsModule) fromList mOther ++ fromMaybeList mGeneratedOther -fromLibrarySectionInConditional :: [String] -> LibrarySection -> Library +fromLibrarySectionInConditional :: [Module] -> LibrarySection -> Library fromLibrarySectionInConditional inferableModules lib@(LibrarySection _ _ exposedModules _ otherModules _ _ _) = case (exposedModules, otherModules) of (Nothing, Nothing) -> addToOtherModules inferableModules (fromLibrarySectionPlain lib) @@ -1306,16 +1365,16 @@ , librarySignatures = fromMaybeList librarySectionSignatures } -getMentionedExecutableModules :: ExecutableSection -> [String] +getMentionedExecutableModules :: ExecutableSection -> [Module] getMentionedExecutableModules (ExecutableSection main otherModules generatedModules)= - maybe id (:) (main >>= toModule . splitDirectories) $ fromMaybeList (otherModules <> generatedModules) + maybe id (:) (toModule . Path.fromFilePath <$> main) $ fromMaybeList (otherModules <> generatedModules) toExecutable :: FilePath -> String -> Section ExecutableSection -> IO (Section Executable) toExecutable dir packageName_ = - inferModules dir packageName_ getMentionedExecutableModules executableOtherModules fromExecutableSection (fromExecutableSection []) + inferModules dir packageName_ getMentionedExecutableModules getExecutableModules fromExecutableSection (fromExecutableSection []) . expandMain where - fromExecutableSection :: [String] -> [String] -> ExecutableSection -> Executable + fromExecutableSection :: [Module] -> [Module] -> ExecutableSection -> Executable fromExecutableSection pathsModule inferableModules ExecutableSection{..} = (Executable executableSectionMain (otherModules ++ generatedModules) generatedModules) where @@ -1350,7 +1409,7 @@ conditionals <- mapM toConditional (fromMaybeList commonOptionsWhen) return Section { sectionData = a - , sectionSourceDirs = fromMaybeList commonOptionsSourceDirs + , sectionSourceDirs = nub $ fromMaybeList commonOptionsSourceDirs , sectionDefaultExtensions = fromMaybeList commonOptionsDefaultExtensions , sectionOtherExtensions = fromMaybeList commonOptionsOtherExtensions , sectionGhcOptions = fromMaybeList commonOptionsGhcOptions @@ -1390,7 +1449,7 @@ ThenElseConditional (Product (ThenElse then_ else_) c) -> conditional c <$> (go then_) <*> (Just <$> go else_) FlatConditional (Product sect c) -> conditional c <$> (go sect) <*> pure Nothing where - conditional (Condition (Cond c)) = Conditional c + conditional = Conditional . conditionCondition type SystemBuildTool = (String, VersionConstraint) @@ -1439,25 +1498,8 @@ warnLegacyTool pkg name = tell ["Usage of the unqualified build-tool name " ++ show name ++ " is deprecated! Please use the qualified name \"" ++ pkg ++ ":" ++ name ++ "\" instead!"] warnLegacySystemTool name = tell ["Listing " ++ show name ++ " under build-tools is deperecated! Please list system executables under system-build-tools instead!"] -pathsModuleFromPackageName :: String -> String -pathsModuleFromPackageName name = "Paths_" ++ map f name +pathsModuleFromPackageName :: String -> Module +pathsModuleFromPackageName name = Module ("Paths_" ++ map f name) where f '-' = '_' f x = x - -getModules :: FilePath -> FilePath -> IO [String] -getModules dir src_ = sort <$> do - exists <- doesDirectoryExist (dir src_) - if exists - then do - src <- canonicalizePath (dir src_) - removeSetup src . toModules <$> getModuleFilesRecursive src - else return [] - where - toModules :: [[FilePath]] -> [String] - toModules = catMaybes . map toModule - - removeSetup :: FilePath -> [String] -> [String] - removeSetup src - | src == dir = filter (/= "Setup") - | otherwise = id diff --git a/src/Hpack/Haskell.hs b/src/Hpack/Haskell.hs --- a/src/Hpack/Haskell.hs +++ b/src/Hpack/Haskell.hs @@ -1,5 +1,6 @@ module Hpack.Haskell ( isModule +, isModuleNameComponent , isQualifiedIdentifier , isIdentifier ) where @@ -7,10 +8,10 @@ import Data.Char isModule :: [String] -> Bool -isModule name = (not . null) name && all isModuleName name +isModule name = (not . null) name && all isModuleNameComponent name -isModuleName :: String -> Bool -isModuleName name = case name of +isModuleNameComponent :: String -> Bool +isModuleNameComponent name = case name of x : xs -> isUpper x && all isIdChar xs _ -> False diff --git a/src/Hpack/Module.hs b/src/Hpack/Module.hs new file mode 100644 --- /dev/null +++ b/src/Hpack/Module.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE CPP #-} +module Hpack.Module ( + Module(..) +, toModule +, getModules +#ifdef TEST +, getModuleFilesRecursive +#endif +) where + +import Data.String +import System.FilePath +import qualified System.Directory as Directory +import Control.Monad +import Data.List hiding (nub, sort) + +import Data.Aeson.Config.FromValue +import Hpack.Util +import Hpack.Haskell + +import Path (Path(..), PathComponent(..)) +import qualified Path + +newtype Module = Module {unModule :: String} + deriving (Eq, Ord) + +instance Show Module where + show = show . unModule + +instance IsString Module where + fromString = Module + +instance FromValue Module where + fromValue = fmap Module . fromValue + +toModule :: Path -> Module +toModule path = case reverse $ Path.components path of + [] -> Module "" + file : dirs -> Module . intercalate "." . reverse $ dropExtension file : dirs + +getModules :: FilePath -> FilePath -> IO [Module] +getModules dir literalSrc = sortModules <$> do + exists <- Directory.doesDirectoryExist (dir literalSrc) + if exists + then do + canonicalSrc <- Directory.canonicalizePath (dir literalSrc) + + let + srcIsProjectRoot :: Bool + srcIsProjectRoot = canonicalSrc == dir + + toModules :: [Path] -> [Module] + toModules = removeSetup . nub . map toModule + + removeSetup :: [Module] -> [Module] + removeSetup + | srcIsProjectRoot = filter (/= "Setup") + | otherwise = id + + toModules <$> getModuleFilesRecursive canonicalSrc + else return [] + +sortModules :: [Module] -> [Module] +sortModules = map Module . sort . map unModule + +isSourceFile :: PathComponent -> Bool +isSourceFile (splitExtension . unPathComponent -> (name, ext)) = ext `elem` extensions && isModuleNameComponent name + where + extensions :: [String] + extensions = [ + ".hs" + , ".lhs" + , ".chs" + , ".hsc" + , ".y" + , ".ly" + , ".x" + ] + +isModuleComponent :: PathComponent -> Bool +isModuleComponent = isModuleNameComponent . unPathComponent + +getModuleFilesRecursive :: FilePath -> IO [Path] +getModuleFilesRecursive baseDir = go (Path []) + where + addBaseDir :: Path -> FilePath + addBaseDir = (baseDir ) . Path.toFilePath + + listDirectory :: Path -> IO [PathComponent] + listDirectory = fmap (map PathComponent) . Directory.listDirectory . addBaseDir + + doesFileExist :: Path -> IO Bool + doesFileExist = Directory.doesFileExist . addBaseDir + + doesDirectoryExist :: Path -> IO Bool + doesDirectoryExist = Directory.doesDirectoryExist . addBaseDir + + go :: Path -> IO [Path] + go dir = do + entries <- listDirectory dir + + files <- filterWith doesFileExist (filter isSourceFile entries) + directories <- filterWith doesDirectoryExist (filter isModuleComponent entries) + + subdirsFiles <- concat <$> mapM go directories + return (files ++ subdirsFiles) + where + filterWith :: (Path -> IO Bool) -> [PathComponent] -> IO [Path] + filterWith p = filterM p . map addDir + + addDir :: PathComponent -> Path + addDir entry = Path (unPath dir ++ [entry]) diff --git a/src/Hpack/Render.hs b/src/Hpack/Render.hs --- a/src/Hpack/Render.hs +++ b/src/Hpack/Render.hs @@ -65,7 +65,8 @@ packageFields :: [Element] packageFields = addVerbatim packageVerbatim . sortFieldsBy existingFieldOrder $ headerFields ++ [ - Field "extra-source-files" (renderPaths packageExtraSourceFiles) + Field "tested-with" $ CommaSeparatedList packageTestedWith + , Field "extra-source-files" (renderPaths packageExtraSourceFiles) , Field "extra-doc-files" (renderPaths packageExtraDocFiles) , Field "data-files" (renderPaths packageDataFiles) ] ++ maybe [] (return . Field "data-dir" . Literal) packageDataDir @@ -108,7 +109,6 @@ , case packageLicenseFile of [file] -> ("license-file", Just file) files -> ("license-files", formatList files) - , ("tested-with", packageTestedWith) , ("build-type", Just (show packageBuildType)) ] @@ -286,8 +286,14 @@ Nothing -> if_ Just else_ -> Group if_ (Stanza "else" $ renderSection renderSectionData [] [] else_) where - if_ = Stanza ("if " ++ condition) (renderSection renderSectionData [] [] sect) + if_ = Stanza ("if " ++ renderCond condition) (renderSection renderSectionData [] [] sect) +renderCond :: Cond -> String +renderCond = \ case + CondExpression c -> c + CondBool True -> "true" + CondBool False -> "false" + defaultLanguage :: Element defaultLanguage = Field "default-language" "Haskell2010" @@ -296,17 +302,17 @@ where replaceDots = map replaceDot replaceDot xs = case xs of - "." -> "./." + "." -> "./" _ -> xs -renderExposedModules :: [String] -> Element -renderExposedModules = Field "exposed-modules" . LineSeparatedList +renderExposedModules :: [Module] -> Element +renderExposedModules = Field "exposed-modules" . LineSeparatedList . map unModule -renderOtherModules :: [String] -> Element -renderOtherModules = Field "other-modules" . LineSeparatedList +renderOtherModules :: [Module] -> Element +renderOtherModules = Field "other-modules" . LineSeparatedList . map unModule -renderGeneratedModules :: [String] -> Element -renderGeneratedModules = Field "autogen-modules" . LineSeparatedList +renderGeneratedModules :: [Module] -> Element +renderGeneratedModules = Field "autogen-modules" . LineSeparatedList . map unModule renderReexportedModules :: [String] -> Element renderReexportedModules = Field "reexported-modules" . CommaSeparatedList diff --git a/src/Hpack/Render/Hints.hs b/src/Hpack/Render/Hints.hs --- a/src/Hpack/Render/Hints.hs +++ b/src/Hpack/Render/Hints.hs @@ -4,6 +4,7 @@ FormattingHints (..) , sniffFormattingHints #ifdef TEST +, sniffRenderSettings , extractFieldOrder , extractSectionsFieldOrder , sanitize @@ -17,10 +18,11 @@ import Data.Char import Data.Maybe -import Data.List +import Data.List hiding (nub) import Control.Applicative import Hpack.Render.Dsl +import Hpack.Util data FormattingHints = FormattingHints { formattingHintsFieldOrder :: [String] @@ -109,6 +111,8 @@ sniffRenderSettings :: [String] -> RenderSettings sniffRenderSettings input = RenderSettings indentation fieldAlignment commaStyle where - indentation = fromMaybe (renderSettingsIndentation defaultRenderSettings) (sniffIndentation input) + indentation = max def $ fromMaybe def (sniffIndentation input) + where def = renderSettingsIndentation defaultRenderSettings + fieldAlignment = renderSettingsFieldAlignment defaultRenderSettings commaStyle = fromMaybe (renderSettingsCommaStyle defaultRenderSettings) (sniffCommaStyle input) diff --git a/src/Hpack/Syntax/Dependencies.hs b/src/Hpack/Syntax/Dependencies.hs --- a/src/Hpack/Syntax/Dependencies.hs +++ b/src/Hpack/Syntax/Dependencies.hs @@ -50,7 +50,7 @@ data DependencyInfo = DependencyInfo { dependencyInfoMixins :: [String] , dependencyInfoVersion :: DependencyVersion -} deriving (Eq, Show) +} deriving (Eq, Ord, Show) addMixins :: Object -> DependencyVersion -> Parser DependencyInfo addMixins o version = do diff --git a/src/Hpack/Syntax/DependencyVersion.hs b/src/Hpack/Syntax/DependencyVersion.hs --- a/src/Hpack/Syntax/DependencyVersion.hs +++ b/src/Hpack/Syntax/DependencyVersion.hs @@ -48,7 +48,7 @@ type GitRef = String data VersionConstraint = AnyVersion | VersionRange String - deriving (Eq, Show) + deriving (Eq, Ord, Show) instance FromValue VersionConstraint where fromValue = versionConstraint @@ -67,7 +67,7 @@ versionRange = DependencyVersion Nothing . VersionRange data DependencyVersion = DependencyVersion (Maybe SourceDependency) VersionConstraint - deriving (Eq, Show) + deriving (Eq, Ord, Show) withDependencyVersion :: (DependencyVersion -> a) @@ -85,7 +85,7 @@ dependencyVersion = withDependencyVersion id (const return) data SourceDependency = GitRef GitUrl GitRef (Maybe FilePath) | Local FilePath - deriving (Eq, Show) + deriving (Eq, Ord, Show) objectDependency :: Object -> Parser DependencyVersion objectDependency o = let diff --git a/src/Hpack/Util.hs b/src/Hpack/Util.hs --- a/src/Hpack/Util.hs +++ b/src/Hpack/Util.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} module Hpack.Util ( GhcOption , GhcProfOption @@ -7,22 +8,25 @@ , CxxOption , LdOption , parseMain -, toModule -, getModuleFilesRecursive + , tryReadFile , expandGlobs , sort , lexicographically , Hash , sha256 + +, nub +, nubOn ) where import Control.Exception import Control.Monad import Data.Char import Data.Bifunctor -import Data.List hiding (sort) +import Data.List hiding (nub, sort) import Data.Ord +import qualified Data.Set as Set import System.IO.Error import System.Directory import System.FilePath @@ -62,38 +66,6 @@ (ys, "") -> [ys] (ys, _:zs) -> ys : go zs -toModule :: [FilePath] -> Maybe String -toModule path = case reverse path of - [] -> Nothing - x : xs -> do - m <- msum $ map (`stripSuffix` x) [ - ".hs" - , ".lhs" - , ".chs" - , ".hsc" - , ".y" - , ".ly" - , ".x" - ] - let name = reverse (m : xs) - guard (isModule name) >> return (intercalate "." name) - where - stripSuffix :: String -> String -> Maybe String - stripSuffix suffix x = reverse <$> stripPrefix (reverse suffix) (reverse x) - -getModuleFilesRecursive :: FilePath -> IO [[String]] -getModuleFilesRecursive baseDir = go [] - where - go :: [FilePath] -> IO [[FilePath]] - go dir = do - c <- map ((dir ++) . return) . filter (`notElem` [".", ".."]) <$> getDirectoryContents (pathTo dir) - subdirsFiles <- filterM (doesDirectoryExist . pathTo) c >>= mapM go . filter isModule - files <- filterM (doesFileExist . pathTo) c - return (files ++ concat subdirsFiles) - where - pathTo :: [FilePath] -> FilePath - pathTo p = baseDir joinPath p - tryReadFile :: FilePath -> IO (Maybe String) tryReadFile file = do r <- tryJust (guard . isDoesNotExistError) (Utf8.readFile file) @@ -158,3 +130,17 @@ sha256 :: String -> Hash sha256 c = show (hash (Utf8.encodeUtf8 c) :: Digest SHA256) + +nub :: Ord a => [a] -> [a] +nub = nubOn id + +nubOn :: Ord b => (a -> b) -> [a] -> [a] +nubOn f = go mempty + where + go seen = \ case + [] -> [] + a : as + | b `Set.member` seen -> go seen as + | otherwise -> a : go (Set.insert b seen) as + where + b = f a diff --git a/src/Path.hs b/src/Path.hs new file mode 100644 --- /dev/null +++ b/src/Path.hs @@ -0,0 +1,25 @@ +module Path where + +import System.FilePath +import Data.String + +fromFilePath :: FilePath -> Path +fromFilePath = Path . map PathComponent . splitDirectories + +toFilePath :: Path -> FilePath +toFilePath = joinPath . components + +components :: Path -> [String] +components = map unPathComponent . unPath + +newtype Path = Path {unPath :: [PathComponent]} + deriving Eq + +instance Show Path where + show = show . toFilePath + +instance IsString Path where + fromString = fromFilePath + +newtype PathComponent = PathComponent {unPathComponent :: String} + deriving Eq diff --git a/test/EndToEndSpec.hs b/test/EndToEndSpec.hs --- a/test/EndToEndSpec.hs +++ b/test/EndToEndSpec.hs @@ -40,6 +40,28 @@ Paths_foo |] + describe "tested-with" $ do + it "accepts a string" $ do + [i| + tested-with: GHC == 7.0.4 + |] `shouldRenderTo` package [i| + tested-with: + GHC == 7.0.4 + |] + + it "accepts a list" $ do + [i| + tested-with: + - GHC == 7.0.4 + - GHC == 7.2.2 + - GHC == 7.4.2 + |] `shouldRenderTo` package [i| + tested-with: + GHC == 7.0.4 + , GHC == 7.2.2 + , GHC == 7.4.2 + |] + it "warns on duplicate fields" $ do [i| name: foo @@ -48,6 +70,48 @@ "package.yaml: Duplicate field $.name" ] + describe "handling of Paths_ module" $ do + it "adds Paths_ to other-modules" $ do + [i| + library: {} + |] `shouldRenderTo` library [i| + other-modules: + Paths_foo + |] + + context "when Paths_ is mentioned in a conditional that is always false" $ do + it "does not add Paths_" $ do + [i| + library: + when: + - condition: false + other-modules: Paths_foo + |] `shouldRenderTo` library [i| + |] + + context "with RebindableSyntax and OverloadedStrings or OverloadedStrings" $ do + it "infers cabal-version 2.2" $ do + [i| + default-extensions: [RebindableSyntax, OverloadedStrings] + library: {} + |] `shouldRenderTo` (library [i| + default-extensions: RebindableSyntax OverloadedStrings + other-modules: + Paths_foo + |]) {packageCabalVersion = "2.2"} + + context "when Paths_ is mentioned in a conditional that is always false" $ do + it "does not infer cabal-version 2.2" $ do + [i| + default-extensions: [RebindableSyntax, OverloadedStrings] + library: + when: + - condition: false + other-modules: Paths_foo + |] `shouldRenderTo` (library [i| + default-extensions: RebindableSyntax OverloadedStrings + |]) + describe "spec-version" $ do it "accepts spec-version" $ do [i| @@ -922,7 +986,98 @@ Foo |] - context "when inferring modules" $ do + context "with mixins" $ do + it "infers cabal-version 2.0" $ do + [i| + library: + dependencies: + foo: + mixin: + - (Blah as Etc) + |] `shouldRenderTo` (library [i| + other-modules: + Paths_foo + build-depends: + foo + mixins: + foo (Blah as Etc) + |]) {packageCabalVersion = "2.0"} + + describe "internal-libraries" $ do + it "accepts internal-libraries" $ do + touch "src/Foo.hs" + [i| + internal-libraries: + bar: + source-dirs: src + |] `shouldRenderTo` internalLibrary "bar" [i| + exposed-modules: + Foo + other-modules: + Paths_foo + hs-source-dirs: + src + |] + + it "warns on unknown fields" $ do + [i| + name: foo + internal-libraries: + bar: + baz: 42 + |] `shouldWarn` pure "package.yaml: Ignoring unrecognized field $.internal-libraries.bar.baz" + + it "warns on missing source-dirs" $ do + [i| + name: foo + internal-libraries: + bar: + source-dirs: src + |] `shouldWarn` pure "Specified source-dir \"src\" does not exist" + + it "accepts visibility" $ do + [i| + internal-libraries: + bar: + visibility: public + |] `shouldRenderTo` (internalLibrary "bar" [i| + visibility: public + other-modules: + Paths_foo + |]) {packageCabalVersion = "3.0"} + + context "when inferring modules" $ do + context "with a library" $ do + it "ignores duplicate source directories" $ do + touch "src/Foo.hs" + [i| + source-dirs: src + library: + source-dirs: src + |] `shouldRenderTo` library [i| + hs-source-dirs: + src + exposed-modules: + Foo + other-modules: + Paths_foo + |] + + it "ignores duplicate modules" $ do + touch "src/Foo.hs" + touch "src/Foo.x" + [i| + library: + source-dirs: src + |] `shouldRenderTo` library [i| + hs-source-dirs: + src + exposed-modules: + Foo + other-modules: + Paths_foo + |] + context "with exposed-modules" $ do it "infers other-modules" $ do touch "src/Foo.hs" @@ -1123,86 +1278,7 @@ Exposed |]) {packageCabalVersion = "2.0"} - context "mixins" $ do - it "sets cabal-version to 2.0 if mixins are used" $ do - [i| - library: - dependencies: - foo: - mixin: - - (Blah as Etc) - |] `shouldRenderTo` (library [i| - other-modules: - Paths_foo - build-depends: - foo - mixins: - foo (Blah as Etc) - |]) {packageCabalVersion = "2.0"} - - describe "internal-libraries" $ do - it "accepts internal-libraries" $ do - touch "src/Foo.hs" - [i| - internal-libraries: - bar: - source-dirs: src - |] `shouldRenderTo` internalLibrary "bar" [i| - exposed-modules: - Foo - other-modules: - Paths_foo - hs-source-dirs: - src - |] - - it "warns on unknown fields" $ do - [i| - name: foo - internal-libraries: - bar: - baz: 42 - |] `shouldWarn` pure "package.yaml: Ignoring unrecognized field $.internal-libraries.bar.baz" - - it "warns on missing source-dirs" $ do - [i| - name: foo - internal-libraries: - bar: - source-dirs: src - |] `shouldWarn` pure "Specified source-dir \"src\" does not exist" - - it "accepts visibility" $ do - [i| - internal-libraries: - bar: - visibility: public - |] `shouldRenderTo` (internalLibrary "bar" [i| - visibility: public - other-modules: - Paths_foo - |]) {packageCabalVersion = "3.0"} - - describe "executables" $ do - it "accepts arbitrary entry points as main" $ do - touch "src/Foo.hs" - touch "src/Bar.hs" - [i| - executables: - foo: - source-dirs: src - main: Foo - |] `shouldRenderTo` executable "foo" [i| - main-is: Foo.hs - ghc-options: -main-is Foo - hs-source-dirs: - src - other-modules: - Bar - Paths_foo - |] - - context "when inferring modules" $ do + context "with an executable" $ do it "infers other-modules" $ do touch "src/Main.hs" touch "src/Foo.hs" @@ -1256,7 +1332,7 @@ Foo |]) {packageCabalVersion = "2.0"} - context "with conditional" $ do + context "with a conditional" $ do it "doesn't infer any modules mentioned in that conditional" $ do touch "src/Foo.hs" touch "src/Bar.hs" @@ -1301,7 +1377,26 @@ windows |] - context "with conditional" $ do + describe "executables" $ do + it "accepts arbitrary entry points as main" $ do + touch "src/Foo.hs" + touch "src/Bar.hs" + [i| + executables: + foo: + source-dirs: src + main: Foo + |] `shouldRenderTo` executable "foo" [i| + main-is: Foo.hs + ghc-options: -main-is Foo + hs-source-dirs: + src + other-modules: + Bar + Paths_foo + |] + + context "with a conditional" $ do it "does not apply global options" $ do -- related bug: https://github.com/sol/hpack/issues/214 [i| @@ -1380,6 +1475,40 @@ unix |] + context "with empty then-branch" $ do + it "provides a hint" $ do + [i| + when: + condition: os(windows) + then: {} + else: + dependencies: unix + executable: {} + |] `shouldFailWith` unlines [ + "package.yaml: Error while parsing $.when - an empty \"then\" section is not allowed, try the following instead:" + , "" + , "when:" + , " condition: '!(os(windows))'" + , " dependencies: unix" + ] + + context "with empty else-branch" $ do + it "provides a hint" $ do + [i| + when: + condition: os(windows) + then: + dependencies: Win32 + else: {} + executable: {} + |] `shouldFailWith` unlines [ + "package.yaml: Error while parsing $.when - an empty \"else\" section is not allowed, try the following instead:" + , "" + , "when:" + , " condition: os(windows)" + , " dependencies: Win32" + ] + it "rejects invalid conditionals" $ do [i| when: @@ -1407,7 +1536,8 @@ else: when: condition: os(windows) - then: {} + then: + dependencies: foo else: baz: null |] `shouldWarn` [ diff --git a/test/Helper.hs b/test/Helper.hs --- a/test/Helper.hs +++ b/test/Helper.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Helper ( module Test.Hspec , module Test.Mockery.Directory @@ -13,6 +14,7 @@ import Test.Hspec import Test.Mockery.Directory +import Data.String import Control.Monad import Control.Applicative import System.Directory (getCurrentDirectory, setCurrentDirectory, canonicalizePath) @@ -22,6 +24,11 @@ import Data.Yaml.TH (yamlQQ) import Language.Haskell.TH.Quote (QuasiQuoter) + +import Hpack.Config + +instance IsString Cond where + fromString = CondExpression withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory dir action = do diff --git a/test/Hpack/ConfigSpec.hs b/test/Hpack/ConfigSpec.hs --- a/test/Hpack/ConfigSpec.hs +++ b/test/Hpack/ConfigSpec.hs @@ -148,25 +148,6 @@ } renameDependencies "bar" "baz" (sectionWithConditional ["foo", "bar"]) `shouldBe` sectionWithConditional ["foo", "baz"] - describe "getModules" $ around withTempDirectory $ do - it "returns Haskell modules in specified source directory" $ \dir -> do - touch (dir "src/Foo.hs") - touch (dir "src/Bar/Baz.hs") - touch (dir "src/Setup.hs") - getModules dir "src" >>= (`shouldMatchList` ["Foo", "Bar.Baz", "Setup"]) - - context "when source directory is '.'" $ do - it "ignores Setup" $ \dir -> do - touch (dir "Foo.hs") - touch (dir "Setup.hs") - getModules dir "." `shouldReturn` ["Foo"] - - context "when source directory is './.'" $ do - it "ignores Setup" $ \dir -> do - touch (dir "Foo.hs") - touch (dir "Setup.hs") - getModules dir "./." `shouldReturn` ["Foo"] - describe "toBuildTool" $ do let toBuildTool_ name = runWriter $ toBuildTool "my-package" ["foo"] (name, anyVersion) context "with an UnqualifiedBuildTool" $ do @@ -662,17 +643,17 @@ it "accepts Strings" $ do [yaml| os(windows) - |] `shouldDecodeTo_` Cond "os(windows)" + |] `shouldDecodeTo_` CondExpression "os(windows)" it "accepts True" $ do [yaml| yes - |] `shouldDecodeTo_` Cond "true" + |] `shouldDecodeTo_` CondBool True it "accepts False" $ do [yaml| no - |] `shouldDecodeTo_` Cond "false" + |] `shouldDecodeTo_` CondBool False it "rejects other values" $ do [yaml| diff --git a/test/Hpack/ModuleSpec.hs b/test/Hpack/ModuleSpec.hs new file mode 100644 --- /dev/null +++ b/test/Hpack/ModuleSpec.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE OverloadedStrings #-} +module Hpack.ModuleSpec (spec) where + +import Helper + +import Hpack.Module + +spec :: Spec +spec = do + describe "getModules" $ around withTempDirectory $ do + it "returns Haskell modules in specified source directory" $ \dir -> do + touch (dir "src/Foo.hs") + touch (dir "src/Bar/Baz.hs") + touch (dir "src/Setup.hs") + getModules dir "src" >>= (`shouldMatchList` ["Foo", "Bar.Baz", "Setup"]) + + context "when source directory is '.'" $ do + it "ignores Setup" $ \dir -> do + touch (dir "Foo.hs") + touch (dir "Setup.hs") + getModules dir "." `shouldReturn` ["Foo"] + + context "when source directory is './.'" $ do + it "ignores Setup" $ \dir -> do + touch (dir "Foo.hs") + touch (dir "Setup.hs") + getModules dir "./." `shouldReturn` ["Foo"] + + describe "toModule" $ do + it "maps a Path to a Module" $ do + toModule "Foo/Bar/Baz.hs" `shouldBe` "Foo.Bar.Baz" + + describe "getModuleFilesRecursive" $ do + it "gets all Haskell source files from given directory" $ do + inTempDirectory $ do + touch "foo/Bar.hs" + touch "foo/Baz.chs" + actual <- getModuleFilesRecursive "foo" + actual `shouldMatchList` [ + "Bar.hs" + , "Baz.chs" + ] + + it "ignores other files" $ do + inTempDirectory $ do + touch "foo/Bar.js" + getModuleFilesRecursive "foo" `shouldReturn` [] + + it "descends into subdirectories" $ do + inTempDirectory $ do + touch "foo/Bar/Baz.hs" + getModuleFilesRecursive "foo" `shouldReturn` ["Bar/Baz.hs"] + + context "when a subdirectory is not a valid module name" $ do + it "does not descend" $ do + inTempDirectory $ do + touch "foo/bar/Baz.hs" + getModuleFilesRecursive "foo" `shouldReturn` empty diff --git a/test/Hpack/Render/HintsSpec.hs b/test/Hpack/Render/HintsSpec.hs --- a/test/Hpack/Render/HintsSpec.hs +++ b/test/Hpack/Render/HintsSpec.hs @@ -7,6 +7,17 @@ spec :: Spec spec = do + describe "sniffRenderSettings" $ do + context "when sniffed indentation is < default" $ do + it "uses default instead" $ do + let input = [ + "library" + , "exposed-modules:" + , " Foo" + ] + sniffIndentation input `shouldBe` Just 0 + renderSettingsIndentation (sniffRenderSettings input) `shouldBe` 2 + describe "extractFieldOrder" $ do it "extracts field order hints" $ do let input = [ @@ -109,7 +120,7 @@ splitField "foo bar" `shouldBe` Nothing describe "sniffIndentation" $ do - it "sniff alignment from executable section" $ do + it "sniffs indentation from executable section" $ do let input = [ "name: foo" , "version: 0.0.0" @@ -119,7 +130,7 @@ ] sniffIndentation input `shouldBe` Just 4 - it "sniff alignment from library section" $ do + it "sniffs indentation from library section" $ do let input = [ "name: foo" , "version: 0.0.0" diff --git a/test/Hpack/RenderSpec.hs b/test/Hpack/RenderSpec.hs --- a/test/Hpack/RenderSpec.hs +++ b/test/Hpack/RenderSpec.hs @@ -342,7 +342,7 @@ (render defaultRenderSettings 0 $ renderDirectories "name" ["."]) `shouldBe` [ "name:" - , " ./." + , " ./" ] describe "renderDependencies" $ do diff --git a/test/Hpack/UtilSpec.hs b/test/Hpack/UtilSpec.hs --- a/test/Hpack/UtilSpec.hs +++ b/test/Hpack/UtilSpec.hs @@ -30,41 +30,6 @@ it "accepts qualified identifier" $ do parseMain "Foo.bar" `shouldBe` ("Foo.hs", ["-main-is Foo.bar"]) - describe "toModule" $ do - it "maps .hs paths to module names" $ do - toModule ["Foo", "Bar", "Baz.hs"] `shouldBe` Just "Foo.Bar.Baz" - - it "maps .lhs paths to module names" $ do - toModule ["Foo", "Bar", "Baz.lhs"] `shouldBe` Just "Foo.Bar.Baz" - - it "maps .hsc paths to module names" $ do - toModule ["Foo", "Bar", "Baz.hsc"] `shouldBe` Just "Foo.Bar.Baz" - - it "rejects invalid module names" $ do - toModule ["resources", "hello.hs"] `shouldBe` Nothing - - describe "getModuleFilesRecursive" $ do - it "gets all files from given directory" $ do - inTempDirectory $ do - touch "foo/bar" - touch "foo/baz" - actual <- getModuleFilesRecursive "foo" - actual `shouldMatchList` [ - ["bar"] - , ["baz"] - ] - - it "descends into subdirectories" $ do - inTempDirectory $ do - touch "foo/Bar/baz" - getModuleFilesRecursive "foo" `shouldReturn` [["Bar", "baz"]] - - context "when a subdirectory is not a valid module name" $ do - it "does not descend" $ do - inTempDirectory $ do - touch "foo/bar/baz" - getModuleFilesRecursive "foo" `shouldReturn` empty - describe "tryReadFile" $ do it "reads file" $ do inTempDirectory $ do