diff --git a/hpack.cabal b/hpack.cabal --- a/hpack.cabal +++ b/hpack.cabal @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.4.0. +-- This file has been generated from package.yaml by hpack version 0.5.1. -- -- see: https://github.com/sol/hpack name: hpack -version: 0.5.0 +version: 0.5.1 synopsis: An alternative format for Haskell packages homepage: https://github.com/sol/hpack#readme bug-reports: https://github.com/sol/hpack/issues @@ -19,11 +19,6 @@ library hs-source-dirs: src - exposed-modules: - Hpack.Config - Hpack.Run - other-modules: - Hpack.Util build-depends: aeson >= 0.8 , base >= 4.7 && < 5 @@ -36,11 +31,16 @@ , unordered-containers , yaml ghc-options: -Wall + exposed-modules: + Hpack.Config + Hpack.Run + other-modules: + Hpack.Util default-language: Haskell2010 executable hpack - hs-source-dirs: driver main-is: Main.hs + hs-source-dirs: driver build-depends: aeson >= 0.8 , base >= 4.7 && < 5 @@ -52,23 +52,14 @@ , text , unordered-containers , yaml - , hpack ghc-options: -Wall default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 - hs-source-dirs: test, src main-is: Spec.hs - other-modules: - Helper - Hpack.ConfigSpec - Hpack.RunSpec - Hpack.UtilSpec - Hpack.Config - Hpack.Run - Hpack.Util + hs-source-dirs: test, src build-depends: aeson >= 0.8 , base >= 4.7 && < 5 @@ -80,10 +71,17 @@ , text , unordered-containers , yaml - , hspec == 2.* , mockery >= 0.3 , interpolate , aeson-qq ghc-options: -Wall + other-modules: + Helper + Hpack.ConfigSpec + Hpack.RunSpec + Hpack.UtilSpec + Hpack.Config + Hpack.Run + Hpack.Util 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 @@ -29,7 +29,8 @@ import Data.Data import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as Map -import Data.List (nub, sort, (\\)) +import Data.Ord +import Data.List (nub, (\\), sortBy) import Data.Maybe import Data.String import Data.Text (Text) @@ -101,15 +102,6 @@ instance FromJSON ExecutableSection where parseJSON = genericParseJSON_ -data WithCommonOptions a = WithCommonOptions a CommonOptions - deriving (Eq, Show, Generic, Data, Typeable) - -instance HasFieldNames a => HasFieldNames (WithCommonOptions a) where - fieldNames (WithCommonOptions a options) = (fieldNames a ++ fieldNames options) \\ ["config"] -- FIXME : test for removing "config" - -instance FromJSON a => FromJSON (WithCommonOptions a) where - parseJSON v = WithCommonOptions <$> parseJSON v <*> parseJSON v - data CommonOptions = CommonOptions { commonOptionsSourceDirs :: Maybe (List FilePath) , commonOptionsDependencies :: Maybe (List Dependency) @@ -137,19 +129,20 @@ , packageConfigCopyright :: Maybe (List String) , packageConfigLicense :: Maybe String , packageConfigExtraSourceFiles :: Maybe (List FilePath) +, packageConfigDataFiles :: Maybe (List FilePath) , packageConfigGithub :: Maybe Text -, packageConfigLibrary :: Maybe (CaptureUnknownFields (WithCommonOptions LibrarySection)) -, packageConfigExecutables :: Maybe (HashMap String (CaptureUnknownFields (WithCommonOptions ExecutableSection))) -, packageConfigTests :: Maybe (HashMap String (CaptureUnknownFields (WithCommonOptions ExecutableSection))) +, packageConfigLibrary :: Maybe (CaptureUnknownFields (Section LibrarySection)) +, packageConfigExecutables :: Maybe (HashMap String (CaptureUnknownFields (Section ExecutableSection))) +, packageConfigTests :: Maybe (HashMap String (CaptureUnknownFields (Section ExecutableSection))) } deriving (Eq, Show, Generic, Data, Typeable) instance HasFieldNames PackageConfig packageDependencies :: Package -> [Dependency] -packageDependencies Package{..} = nub . sort $ - (concat $ concatMap sectionDependencies packageExecutables) - ++ (concat $ concatMap sectionDependencies packageTests) - ++ maybe [] (concat . sectionDependencies) packageLibrary +packageDependencies Package{..} = nub . sortBy (comparing (lexicographically . dependencyName)) $ + (concatMap sectionDependencies packageExecutables) + ++ (concatMap sectionDependencies packageTests) + ++ maybe [] sectionDependencies packageLibrary instance FromJSON PackageConfig where parseJSON value = handleNullValues <$> genericParseJSON_ value @@ -237,6 +230,7 @@ , packageLicense :: Maybe String , packageLicenseFile :: Maybe FilePath , packageExtraSourceFiles :: [FilePath] +, packageDataFiles :: [FilePath] , packageSourceRepository :: Maybe SourceRepository , packageLibrary :: Maybe (Section Library) , packageExecutables :: [Section Executable] @@ -257,19 +251,28 @@ data Section a = Section { sectionData :: a , sectionSourceDirs :: [FilePath] -, sectionDependencies :: [[Dependency]] +, sectionDependencies :: [Dependency] , sectionDefaultExtensions :: [String] , sectionGhcOptions :: [GhcOption] , sectionCppOptions :: [CppOption] -} deriving (Eq, Show, Functor, Foldable, Traversable) +} deriving (Eq, Show, Functor, Foldable, Traversable, Data, Typeable) +instance HasFieldNames a => HasFieldNames (Section a) where + fieldNames section = (fieldNames (sectionData section) ++ fieldNames proxy) \\ ["config"] -- FIXME : test for removing "config" + where + proxy :: CommonOptions + proxy = CommonOptions Nothing Nothing Nothing Nothing Nothing + +instance FromJSON a => FromJSON (Section a) where + parseJSON v = toSection <$> parseJSON v <*> parseJSON v + data SourceRepository = SourceRepository { sourceRepositoryUrl :: String , sourceRepositorySubdir :: Maybe String } deriving (Eq, Show) -mkPackage :: (CaptureUnknownFields (WithCommonOptions PackageConfig)) -> IO ([String], Package) -mkPackage (CaptureUnknownFields unknownFields (WithCommonOptions PackageConfig{..} globalOptions@CommonOptions{..})) = do +mkPackage :: (CaptureUnknownFields (Section PackageConfig)) -> IO ([String], Package) +mkPackage (CaptureUnknownFields unknownFields globalOptions@Section{sectionData = PackageConfig{..}}) = do mLibrary <- mapM (toLibrary globalOptions) mLibrarySection executables <- toExecutables globalOptions (map (fmap captureUnknownFieldsValue) executableSections) tests <- toExecutables globalOptions (map (fmap captureUnknownFieldsValue) testsSections) @@ -287,6 +290,9 @@ (extraSourceFilesWarnings, extraSourceFiles) <- expandGlobs (fromMaybeList packageConfigExtraSourceFiles) + (dataFilesWarnings, dataFiles) <- + expandGlobs (fromMaybeList packageConfigDataFiles) + let package = Package { packageName = name , packageVersion = fromMaybe "0.0.0" packageConfigVersion @@ -302,6 +308,7 @@ , packageLicense = packageConfigLicense , packageLicenseFile = guard licenseFileExists >> Just "LICENSE" , packageExtraSourceFiles = extraSourceFiles + , packageDataFiles = dataFiles , packageSourceRepository = sourceRepository , packageLibrary = mLibrary , packageExecutables = executables @@ -315,19 +322,20 @@ ++ formatUnknownSectionFields "test" testsSections ++ formatMissingSourceDirs missingSourceDirs ++ extraSourceFilesWarnings + ++ dataFilesWarnings return (warnings, package) where - executableSections :: [(String, CaptureUnknownFields (WithCommonOptions ExecutableSection))] + executableSections :: [(String, CaptureUnknownFields (Section ExecutableSection))] executableSections = toList packageConfigExecutables - testsSections :: [(String, CaptureUnknownFields (WithCommonOptions ExecutableSection))] + testsSections :: [(String, CaptureUnknownFields (Section ExecutableSection))] testsSections = toList packageConfigTests toList :: Maybe (HashMap String a) -> [(String, a)] toList = Map.toList . fromMaybe mempty - mLibrarySection :: Maybe (WithCommonOptions LibrarySection) + mLibrarySection :: Maybe (Section LibrarySection) mLibrarySection = captureUnknownFieldsValue <$> packageConfigLibrary formatUnknownFields :: String -> [String] -> [String] @@ -368,11 +376,11 @@ where fromGithub = (++ "/issues") . sourceRepositoryUrl <$> sourceRepository -toLibrary :: CommonOptions -> WithCommonOptions LibrarySection -> IO (Section Library) +toLibrary :: Section global -> Section LibrarySection -> IO (Section Library) toLibrary globalOptions library = traverse fromLibrarySection section where section :: Section LibrarySection - section = toSection globalOptions library + section = mergeSections globalOptions library sourceDirs :: [FilePath] sourceDirs = sectionSourceDirs section @@ -383,11 +391,11 @@ let (exposedModules, otherModules) = determineModules modules librarySectionExposedModules librarySectionOtherModules return (Library exposedModules otherModules) -toExecutables :: CommonOptions -> [(String, WithCommonOptions ExecutableSection)] -> IO [Section Executable] +toExecutables :: Section global -> [(String, Section ExecutableSection)] -> IO [Section Executable] toExecutables globalOptions executables = mapM toExecutable sections where sections :: [(String, Section ExecutableSection)] - sections = map (fmap $ toSection globalOptions) executables + sections = map (fmap $ mergeSections globalOptions) executables toExecutable :: (String, Section ExecutableSection) -> IO (Section Executable) toExecutable (name, section) = traverse fromExecutableSection section @@ -403,18 +411,28 @@ filterMain :: [String] -> [String] filterMain = maybe id (filter . (/=)) (toModule $ splitDirectories executableSectionMain) -toSection :: CommonOptions -> WithCommonOptions a -> Section a -toSection globalOptions (WithCommonOptions a options) +mergeSections :: Section global -> Section a -> Section a +mergeSections globalOptions options = Section a sourceDirs dependencies defaultExtensions ghcOptions cppOptions where - sourceDirs = merge commonOptionsSourceDirs - defaultExtensions = merge commonOptionsDefaultExtensions - ghcOptions = merge commonOptionsGhcOptions - cppOptions = merge commonOptionsCppOptions - merge selector = fromMaybeList (selector globalOptions) ++ fromMaybeList (selector options) - getDependencies = fromMaybeList . commonOptionsDependencies - dependencies = filter (not . null) [getDependencies globalOptions, getDependencies options] + a = sectionData options + sourceDirs = sectionSourceDirs globalOptions ++ sectionSourceDirs options + defaultExtensions = sectionDefaultExtensions globalOptions ++ sectionDefaultExtensions options + ghcOptions = sectionGhcOptions globalOptions ++ sectionGhcOptions options + cppOptions = sectionCppOptions globalOptions ++ sectionCppOptions options + getDependencies = sectionDependencies + dependencies = getDependencies globalOptions ++ getDependencies options +toSection :: a -> CommonOptions -> Section a +toSection a CommonOptions{..} + = Section a sourceDirs dependencies defaultExtensions ghcOptions cppOptions + where + sourceDirs = fromMaybeList commonOptionsSourceDirs + defaultExtensions = fromMaybeList commonOptionsDefaultExtensions + ghcOptions = fromMaybeList commonOptionsGhcOptions + cppOptions = fromMaybeList commonOptionsCppOptions + dependencies = fromMaybeList commonOptionsDependencies + determineModules :: [String] -> Maybe (List String) -> Maybe (List String) -> ([String], [String]) determineModules modules mExposedModules mOtherModules = case (mExposedModules, mOtherModules) of (Nothing, Nothing) -> (modules, []) @@ -424,7 +442,7 @@ exposedModules = maybe (modules \\ otherModules) fromList mExposedModules getModules :: FilePath -> IO [String] -getModules src = do +getModules src = sort <$> do exits <- doesDirectoryExist src if exits then toModules <$> getFilesRecursive src diff --git a/src/Hpack/Run.hs b/src/Hpack/Run.hs --- a/src/Hpack/Run.hs +++ b/src/Hpack/Run.hs @@ -42,6 +42,7 @@ sections = catMaybes [ header , extraSourceFiles + , dataFiles , sourceRepository , library ] ++ renderExecutables packageExecutables ++ renderTests packageTests @@ -49,6 +50,7 @@ header = Just (unlines $ map formatField sortedFields) extraSourceFiles = guard (not . null $ packageExtraSourceFiles) >> Just (unlines $ "extra-source-files:" : map (" " ++) packageExtraSourceFiles) + dataFiles = guard (not . null $ packageDataFiles) >> Just (unlines $ "data-files:" : map (" " ++) packageDataFiles) sourceRepository = renderSourceRepository <$> packageSourceRepository @@ -149,22 +151,24 @@ renderExecutableSection section@(sectionData -> Executable{..}) = " main-is: " ++ executableMain ++ "\n" ++ renderSection section + ++ renderOtherModules executableOtherModules + ++ " default-language: Haskell2010\n" renderLibrary :: Section Library -> String renderLibrary section@(sectionData -> Library{..}) = "library\n" + ++ renderSection section ++ renderExposedModules libraryExposedModules ++ renderOtherModules libraryOtherModules - ++ renderSection section + ++ " default-language: Haskell2010\n" renderSection :: Section a -> String renderSection Section{..} = renderSourceDirs sectionSourceDirs - ++ renderDependencies sectionDependencies + ++ unlines (renderDependencies sectionDependencies) ++ renderDefaultExtensions sectionDefaultExtensions ++ renderGhcOptions sectionGhcOptions ++ renderCppOptions sectionCppOptions - ++ " default-language: Haskell2010\n" renderSourceDirs :: [String] -> String renderSourceDirs dirs @@ -181,14 +185,15 @@ | null modules = "" | otherwise = " other-modules:\n" ++ (unlines $ map (" " ++) modules) -renderDependencies :: [[Dependency]] -> String +renderDependencies :: [Dependency] -> [String] renderDependencies dependencies - | null dependencies = "" - | otherwise = concatMap render $ zip (True : repeat False) (map (map dependencyName) dependencies) + | null dependencies = [] + | otherwise = " build-depends:" : map render (zip (True : repeat False) dependencies) where - render (isFirst, xs) - | isFirst = " build-depends:\n " ++ intercalate "\n , " xs ++ "\n" - | otherwise = "\n , " ++ intercalate "\n , " xs ++ "\n" + render :: (Bool, Dependency) -> String + render (isFirst, dependency) + | isFirst = " " ++ dependencyName dependency + | otherwise = " , " ++ dependencyName dependency renderGhcOptions :: [GhcOption] -> String renderGhcOptions = renderOptions "ghc-options" diff --git a/src/Hpack/Util.hs b/src/Hpack/Util.hs --- a/src/Hpack/Util.hs +++ b/src/Hpack/Util.hs @@ -7,25 +7,33 @@ , sniffAlignment , extractFieldOrderHint , expandGlobs +, sort +, lexicographically -- exported for testing , splitField ) where import Control.Applicative -import Control.Monad -import Control.Exception import Control.DeepSeq +import Control.Exception +import Control.Monad +import Data.Aeson.Types import Data.Char +import Data.Data +import Data.List hiding (sort) import Data.Maybe -import Data.List +import Data.Ord import System.Directory import System.FilePath import System.FilePath.Glob -import Data.Data -import Data.Aeson.Types +sort :: [String] -> [String] +sort = sortBy (comparing lexicographically) +lexicographically :: String -> (String, String) +lexicographically x = (map toLower x, x) + newtype List a = List {fromList :: [a]} deriving (Eq, Show, Data, Typeable) @@ -51,8 +59,8 @@ isValidModuleChar :: Char -> Bool isValidModuleChar c = isAlphaNum c || c == '_' || c == '\'' -getFilesRecursive :: FilePath -> IO [[FilePath]] -getFilesRecursive baseDir = sort <$> go [] +getFilesRecursive :: FilePath -> IO [[String]] +getFilesRecursive baseDir = go [] where go :: [FilePath] -> IO [[FilePath]] go dir = do diff --git a/test/Hpack/ConfigSpec.hs b/test/Hpack/ConfigSpec.hs --- a/test/Hpack/ConfigSpec.hs +++ b/test/Hpack/ConfigSpec.hs @@ -19,7 +19,7 @@ import Hpack.Config package :: Package -package = Package "foo" "0.0.0" Nothing Nothing Nothing Nothing Nothing Nothing [] [] [] Nothing Nothing [] Nothing Nothing [] [] +package = Package "foo" "0.0.0" Nothing Nothing Nothing Nothing Nothing Nothing [] [] [] Nothing Nothing [] [] Nothing Nothing [] [] executable :: String -> String -> Executable executable name main_ = Executable name main_ [] @@ -224,6 +224,16 @@ Right (_, c) <- readPackageConfig "package.yaml" packageExtraSourceFiles c `shouldBe` ["CHANGES.markdown", "README.markdown"] + it "accepts data-files" $ do + writeFile "package.yaml" [i| + data-files: + - data/**/*.html + |] + touch "data/foo/index.html" + touch "data/bar/index.html" + Right (_, c) <- readPackageConfig "package.yaml" + packageDataFiles c `shouldMatchList` ["data/foo/index.html", "data/bar/index.html"] + it "accepts github" $ do writeFile "package.yaml" [i| github: hspec/hspec @@ -512,7 +522,7 @@ dependencies: hspec |] Right (_, c) <- readPackageConfig "package.yaml" - c `shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = [["hspec"]]}]} + c `shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = ["hspec"]}]} it "accepts list of dependencies" $ do writeFile "package.yaml" [i| @@ -524,7 +534,7 @@ - QuickCheck |] Right (_, c) <- readPackageConfig "package.yaml" - c `shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = [["hspec", "QuickCheck"]]}]} + c `shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = ["hspec", "QuickCheck"]}]} context "when both global and section specific dependencies are specified" $ do it "combines dependencies" $ do @@ -538,7 +548,7 @@ dependencies: hspec |] Right (_, c) <- readPackageConfig "package.yaml" - c `shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = [["base"], ["hspec"]]}]} + c `shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = ["base", "hspec"]}]} context "when a specified source directory does not exist" $ do it "warns" $ do diff --git a/test/Hpack/RunSpec.hs b/test/Hpack/RunSpec.hs --- a/test/Hpack/RunSpec.hs +++ b/test/Hpack/RunSpec.hs @@ -108,7 +108,7 @@ context "when rendering executable section" $ do it "includes dependencies" $ do - renderPackage 0 [] package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionDependencies = [["foo", "bar"], ["foo", "baz"]]}]} `shouldBe` unlines [ + renderPackage 0 [] package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionDependencies = ["foo", "bar", "foo", "baz"]}]} `shouldBe` unlines [ "name: foo" , "version: 0.0.0" , "build-type: Simple" @@ -119,7 +119,6 @@ , " build-depends:" , " foo" , " , bar" - , "" , " , foo" , " , baz" , " default-language: Haskell2010" diff --git a/test/Hpack/UtilSpec.hs b/test/Hpack/UtilSpec.hs --- a/test/Hpack/UtilSpec.hs +++ b/test/Hpack/UtilSpec.hs @@ -3,7 +3,6 @@ import Helper import Data.Aeson -import Data.List import System.Directory import Hpack.Util @@ -13,6 +12,10 @@ spec :: Spec spec = do + describe "sort" $ do + it "sorts lexicographically" $ do + sort ["foo", "Foo"] `shouldBe` ["Foo", "foo" :: String] + describe "toModule" $ do it "maps paths to module names" $ do toModule ["Foo", "Bar", "Baz.hs"] `shouldBe` Just "Foo.Bar.Baz" @@ -26,7 +29,8 @@ touch "foo/bar" touch "foo/baz" touch "foo/foobar/baz" - getFilesRecursive "foo" `shouldReturn` [ + actual <- getFilesRecursive "foo" + actual `shouldMatchList` [ ["bar"] , ["baz"] , ["foobar", "baz"]