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.9.0. +-- This file has been generated from package.yaml by hpack version 0.9.1. -- -- see: https://github.com/sol/hpack name: hpack -version: 0.9.1 +version: 0.10.0 synopsis: An alternative format for Haskell packages category: Development homepage: https://github.com/sol/hpack#readme diff --git a/src/Hpack.hs b/src/Hpack.hs --- a/src/Hpack.hs +++ b/src/Hpack.hs @@ -41,15 +41,20 @@ args <- getArgs case args of ["--version"] -> putStrLn programVersion + ["--help"] -> printHelp _ -> case parseVerbosity args of (verbose, [dir]) -> hpack dir verbose (verbose, []) -> hpack "." verbose _ -> do - hPutStrLn stderr $ unlines [ - "Usage: hpack [ --silent ] [ dir ]" - , " hpack --version" - ] + printHelp exitFailure + +printHelp :: IO () +printHelp = do + hPutStrLn stderr $ unlines [ + "Usage: hpack [ --silent ] [ dir ]" + , " hpack --version" + ] parseVerbosity :: [String] -> (Bool, [String]) parseVerbosity xs = (verbose, ys) diff --git a/src/Hpack/Config.hs b/src/Hpack/Config.hs --- a/src/Hpack/Config.hs +++ b/src/Hpack/Config.hs @@ -4,6 +4,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -23,8 +24,11 @@ , Section(..) , Library(..) , Executable(..) +, Condition(..) , SourceRepository(..) #ifdef TEST +, HasFieldNames(..) +, CaptureUnknownFields(..) , getModules , determineModules #endif @@ -56,7 +60,7 @@ package name version = Package name version Nothing Nothing Nothing Nothing Nothing Nothing [] [] [] Nothing Nothing Nothing [] [] Nothing Nothing [] [] [] section :: a -> Section a -section a = Section a [] [] [] [] [] [] [] +section a = Section a [] [] [] [] [] [] [] [] packageConfig :: FilePath packageConfig = "package.yaml" @@ -79,31 +83,39 @@ #endif '-' . drop (length name) +type FieldName = String + class HasFieldNames a where - fieldNames :: Proxy a -> [String] + fieldNames :: Proxy a -> [FieldName] default fieldNames :: (HasTypeName a, Generic a, Selectors (Rep a)) => Proxy a -> [String] fieldNames proxy = map (hyphenize $ typeName proxy) (selectors proxy) data CaptureUnknownFields a = CaptureUnknownFields { - captureUnknownFieldsFields :: [String] + captureUnknownFieldsFields :: [FieldName] , captureUnknownFieldsValue :: a } deriving (Eq, Show, Generic) -instance (HasFieldNames a, FromJSON a) => FromJSON (CaptureUnknownFields a) where - parseJSON v = captureUnknownFields <$> parseJSON v +instance (HasFieldNames a, FromJSON a) => FromJSON (CaptureUnknownFields (Section a)) where + parseJSON v = do + (unknownFields, sect) <- toSection <$> parseJSON v <*> parseJSON v + return (CaptureUnknownFields (unknownSectionFields ++ unknownFields) sect) where - captureUnknownFields a = case v of - Object o -> CaptureUnknownFields unknown a - where - unknown = keys \\ fields - keys = map T.unpack (Map.keys o) - fields = fieldNames (Proxy :: Proxy a) - _ -> CaptureUnknownFields [] a + unknownSectionFields = getUnknownFields v (Proxy :: Proxy (Section a)) +getUnknownFields :: forall a. HasFieldNames a => Value -> Proxy a -> [FieldName] +getUnknownFields v _ = case v of + Object o -> unknown + where + unknown = keys \\ fields + keys = map T.unpack (Map.keys o) + fields = fieldNames (Proxy :: Proxy a) + _ -> [] + data LibrarySection = LibrarySection { librarySectionExposedModules :: Maybe (List String) , librarySectionOtherModules :: Maybe (List String) +, librarySectionReexportedModules :: Maybe (List String) } deriving (Eq, Show, Generic) instance HasFieldNames LibrarySection @@ -129,6 +141,7 @@ , commonOptionsGhcOptions :: Maybe (List GhcOption) , commonOptionsGhcProfOptions :: Maybe (List GhcProfOption) , commonOptionsCppOptions :: Maybe (List CppOption) +, commonOptionsWhen :: Maybe (List (CaptureUnknownFields (Section Condition))) } deriving (Eq, Show, Generic) instance HasFieldNames CommonOptions @@ -136,6 +149,15 @@ instance FromJSON CommonOptions where parseJSON = genericParseJSON_ +newtype Condition = Condition { + conditionCondition :: String +} deriving (Eq, Show, Generic) + +instance FromJSON Condition where + parseJSON = genericParseJSON_ + +instance HasFieldNames Condition + data PackageConfig = PackageConfig { packageConfigName :: Maybe String , packageConfigVersion :: Maybe String @@ -149,6 +171,7 @@ , packageConfigMaintainer :: Maybe (List String) , packageConfigCopyright :: Maybe (List String) , packageConfigLicense :: Maybe String +, packageConfigLicenseFile :: Maybe String , packageConfigTestedWith :: Maybe String , packageConfigExtraSourceFiles :: Maybe (List FilePath) , packageConfigDataFiles :: Maybe (List FilePath) @@ -264,6 +287,7 @@ data Library = Library { libraryExposedModules :: [String] , libraryOtherModules :: [String] +, libraryReexportedModules :: [String] } deriving (Eq, Show) data Executable = Executable { @@ -281,14 +305,12 @@ , sectionGhcOptions :: [GhcOption] , sectionGhcProfOptions :: [GhcProfOption] , sectionCppOptions :: [CppOption] +, sectionConditionals :: [Section Condition] } deriving (Eq, Show, Functor, Foldable, Traversable) instance HasFieldNames a => HasFieldNames (Section a) where fieldNames Proxy = fieldNames (Proxy :: Proxy a) ++ fieldNames (Proxy :: Proxy CommonOptions) -instance FromJSON a => FromJSON (Section a) where - parseJSON v = toSection <$> parseJSON v <*> parseJSON v - data SourceRepository = SourceRepository { sourceRepositoryUrl :: String , sourceRepositorySubdir :: Maybe String @@ -331,7 +353,7 @@ , packageMaintainer = fromMaybeList packageConfigMaintainer , packageCopyright = fromMaybeList packageConfigCopyright , packageLicense = packageConfigLicense - , packageLicenseFile = guard licenseFileExists >> Just "LICENSE" + , packageLicenseFile = packageConfigLicenseFile <|> (guard licenseFileExists >> Just "LICENSE") , packageTestedWith = packageConfigTestedWith , packageExtraSourceFiles = extraSourceFiles , packageDataFiles = dataFiles @@ -368,7 +390,7 @@ mLibrarySection :: Maybe (Section LibrarySection) mLibrarySection = captureUnknownFieldsValue <$> packageConfigLibrary - formatUnknownFields :: String -> [String] -> [String] + formatUnknownFields :: String -> [FieldName] -> [String] formatUnknownFields name = map f . sort where f field = "Ignoring unknown field " ++ show field ++ " in " ++ name @@ -419,7 +441,8 @@ fromLibrarySection LibrarySection{..} = do modules <- concat <$> mapM (getModules dir) sourceDirs let (exposedModules, otherModules) = determineModules name modules librarySectionExposedModules librarySectionOtherModules - return (Library exposedModules otherModules) + reexportedModules = fromMaybeList librarySectionReexportedModules + return (Library exposedModules otherModules reexportedModules) toExecutables :: FilePath -> Section global -> [(String, Section ExecutableSection)] -> IO [Section Executable] toExecutables dir globalOptions executables = mapM toExecutable sections @@ -444,7 +467,7 @@ mergeSections :: Section global -> Section a -> Section a mergeSections globalOptions options - = Section a sourceDirs dependencies defaultExtensions otherExtensions ghcOptions ghcProfOptions cppOptions + = Section a sourceDirs dependencies defaultExtensions otherExtensions ghcOptions ghcProfOptions cppOptions conditionals where a = sectionData options sourceDirs = sectionSourceDirs globalOptions ++ sectionSourceDirs options @@ -454,10 +477,11 @@ ghcProfOptions = sectionGhcProfOptions globalOptions ++ sectionGhcProfOptions options cppOptions = sectionCppOptions globalOptions ++ sectionCppOptions options dependencies = sectionDependencies globalOptions ++ sectionDependencies options + conditionals = sectionConditionals globalOptions ++ sectionConditionals options -toSection :: a -> CommonOptions -> Section a +toSection :: a -> CommonOptions -> ([FieldName], Section a) toSection a CommonOptions{..} - = Section a sourceDirs dependencies defaultExtensions otherExtensions ghcOptions ghcProfOptions cppOptions + = (concat unknownFields, Section a sourceDirs dependencies defaultExtensions otherExtensions ghcOptions ghcProfOptions cppOptions conditionals) where sourceDirs = fromMaybeList commonOptionsSourceDirs defaultExtensions = fromMaybeList commonOptionsDefaultExtensions @@ -466,6 +490,8 @@ ghcProfOptions = fromMaybeList commonOptionsGhcProfOptions cppOptions = fromMaybeList commonOptionsCppOptions dependencies = fromMaybeList commonOptionsDependencies + (unknownFields, conditionals) = + unzip [(field, value) | CaptureUnknownFields field value <- fromMaybeList commonOptionsWhen] pathsModuleFromPackageName :: String -> String pathsModuleFromPackageName name = "Paths_" ++ map f name diff --git a/src/Hpack/Run.hs b/src/Hpack/Run.hs --- a/src/Hpack/Run.hs +++ b/src/Hpack/Run.hs @@ -10,6 +10,7 @@ , CommaStyle(..) , defaultRenderSettings #ifdef TEST +, renderConditional , renderSourceRepository , formatDescription #endif @@ -112,7 +113,7 @@ , ("license-file", packageLicenseFile) , ("tested-with", packageTestedWith) , ("build-type", Just "Simple") - , ("cabal-version", Just ">= 1.10") + , ("cabal-version", cabalVersion) ] formatList :: [String] -> Maybe String @@ -123,6 +124,18 @@ defaultFieldOrder :: [String] defaultFieldOrder = map fst fields + cabalVersion :: Maybe String + cabalVersion = maximum [ + Just ">= 1.10" + , packageLibrary >>= libCabalVersion + ] + where + libCabalVersion :: Section Library -> Maybe String + libCabalVersion sect = ">= 1.21" <$ guard (hasReexportedModules sect) + + hasReexportedModules :: Section Library -> Bool + hasReexportedModules = not . null . libraryReexportedModules . sectionData + formatDescription :: Int -> String -> String formatDescription alignment description = case map emptyLineToDot $ lines description of x : xs -> intercalate "\n" (x : map (indentation ++) xs) @@ -179,6 +192,7 @@ renderSection sect ++ [ renderExposedModules libraryExposedModules , renderOtherModules libraryOtherModules + , renderReexportedModules libraryReexportedModules , defaultLanguage ] @@ -192,7 +206,14 @@ , renderCppOptions sectionCppOptions , renderDependencies sectionDependencies ] + ++ map renderConditional sectionConditionals +renderConditional :: Section Condition -> Element +renderConditional sect = Stanza condition (renderSection sect) + where + condition :: String + condition = "if " ++ conditionCondition (sectionData sect) + defaultLanguage :: Element defaultLanguage = Field "default-language" "Haskell2010" @@ -204,6 +225,9 @@ renderOtherModules :: [String] -> Element renderOtherModules modules = Field "other-modules" (LineSeparatedList modules) + +renderReexportedModules :: [String] -> Element +renderReexportedModules modules = Field "reexported-modules" (LineSeparatedList modules) renderDependencies :: [Dependency] -> Element renderDependencies dependencies = Field "build-depends" (CommaSeparatedList $ map dependencyName dependencies) diff --git a/src/Hpack/Util.hs b/src/Hpack/Util.hs --- a/src/Hpack/Util.hs +++ b/src/Hpack/Util.hs @@ -31,6 +31,7 @@ import Data.Ord import System.Directory import System.FilePath +import qualified System.FilePath.Posix as Posix import System.FilePath.Glob import Hpack.Haskell @@ -119,13 +120,16 @@ isNameChar = (`elem` nameChars) nameChars = ['a'..'z'] ++ ['A'..'Z'] ++ "-" +toPosixFilePath :: FilePath -> FilePath +toPosixFilePath = Posix.joinPath . splitDirectories + expandGlobs :: FilePath -> [String] -> IO ([String], [FilePath]) expandGlobs dir patterns = do files <- (fst <$> globDir compiledPatterns dir) >>= mapM removeDirectories let warnings = [warn pattern | ([], pattern) <- zip files patterns] return (warnings, combineResults files) where - combineResults = nub . map (makeRelative dir) . sort . concat + combineResults = nub . sort . map (toPosixFilePath . makeRelative dir) . concat warn pattern = "Specified pattern " ++ show pattern ++ " for extra-source-files does not match any files" compiledPatterns = map (compileWith options) patterns removeDirectories = filterM doesFileExist diff --git a/test/Helper.hs b/test/Helper.hs --- a/test/Helper.hs +++ b/test/Helper.hs @@ -2,7 +2,7 @@ module Test.Hspec , module Test.Mockery.Directory , module Control.Applicative -, module System.IO.Temp +, withTempDirectory , module System.FilePath , withCurrentDirectory ) where @@ -12,7 +12,7 @@ import Control.Applicative import System.Directory import Control.Exception -import System.IO.Temp +import qualified System.IO.Temp as Temp import System.FilePath withCurrentDirectory :: FilePath -> IO a -> IO a @@ -20,3 +20,7 @@ bracket (getCurrentDirectory) (setCurrentDirectory) $ \ _ -> do setCurrentDirectory dir action + +withTempDirectory :: (FilePath -> IO a) -> IO a +withTempDirectory action = Temp.withSystemTempDirectory "hspec" $ \dir -> do + canonicalizePath dir >>= action diff --git a/test/Hpack/ConfigSpec.hs b/test/Hpack/ConfigSpec.hs --- a/test/Hpack/ConfigSpec.hs +++ b/test/Hpack/ConfigSpec.hs @@ -13,9 +13,10 @@ import Data.Aeson.QQ import Data.Aeson.Types -import Data.String.Interpolate +import Data.String.Interpolate.IsString import Control.Arrow import System.Directory (createDirectory) +import Data.Yaml import Hpack.Util import Hpack.Config hiding (package) @@ -28,10 +29,10 @@ executable name main_ = Executable name main_ [] library :: Library -library = Library [] [] +library = Library [] [] [] withPackage :: String -> IO () -> (([String], Package) -> Expectation) -> Expectation -withPackage content beforeAction expectation = withSystemTempDirectory "hspec" $ \dir_ -> do +withPackage content beforeAction expectation = withTempDirectory $ \dir_ -> do let dir = dir_ "foo" createDirectory dir writeFile (dir "package.yaml") content @@ -51,9 +52,51 @@ withPackageWarnings_ :: String -> ([String] -> Expectation) -> Expectation withPackageWarnings_ content = withPackageWarnings content (return ()) +data Dummy = Dummy + deriving (Eq, Show) + +instance FromJSON Dummy where + parseJSON _ = return Dummy + +instance HasFieldNames Dummy where + fieldNames _ = [] + spec :: Spec spec = do describe "parseJSON" $ do + context "when parsing (CaptureUnknownFields Section a)" $ do + it "accepts dependencies" $ do + let input = [i| + dependencies: hpack + |] + captureUnknownFieldsValue <$> decodeEither input + `shouldBe` Right (section Dummy){sectionDependencies = ["hpack"]} + + it "accepts conditionals" $ do + let input = [i| + when: + condition: os(windows) + dependencies: Win32 + |] + conditionals = [(section $ Condition "os(windows)"){sectionDependencies = ["Win32"]}] + captureUnknownFieldsValue <$> decodeEither input + `shouldBe` Right (section Dummy){sectionConditionals = conditionals} + + it "warns on unknown fields" $ do + let input = [i| + foo: 23 + when: + - condition: os(windows) + bar: 23 + when: + condition: os(windows) + bar2: 23 + - condition: os(windows) + baz: 23 + |] + captureUnknownFieldsFields <$> (decodeEither input :: Either String (CaptureUnknownFields (Section Dummy))) + `shouldBe` Right ["foo", "bar", "bar2", "baz"] + context "when parsing a Dependency" $ do it "accepts simple dependencies" $ do parseEither parseJSON "hpack" `shouldBe` Right (Dependency "hpack" Nothing) @@ -107,7 +150,7 @@ }|] parseEither parseJSON value `shouldBe` (Left "Error in $: neither key \"git\" nor key \"github\" present" :: Either String Dependency) - describe "getModules" $ around (withSystemTempDirectory "hspec") $ 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") @@ -149,6 +192,33 @@ ] ) + it "warns on unknown fields in when block, list" $ do + withPackageWarnings_ [i| + when: + - condition: impl(ghc) + bar: 23 + baz: 42 + |] + (`shouldBe` [ + "Ignoring unknown field \"bar\" in package description" + , "Ignoring unknown field \"baz\" in package description" + ] + ) + + it "warns on unknown fields in when block, single" $ do + withPackageWarnings_ [i| + when: + condition: impl(ghc) + github: foo/bar + dependencies: ghc-prim + baz: 42 + |] + (`shouldBe` [ + "Ignoring unknown field \"baz\" in package description" + , "Ignoring unknown field \"github\" in package description" + ] + ) + it "accepts name" $ do withPackageConfig_ [i| name: bar @@ -256,8 +326,14 @@ (do touch "LICENSE" ) - (`shouldBe` package {packageLicenseFile = Just "LICENSE"}) + (packageLicenseFile >>> (`shouldBe` Just "LICENSE")) + it "accepts license file" $ do + withPackageConfig_ [i| + license-file: FOO + |] + (packageLicenseFile >>> (`shouldBe` Just "FOO")) + it "accepts extra-source-files" $ do withPackageConfig [i| extra-source-files: @@ -390,6 +466,13 @@ ) (packageLibrary >>> (`shouldBe` Just (section library{libraryExposedModules = ["Foo"], libraryOtherModules = ["Bar"]}) {sectionSourceDirs = ["src"]})) + it "allows to specify reexported-modules" $ do + withPackageConfig_ [i| + library: + reexported-modules: Baz + |] + (packageLibrary >>> (`shouldBe` Just (section library{libraryReexportedModules = ["Baz"]}))) + it "allows to specify both exposed-modules and other-modules" $ do withPackageConfig [i| library: @@ -642,7 +725,7 @@ ] ) - around (withSystemTempDirectory "hspec") $ do + around withTempDirectory $ do context "when package.yaml can not be parsed" $ do it "returns an error" $ \dir -> do let file = dir "package.yaml" diff --git a/test/Hpack/RunSpec.hs b/test/Hpack/RunSpec.hs --- a/test/Hpack/RunSpec.hs +++ b/test/Hpack/RunSpec.hs @@ -91,17 +91,57 @@ , " bar" ] - it "renders libray section" $ do - renderPackage_ 0 [] package {packageLibrary = Just $ section library} `shouldBe` unlines [ - "name: foo" - , "version: 0.0.0" - , "build-type: Simple" - , "cabal-version: >= 1.10" - , "" - , "library" - , " default-language: Haskell2010" - ] + context "when rendering library section" $ do + it "renders library section" $ do + renderPackage_ 0 [] package {packageLibrary = Just $ section library} `shouldBe` unlines [ + "name: foo" + , "version: 0.0.0" + , "build-type: Simple" + , "cabal-version: >= 1.10" + , "" + , "library" + , " default-language: Haskell2010" + ] + it "includes exposed-modules" $ do + renderPackage_ 0 [] package {packageLibrary = Just (section library{libraryExposedModules = ["Foo"]})} `shouldBe` unlines [ + "name: foo" + , "version: 0.0.0" + , "build-type: Simple" + , "cabal-version: >= 1.10" + , "" + , "library" + , " exposed-modules:" + , " Foo" + , " default-language: Haskell2010" + ] + + it "includes other-modules" $ do + renderPackage_ 0 [] package {packageLibrary = Just (section library{libraryOtherModules = ["Bar"]})} `shouldBe` unlines [ + "name: foo" + , "version: 0.0.0" + , "build-type: Simple" + , "cabal-version: >= 1.10" + , "" + , "library" + , " other-modules:" + , " Bar" + , " default-language: Haskell2010" + ] + + it "includes reexported-modules and bumps cabal version" $ do + renderPackage_ 0 [] package {packageLibrary = Just (section library{libraryReexportedModules = ["Baz"]})} `shouldBe` unlines [ + "name: foo" + , "version: 0.0.0" + , "build-type: Simple" + , "cabal-version: >= 1.21" + , "" + , "library" + , " reexported-modules:" + , " Baz" + , " default-language: Haskell2010" + ] + context "when given list of existing fields" $ do it "retains field order" $ do renderPackage_ 16 ["cabal-version", "version", "name", "build-type"] package `shouldBe` unlines [ @@ -162,6 +202,25 @@ , " ghc-prof-options: -fprof-auto -rtsopts" , " default-language: Haskell2010" ] + describe "renderConditional" $ do + it "renders conditionals" $ do + let conditional = (section $ Condition "os(windows)"){sectionDependencies = ["Win32"]} + render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [ + "if os(windows)" + , " build-depends:" + , " Win32" + ] + + it "renders nested conditionals" $ do + let conditional = (section $ Condition "arch(i386)"){sectionGhcOptions = ["-threaded"], sectionConditionals = [innerConditional]} + innerConditional = (section $ Condition "os(windows)"){sectionDependencies = ["Win32"]} + render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [ + "if arch(i386)" + , " ghc-options: -threaded" + , " if os(windows)" + , " build-depends:" + , " Win32" + ] describe "formatDescription" $ do it "formats description" $ do diff --git a/test/Hpack/UtilSpec.hs b/test/Hpack/UtilSpec.hs --- a/test/Hpack/UtilSpec.hs +++ b/test/Hpack/UtilSpec.hs @@ -142,7 +142,7 @@ it "rejects invalid fields" $ do splitField "foo bar" `shouldBe` Nothing - describe "expandGlobs" $ around (withSystemTempDirectory "hspec") $ do + describe "expandGlobs" $ around withTempDirectory $ do it "accepts simple files" $ \dir -> do touch (dir "foo.js") expandGlobs dir ["foo.js"] `shouldReturn` ([], ["foo.js"])