diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,8 @@ -## next +## next (0.19.0) + - Add Paths_* module to executables (see #195, for GHC 8.2.1 compatibility) + - Allow specifying dependencies as a hash (see #198) + +## Change in 0.18.1 - Output generated cabal file to `stdout` when `-` is given as a command-line option (see #113) - Recognize `.chs`, `.y`, `.ly` and `.x` as Haskell modules when inferring 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.18.0. +-- This file has been generated from package.yaml by hpack version 0.19.0. -- -- see: https://github.com/sol/hpack name: hpack -version: 0.18.1 +version: 0.19.0 synopsis: An alternative format for Haskell packages description: See README at category: Development @@ -27,24 +27,27 @@ src ghc-options: -Wall build-depends: - base >= 4.7 && < 5 - , base-compat >= 0.8 + Cabal + , Glob + , aeson >=0.11 + , base >=4.7 && <5 + , base-compat >=0.8 , bytestring + , containers , deepseq , directory , filepath - , Glob + , pretty , text - , containers , unordered-containers , yaml - , aeson >= 0.11 exposed-modules: Hpack Hpack.Config Hpack.Run Hpack.Yaml other-modules: + Hpack.Dependency Hpack.FormattingHints Hpack.GenericsUtil Hpack.Haskell @@ -60,19 +63,23 @@ driver ghc-options: -Wall build-depends: - base >= 4.7 && < 5 - , base-compat >= 0.8 + Cabal + , Glob + , aeson >=0.11 + , base >=4.7 && <5 + , base-compat >=0.8 , bytestring + , containers , deepseq , directory , filepath - , Glob + , hpack + , pretty , text - , containers , unordered-containers , yaml - , aeson >= 0.11 - , hpack + other-modules: + Paths_hpack default-language: Haskell2010 test-suite spec @@ -84,27 +91,30 @@ ghc-options: -Wall cpp-options: -DTEST build-depends: - base >= 4.7 && < 5 - , base-compat >= 0.8 + Cabal + , Glob + , HUnit >=1.6.0.0 + , QuickCheck + , aeson >=0.11 + , base >=4.7 && <5 + , base-compat >=0.8 , bytestring + , containers , deepseq , directory , filepath - , Glob + , hspec ==2.* + , interpolate + , mockery >=0.3 + , pretty + , temporary , text - , containers , unordered-containers , yaml - , aeson >= 0.11 - , hspec == 2.* - , QuickCheck - , temporary - , mockery >= 0.3 - , interpolate - , aeson-qq other-modules: Helper Hpack.ConfigSpec + Hpack.DependencySpec Hpack.FormattingHintsSpec Hpack.GenericsUtilSpec Hpack.HaskellSpec @@ -115,6 +125,7 @@ HpackSpec Hpack Hpack.Config + Hpack.Dependency Hpack.FormattingHints Hpack.GenericsUtil Hpack.Haskell @@ -123,4 +134,5 @@ Hpack.Run Hpack.Util Hpack.Yaml + 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 @@ -11,6 +11,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ConstraintKinds #-} module Hpack.Config ( packageConfig , readPackageConfig @@ -19,10 +21,11 @@ , package , section , Package(..) -, Dependency(..) -, AddSource(..) -, GitUrl +, Dependencies(..) +, DependencyVersion(..) +, SourceDependency(..) , GitRef +, GitUrl , GhcOption , CustomSetup(..) , Section(..) @@ -51,6 +54,7 @@ import qualified Data.HashMap.Lazy as HashMap import Data.List.Compat (nub, (\\), sortBy, isPrefixOf) import Data.Maybe +import Data.Monoid import Data.Ord import Data.String import Data.Text (Text) @@ -64,6 +68,7 @@ import Hpack.GenericsUtil import Hpack.Util import Hpack.Yaml +import Hpack.Dependency package :: String -> String -> Package package name version = Package { @@ -102,35 +107,34 @@ } renameDependencies :: String -> String -> Section a -> Section a -renameDependencies old new sect@Section{..} = sect {sectionDependencies = map rename sectionDependencies, sectionConditionals = map renameConditional sectionConditionals} +renameDependencies old new sect@Section{..} = sect {sectionDependencies = (Dependencies . Map.fromList . map rename . Map.toList . unDependencies) sectionDependencies, sectionConditionals = map renameConditional sectionConditionals} where - rename dep - | dependencyName dep == old = dep {dependencyName = new} + rename dep@(name, version) + | name == old = (new, version) | otherwise = dep renameConditional :: Conditional -> Conditional renameConditional (Conditional condition then_ else_) = Conditional condition (renameDependencies old new then_) (renameDependencies old new <$> else_) -packageDependencies :: Package -> [Dependency] -packageDependencies Package{..} = nub . sortBy (comparing (lexicographically . dependencyName)) $ - (concatMap sectionDependencies packageExecutables) - ++ (concatMap sectionDependencies packageTests) - ++ (concatMap sectionDependencies packageBenchmarks) - ++ maybe [] sectionDependencies packageLibrary +packageDependencies :: Package -> [(String, DependencyVersion)] +packageDependencies Package{..} = nub . sortBy (comparing (lexicographically . fst)) $ + (concatMap deps packageExecutables) + ++ (concatMap deps packageTests) + ++ (concatMap deps packageBenchmarks) + ++ maybe [] deps packageLibrary + where + deps xs = [(name, version) | (name, version) <- (Map.toList . unDependencies . sectionDependencies) xs] section :: a -> Section a -section a = Section a [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] Nothing [] [] +section a = Section a [] mempty [] [] [] [] [] [] [] [] [] [] [] [] [] [] Nothing [] mempty packageConfig :: FilePath packageConfig = "package.yaml" -githubBaseUrl :: String -githubBaseUrl = "https://github.com/" - #if MIN_VERSION_aeson(1,0,0) -genericParseJSON_ :: forall a. (Generic a, GFromJSON Zero (Rep a), HasTypeName a) => Value -> Parser a +genericParseJSON_ :: forall a d m. (GFromJSON Zero (Rep a), HasTypeName a d m) => Value -> Parser a #else -genericParseJSON_ :: forall a. (Generic a, GFromJSON (Rep a), HasTypeName a) => Value -> Parser a +genericParseJSON_ :: forall a d m. (GFromJSON (Rep a), HasTypeName a d m) => Value -> Parser a #endif genericParseJSON_ = genericParseJSON defaultOptions {fieldLabelModifier = hyphenize name} where @@ -151,7 +155,7 @@ class HasFieldNames a where fieldNames :: Proxy a -> [FieldName] - default fieldNames :: (HasTypeName a, Selectors (Rep a)) => Proxy a -> [String] + default fieldNames :: (HasTypeName a d m, Selectors (Rep a)) => Proxy a -> [String] fieldNames proxy = map (hyphenize $ typeName proxy) (selectors proxy) ignoreUnderscoredUnknownFields :: Proxy a -> Bool @@ -193,7 +197,7 @@ _ -> [] data CustomSetupSection = CustomSetupSection { - customSetupSectionDependencies :: Maybe (List Dependency) + customSetupSectionDependencies :: Maybe Dependencies } deriving (Eq, Show, Generic) instance HasFieldNames CustomSetupSection @@ -225,7 +229,7 @@ data CommonOptions = CommonOptions { commonOptionsSourceDirs :: Maybe (List FilePath) -, commonOptionsDependencies :: Maybe (List Dependency) +, commonOptionsDependencies :: Maybe Dependencies , commonOptionsDefaultExtensions :: Maybe (List String) , commonOptionsOtherExtensions :: Maybe (List String) , commonOptionsGhcOptions :: Maybe (List GhcOption) @@ -242,7 +246,7 @@ , commonOptionsLdOptions :: Maybe (List LdOption) , commonOptionsBuildable :: Maybe Bool , commonOptionsWhen :: Maybe (List ConditionalSection) -, commonOptionsBuildTools :: Maybe (List Dependency) +, commonOptionsBuildTools :: Maybe Dependencies } deriving (Eq, Show, Generic) instance HasFieldNames CommonOptions @@ -373,49 +377,6 @@ dir <- takeDirectory <$> canonicalizePath file Right <$> mkPackage dir config -data Dependency = Dependency { - dependencyName :: String -, dependencyGitRef :: Maybe AddSource -} deriving (Eq, Show, Ord, Generic) - -instance IsString Dependency where - fromString name = Dependency name Nothing - -instance FromJSON Dependency where - parseJSON v = case v of - String _ -> fromString <$> parseJSON v - Object o -> addSourceDependency o - _ -> typeMismatch "String or an Object" v - where - addSourceDependency o = Dependency <$> name <*> (Just <$> (local <|> git)) - where - name :: Parser String - name = o .: "name" - - local :: Parser AddSource - local = Local <$> o .: "path" - - git :: Parser AddSource - git = GitRef <$> url <*> ref <*> subdir - - url :: Parser String - url = - ((githubBaseUrl ++) <$> o .: "github") - <|> (o .: "git") - <|> fail "neither key \"git\" nor key \"github\" present" - - ref :: Parser String - ref = o .: "ref" - - subdir :: Parser (Maybe FilePath) - subdir = o .:? "subdir" - -data AddSource = GitRef GitUrl GitRef (Maybe FilePath) | Local FilePath - deriving (Eq, Show, Ord) - -type GitUrl = String -type GitRef = String - data Package = Package { packageName :: String , packageVersion :: String @@ -444,7 +405,7 @@ } deriving (Eq, Show) data CustomSetup = CustomSetup { - customSetupDependencies :: [Dependency] + customSetupDependencies :: Dependencies } deriving (Eq, Show) data Library = Library { @@ -463,7 +424,7 @@ data Section a = Section { sectionData :: a , sectionSourceDirs :: [FilePath] -, sectionDependencies :: [Dependency] +, sectionDependencies :: Dependencies , sectionDefaultExtensions :: [String] , sectionOtherExtensions :: [String] , sectionGhcOptions :: [GhcOption] @@ -480,7 +441,7 @@ , sectionLdOptions :: [LdOption] , sectionBuildable :: Maybe Bool , sectionConditionals :: [Conditional] -, sectionBuildTools :: [Dependency] +, sectionBuildTools :: Dependencies } deriving (Eq, Show, Functor, Foldable, Traversable) data Conditional = Conditional { @@ -544,9 +505,9 @@ libraryWarnings :: [String] libraryWarnings = maybe [] fst libraryResult - (executablesWarnings, executables) <- toExecutables dir globalOptions executableSections - (testsWarnings, tests) <- toExecutables dir globalOptions (map (fmap captureUnknownFieldsValue) testsSections) - (benchmarksWarnings, benchmarks) <- toExecutables dir globalOptions (map (fmap captureUnknownFieldsValue) benchmarkSections) + (executablesWarnings, executables) <- toExecutables dir packageName_ globalOptions executableSections + (testsWarnings, tests) <- toExecutables dir packageName_ globalOptions (map (fmap captureUnknownFieldsValue) testsSections) + (benchmarksWarnings, benchmarks) <- toExecutables dir packageName_ globalOptions (map (fmap captureUnknownFieldsValue) benchmarkSections) licenseFileExists <- doesFileExist (dir "LICENSE") @@ -712,7 +673,7 @@ toCustomSetup :: CustomSetupSection -> CustomSetup toCustomSetup CustomSetupSection{..} = CustomSetup - { customSetupDependencies = fromMaybeList customSetupSectionDependencies } + { customSetupDependencies = fromMaybe mempty customSetupSectionDependencies } toLibrary :: FilePath -> String -> Section global -> Section LibrarySection -> IO ([String], Section Library) toLibrary dir name globalOptions library = traverse fromLibrarySection sect >>= expandForeignSources dir @@ -730,8 +691,8 @@ reexportedModules = fromMaybeList librarySectionReexportedModules return (Library librarySectionExposed exposedModules otherModules reexportedModules) -toExecutables :: FilePath -> Section global -> [(String, Section ExecutableSection)] -> IO ([String], [Section Executable]) -toExecutables dir globalOptions executables = do +toExecutables :: FilePath -> String -> Section global -> [(String, Section ExecutableSection)] -> IO ([String], [Section Executable]) +toExecutables dir packageName_ globalOptions executables = do result <- mapM toExecutable sections >>= mapM (expandForeignSources dir) let (warnings, xs) = unzip result return (concat warnings, xs) @@ -746,9 +707,14 @@ where fromExecutableSection :: ExecutableSection -> IO (Executable, [GhcOption]) fromExecutableSection ExecutableSection{..} = do - modules <- maybe (filterMain . concat <$> mapM (getModules dir) sectionSourceDirs) (return . fromList) executableSectionOtherModules + modules <- maybe inferModules (return . fromList) executableSectionOtherModules return (Executable name mainSrcFile modules, ghcOptions) where + inferModules :: IO [String] + inferModules = filterMain . (++ [pathsModule]) . concat <$> mapM (getModules dir) sectionSourceDirs + + pathsModule = pathsModuleFromPackageName packageName_ + filterMain :: [String] -> [String] filterMain = maybe id (filter . (/=)) (toModule $ splitDirectories executableSectionMain) @@ -774,9 +740,9 @@ , sectionInstallIncludes = sectionInstallIncludes globalOptions ++ sectionInstallIncludes options , sectionLdOptions = sectionLdOptions globalOptions ++ sectionLdOptions options , sectionBuildable = sectionBuildable options <|> sectionBuildable globalOptions - , sectionDependencies = sectionDependencies globalOptions ++ sectionDependencies options + , sectionDependencies = sectionDependencies options <> sectionDependencies globalOptions , sectionConditionals = sectionConditionals globalOptions ++ sectionConditionals options - , sectionBuildTools = sectionBuildTools globalOptions ++ sectionBuildTools options + , sectionBuildTools = sectionBuildTools options <> sectionBuildTools globalOptions } toSection :: a -> CommonOptions -> ([FieldName], Section a) @@ -800,9 +766,9 @@ , sectionInstallIncludes = fromMaybeList commonOptionsInstallIncludes , sectionLdOptions = fromMaybeList commonOptionsLdOptions , sectionBuildable = commonOptionsBuildable - , sectionDependencies = fromMaybeList commonOptionsDependencies + , sectionDependencies = fromMaybe mempty commonOptionsDependencies , sectionConditionals = conditionals - , sectionBuildTools = fromMaybeList commonOptionsBuildTools + , sectionBuildTools = fromMaybe mempty commonOptionsBuildTools } ) where diff --git a/src/Hpack/Dependency.hs b/src/Hpack/Dependency.hs new file mode 100644 --- /dev/null +++ b/src/Hpack/Dependency.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Hpack.Dependency ( + Dependencies(..) +, DependencyVersion(..) +, SourceDependency(..) +, GitRef +, GitUrl +, githubBaseUrl +) where + +import Prelude () +import Prelude.Compat + +import qualified Data.Text as T +import Text.PrettyPrint (renderStyle, Style(..), Mode(..)) +import Control.Monad +import qualified Distribution.Compat.ReadP as D +import qualified Distribution.Package as D +import qualified Distribution.Text as D +import qualified Distribution.Version as D +import Data.Map.Lazy (Map) +import qualified Data.Map.Lazy as Map +import Data.Aeson.Types +import Control.Applicative + +githubBaseUrl :: String +githubBaseUrl = "https://github.com/" + +newtype Dependencies = Dependencies { + unDependencies :: Map String DependencyVersion +} deriving (Eq, Show, Monoid) + +data DependencyVersion = + AnyVersion + | VersionRange String + | SourceDependency SourceDependency + deriving (Eq, Show) + +data SourceDependency = GitRef GitUrl GitRef (Maybe FilePath) | Local FilePath + deriving (Eq, Show) + +type GitUrl = String +type GitRef = String + +instance FromJSON Dependencies where + parseJSON v = case v of + String _ -> dependenciesFromList . return <$> parseJSON v + Array _ -> dependenciesFromList <$> parseJSON v + Object _ -> Dependencies <$> parseJSON v + _ -> typeMismatch "Array, Object, or String" v + where + fromDependency :: Dependency -> (String, DependencyVersion) + fromDependency (Dependency name version) = (name, version) + + dependenciesFromList :: [Dependency] -> Dependencies + dependenciesFromList = Dependencies . Map.fromList . map fromDependency + +instance FromJSON DependencyVersion where + parseJSON v = case v of + Null -> return AnyVersion + Object _ -> SourceDependency <$> parseJSON v + String s -> parseVersionRange ("== " ++ input) <|> parseVersionRange input + where + input = T.unpack s + + _ -> typeMismatch "Null, Object, or String" v + +instance FromJSON SourceDependency where + parseJSON = withObject "SourceDependency" (\o -> let + local :: Parser SourceDependency + local = Local <$> o .: "path" + + git :: Parser SourceDependency + git = GitRef <$> url <*> ref <*> subdir + + url :: Parser String + url = + ((githubBaseUrl ++) <$> o .: "github") + <|> (o .: "git") + <|> fail "neither key \"git\" nor key \"github\" present" + + ref :: Parser String + ref = o .: "ref" + + subdir :: Parser (Maybe FilePath) + subdir = o .:? "subdir" + + in local <|> git) + +data Dependency = Dependency { + _dependencyName :: String +, _dependencyVersion :: DependencyVersion +} deriving (Eq, Show) + +instance FromJSON Dependency where + parseJSON v = case v of + String _ -> do + (name, versionRange) <- parseJSON v >>= parseDependency + return (Dependency name versionRange) + Object o -> addSourceDependency o + _ -> typeMismatch "String or an Object" v + where + addSourceDependency o = Dependency <$> name <*> (SourceDependency <$> parseJSON v) + where + name :: Parser String + name = o .: "name" + +depPkgName :: D.Dependency -> String +#if MIN_VERSION_Cabal(2,0,0) +depPkgName = D.unPackageName . D.depPkgName +#else +depPkgName (D.Dependency (D.PackageName name) _) = name +#endif + +depVerRange :: D.Dependency -> D.VersionRange +#if MIN_VERSION_Cabal(2,0,0) +depVerRange = D.depVerRange +#else +depVerRange (D.Dependency _ versionRange) = versionRange +#endif + +parseDependency :: Monad m => String -> m (String, DependencyVersion) +parseDependency = liftM fromCabal . parseCabalDependency + where + fromCabal :: D.Dependency -> (String, DependencyVersion) + fromCabal d = (depPkgName d, dependencyVersionFromCabal $ depVerRange d) + +dependencyVersionFromCabal :: D.VersionRange -> DependencyVersion +dependencyVersionFromCabal versionRange + | D.isAnyVersion versionRange = AnyVersion + | otherwise = VersionRange . renderStyle style . D.disp $ versionRange + where + style = Style OneLineMode 0 0 + +parseCabalDependency :: Monad m => String -> m D.Dependency +parseCabalDependency = cabalParse "dependency" + +parseVersionRange :: Monad m => String -> m DependencyVersion +parseVersionRange = liftM dependencyVersionFromCabal . parseCabalVersionRange + +parseCabalVersionRange :: Monad m => String -> m D.VersionRange +parseCabalVersionRange = cabalParse "constraint" + +cabalParse :: (Monad m, D.Text a) => String -> String -> m a +cabalParse subject s = case [d | (d, "") <- D.readP_to_S D.parse s] of + [d] -> return d + _ -> fail $ unwords ["invalid", subject, show s] diff --git a/src/Hpack/GenericsUtil.hs b/src/Hpack/GenericsUtil.hs --- a/src/Hpack/GenericsUtil.hs +++ b/src/Hpack/GenericsUtil.hs @@ -4,7 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ConstraintKinds #-} module Hpack.GenericsUtil ( HasTypeName , typeName @@ -15,11 +15,10 @@ import Data.Proxy import GHC.Generics -class HasTypeName a where - typeName :: Proxy a -> String +type HasTypeName a d m = (Datatype d, Generic a, Rep a ~ M1 D d m) -instance (Datatype d, Generic a, Rep a ~ M1 D d m) => HasTypeName a where - typeName _ = datatypeName (undefined :: M1 D d x y) +typeName :: forall a d m. (Datatype d, Generic a, Rep a ~ M1 D d m) => Proxy a -> String +typeName _ = datatypeName (undefined :: M1 D d x y) selectors :: (Selectors (Rep a)) => Proxy a -> [String] selectors = f diff --git a/src/Hpack/Run.hs b/src/Hpack/Run.hs --- a/src/Hpack/Run.hs +++ b/src/Hpack/Run.hs @@ -28,6 +28,7 @@ import Data.List.Compat import System.Exit.Compat import System.FilePath +import qualified Data.Map.Lazy as Map import Hpack.Util import Hpack.Config @@ -200,7 +201,7 @@ renderCustomSetup :: CustomSetup -> Element renderCustomSetup CustomSetup{..} = - Stanza "custom-setup" [renderSetupDepends customSetupDependencies] + Stanza "custom-setup" [renderDependencies "setup-depends" customSetupDependencies] renderLibrary :: Section Library -> Element renderLibrary sect@(sectionData -> Library{..}) = Stanza "library" $ @@ -232,8 +233,8 @@ , renderDirectories "extra-lib-dirs" sectionExtraLibDirs , Field "extra-libraries" (LineSeparatedList sectionExtraLibraries) , renderLdOptions sectionLdOptions - , renderDependencies sectionDependencies - , renderBuildTools sectionBuildTools + , renderDependencies "build-depends" sectionDependencies + , renderDependencies "build-tools" sectionBuildTools ] ++ maybe [] (return . renderBuildable) sectionBuildable ++ map renderConditional sectionConditionals @@ -265,9 +266,17 @@ renderReexportedModules :: [String] -> Element renderReexportedModules = Field "reexported-modules" . LineSeparatedList -renderDependencies :: [Dependency] -> Element -renderDependencies = Field "build-depends" . CommaSeparatedList . map dependencyName +renderDependencies :: String -> Dependencies -> Element +renderDependencies name = Field name . CommaSeparatedList . map renderDependency . Map.toList . unDependencies +renderDependency :: (String, DependencyVersion) -> String +renderDependency (name, version) = name ++ v + where + v = case version of + AnyVersion -> "" + VersionRange x -> " " ++ x + SourceDependency _ -> "" + renderGhcOptions :: [GhcOption] -> Element renderGhcOptions = Field "ghc-options" . WordList @@ -294,9 +303,3 @@ renderOtherExtensions :: [String] -> Element renderOtherExtensions = Field "other-extensions" . WordList - -renderBuildTools :: [Dependency] -> Element -renderBuildTools = Field "build-tools" . CommaSeparatedList . map dependencyName - -renderSetupDepends :: [Dependency] -> Element -renderSetupDepends = Field "setup-depends" . CommaSeparatedList . map dependencyName diff --git a/test/Hpack/ConfigSpec.hs b/test/Hpack/ConfigSpec.hs --- a/test/Hpack/ConfigSpec.hs +++ b/test/Hpack/ConfigSpec.hs @@ -1,32 +1,37 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Hpack.ConfigSpec ( spec , package -, executable +, deps ) where import Helper -import Data.Aeson.QQ import Data.Aeson.Types import Data.String.Interpolate.IsString import Control.Arrow import System.Directory (createDirectory) import Data.Yaml import Data.Either.Compat +import qualified Data.Map.Lazy as Map import Hpack.Util +import Hpack.Dependency import Hpack.Config hiding (package) import qualified Hpack.Config as Config +deps :: [String] -> Dependencies +deps = Dependencies . Map.fromList . map (flip (,) AnyVersion) + package :: Package package = Config.package "foo" "0.0.0" executable :: String -> String -> Executable -executable name main_ = Executable name main_ [] +executable name main_ = Executable name main_ ["Paths_foo"] library :: Library library = Library Nothing [] ["Paths_foo"] [] @@ -59,11 +64,11 @@ renamePackage "bar" package `shouldBe` package {packageName = "bar"} it "renames dependencies on self" $ do - let packageWithExecutable dependencies = package {packageExecutables = [(section $ executable "main" "Main.hs") {sectionDependencies = dependencies}]} + let packageWithExecutable dependencies = package {packageExecutables = [(section $ executable "main" "Main.hs") {sectionDependencies = deps dependencies}]} renamePackage "bar" (packageWithExecutable ["foo"]) `shouldBe` (packageWithExecutable ["bar"]) {packageName = "bar"} describe "renameDependencies" $ do - let sectionWithDeps dependencies = (section ()) {sectionDependencies = dependencies} + let sectionWithDeps dependencies = (section ()) {sectionDependencies = deps dependencies} it "renames dependencies" $ do renameDependencies "bar" "baz" (sectionWithDeps ["foo", "bar"]) `shouldBe` sectionWithDeps ["foo", "baz"] @@ -87,7 +92,7 @@ dependencies: hpack |] captureUnknownFieldsValue <$> decodeEither input - `shouldBe` Right (section Empty){sectionDependencies = ["hpack"]} + `shouldBe` Right (section Empty){sectionDependencies = deps ["hpack"]} it "accepts includes-dirs" $ do let input = [i| @@ -152,7 +157,7 @@ |] conditionals = [ Conditional "os(windows)" - (section ()){sectionDependencies = ["Win32"]} + (section ()){sectionDependencies = deps ["Win32"]} Nothing ] captureUnknownFieldsValue <$> decodeEither input @@ -185,8 +190,8 @@ |] conditionals = [ Conditional "os(windows)" - (section ()){sectionDependencies = ["Win32"]} - (Just (section ()){sectionDependencies = ["unix"]}) + (section ()){sectionDependencies = deps ["Win32"]} + (Just (section ()){sectionDependencies = deps ["unix"]}) ] r :: Either String (Section Empty) r = captureUnknownFieldsValue <$> decodeEither input @@ -218,69 +223,6 @@ captureUnknownFieldsFields <$> (decodeEither input :: Either String (CaptureUnknownFields (Section Empty))) `shouldBe` Right ["foo", "bar", "baz"] - context "when parsing a Dependency" $ do - it "accepts simple dependencies" $ do - parseEither parseJSON "hpack" `shouldBe` Right (Dependency "hpack" Nothing) - - it "accepts git dependencies" $ do - let value = [aesonQQ|{ - name: "hpack", - git: "https://github.com/sol/hpack", - ref: "master" - }|] - source = GitRef "https://github.com/sol/hpack" "master" Nothing - parseEither parseJSON value `shouldBe` Right (Dependency "hpack" (Just source)) - - it "accepts github dependencies" $ do - let value = [aesonQQ|{ - name: "hpack", - github: "sol/hpack", - ref: "master" - }|] - source = GitRef "https://github.com/sol/hpack" "master" Nothing - parseEither parseJSON value `shouldBe` Right (Dependency "hpack" (Just source)) - - it "accepts an optional subdirectory for git dependencies" $ do - let value = [aesonQQ|{ - name: "warp", - github: "yesodweb/wai", - ref: "master", - subdir: "warp" - }|] - source = GitRef "https://github.com/yesodweb/wai" "master" (Just "warp") - parseEither parseJSON value `shouldBe` Right (Dependency "warp" (Just source)) - - it "accepts local dependencies" $ do - let value = [aesonQQ|{ - name: "hpack", - path: "../hpack" - }|] - source = Local "../hpack" - parseEither parseJSON value `shouldBe` Right (Dependency "hpack" (Just source)) - - context "when parsing fails" $ do - it "returns an error message" $ do - let value = Number 23 - parseEither parseJSON value `shouldBe` (Left "Error in $: expected String or an Object, encountered Number" :: Either String Dependency) - - context "when ref is missing" $ do - it "produces accurate error messages" $ do - let value = [aesonQQ|{ - name: "hpack", - git: "sol/hpack", - ef: "master" - }|] - parseEither parseJSON value `shouldBe` (Left "Error in $: key \"ref\" not present" :: Either String Dependency) - - context "when both git and github are missing" $ do - it "produces accurate error messages" $ do - let value = [aesonQQ|{ - name: "hpack", - gi: "sol/hpack", - ref: "master" - }|] - parseEither parseJSON value `shouldBe` (Left "Error in $: neither key \"git\" nor key \"github\" present" :: Either String Dependency) - describe "getModules" $ around withTempDirectory $ do it "returns Haskell modules in specified source directory" $ \dir -> do touch (dir "src/Foo.hs") @@ -721,10 +663,14 @@ withPackageConfig_ [i| custom-setup: dependencies: - - foo >1.0 - - bar ==2.0 + - foo > 1.0 + - bar == 2.0 |] - (packageCustomSetup >>> fmap customSetupDependencies >>> (`shouldBe` Just ["foo >1.0", "bar ==2.0"])) + (packageCustomSetup >>> fmap customSetupDependencies >>> fmap unDependencies >>> fmap Map.toList >>> (`shouldBe` Just [ + ("bar", VersionRange "==2.0") + , ("foo", VersionRange ">1.0") + ]) + ) it "allows yaml merging and overriding fields" $ do withPackageConfig_ [i| @@ -766,7 +712,7 @@ - alex - happy |] - (packageLibrary >>> (`shouldBe` Just (section library) {sectionBuildTools = ["alex", "happy"]})) + (packageLibrary >>> (`shouldBe` Just (section library) {sectionBuildTools = deps ["alex", "happy"]})) it "accepts default-extensions" $ do withPackageConfig_ [i| @@ -802,7 +748,7 @@ - happy library: {} |] - (packageLibrary >>> (`shouldBe` Just (section library) {sectionBuildTools = ["alex", "happy"]})) + (packageLibrary >>> (`shouldBe` Just (section library) {sectionBuildTools = deps ["alex", "happy"]})) it "accepts c-sources" $ do withPackageConfig [i| @@ -1007,7 +953,7 @@ - alex - happy |] - (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "Main.hs") {sectionBuildTools = ["alex", "happy"]}])) + (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "Main.hs") {sectionBuildTools = deps ["alex", "happy"]}])) it "accepts global source-dirs" $ do withPackageConfig_ [i| @@ -1029,7 +975,7 @@ foo: main: Main.hs |] - (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "Main.hs") {sectionBuildTools = ["alex", "happy"]}])) + (packageExecutables >>> (`shouldBe` [(section $ executable "foo" "Main.hs") {sectionBuildTools = deps ["alex", "happy"]}])) it "infers other-modules" $ do withPackageConfig [i| @@ -1042,7 +988,7 @@ touch "src/Main.hs" touch "src/Foo.hs" ) - (map (executableOtherModules . sectionData) . packageExecutables >>> (`shouldBe` [["Foo"]])) + (map (executableOtherModules . sectionData) . packageExecutables >>> (`shouldBe` [["Foo", "Paths_foo"]])) it "allows to specify other-modules" $ do withPackageConfig [i| @@ -1219,7 +1165,7 @@ main: test/Spec.hs dependencies: hspec |] - (`shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = ["hspec"]}]}) + (`shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = deps ["hspec"]}]}) it "accepts list of dependencies" $ do withPackageConfig_ [i| @@ -1230,7 +1176,7 @@ - hspec - QuickCheck |] - (`shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = ["hspec", "QuickCheck"]}]}) + (`shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = deps ["hspec", "QuickCheck"]}]}) context "when both global and section specific dependencies are specified" $ do it "combines dependencies" $ do @@ -1243,7 +1189,19 @@ main: test/Spec.hs dependencies: hspec |] - (`shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = ["base", "hspec"]}]}) + (`shouldBe` package {packageTests = [(section $ executable "spec" "test/Spec.hs") {sectionDependencies = deps ["base", "hspec"]}]}) + + it "gives section specific dependencies precedence" $ do + withPackageConfig_ [i| + dependencies: + - base + + tests: + spec: + main: test/Spec.hs + dependencies: base >= 2 + |] + (packageTests >>> map (Map.toList . unDependencies . sectionDependencies) >>> (`shouldBe` [[("base", VersionRange ">=2")]])) context "when a specified source directory does not exist" $ do it "warns" $ do diff --git a/test/Hpack/DependencySpec.hs b/test/Hpack/DependencySpec.hs new file mode 100644 --- /dev/null +++ b/test/Hpack/DependencySpec.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ConstraintKinds #-} +module Hpack.DependencySpec (spec) where + +import Helper +import Test.HUnit + +import Data.Aeson.Types +import qualified Data.Map.Lazy as Map +import Data.String.Interpolate.IsString +import Data.Yaml +import Data.ByteString (ByteString) + +import Hpack.Dependency + +parsesAs :: HasCallStack => ByteString -> Either String [(String, DependencyVersion)] -> Expectation +parsesAs input expected = do + value <- either assertFailure return (decodeEither input) + parseEither parseJSON value `shouldBe` (Dependencies . Map.fromList <$> expected) + + +spec :: Spec +spec = do + describe "parseJSON" $ do + context "when parsing Dependencies" $ do + context "with a scalar" $ do + it "accepts dependencies without constraints" $ do + [i| + hpack + |] `parsesAs` Right [("hpack", AnyVersion)] + + it "accepts dependencies with constraints" $ do + [i| + hpack >= 2 && < 3 + |] `parsesAs` Right [("hpack", VersionRange ">=2 && <3")] + + context "with invalid constraint" $ do + it "returns an error message" $ do + [i| + hpack == + |] `parsesAs` Left "Error in $: invalid dependency \"hpack ==\"" + + context "with a list" $ do + it "accepts dependencies without constraints" $ do + [i| + - hpack + |] `parsesAs` Right [("hpack", AnyVersion)] + + it "accepts dependencies with constraints" $ do + [i| + - hpack >= 2 && < 3 + |] `parsesAs` Right [("hpack", VersionRange ">=2 && <3")] + + it "accepts git dependencies" $ do + let source = GitRef "https://github.com/sol/hpack" "master" Nothing + [i| + - name: hpack + git: https://github.com/sol/hpack + ref: master + |] `parsesAs` Right [("hpack", SourceDependency source)] + + it "accepts github dependencies" $ do + let source = GitRef "https://github.com/sol/hpack" "master" Nothing + [i| + - name: hpack + github: sol/hpack + ref: master + |] `parsesAs` Right [("hpack", SourceDependency source)] + + it "accepts an optional subdirectory for git dependencies" $ do + let source = GitRef "https://github.com/yesodweb/wai" "master" (Just "warp") + [i| + - name: warp + github: yesodweb/wai + ref: master + subdir: warp + |] `parsesAs` Right [("warp", SourceDependency source)] + + it "accepts local dependencies" $ do + let source = Local "../hpack" + [i| + - name: hpack + path: ../hpack + |] `parsesAs` Right [("hpack", SourceDependency source)] + + context "when ref is missing" $ do + it "produces accurate error messages" $ do + [i| + - name: hpack + git: sol/hpack + ef: master + |] `parsesAs` Left "Error in $[0]: key \"ref\" not present" + + context "when both git and github are missing" $ do + it "produces accurate error messages" $ do + [i| + - name: hpack + gi: sol/hpack + ref: master + |] `parsesAs` Left "Error in $[0]: neither key \"git\" nor key \"github\" present" + + context "with a mapping from dependency names to constraints" $ do + it "accepts dependencies without constraints" $ do + [i| + array: + |] `parsesAs` Right [("array", AnyVersion)] + + it "rejects invalid values" $ do + [i| + hpack: 23 + |] `parsesAs` Left "Error in $.hpack: expected Null, Object, or String, encountered Number" + + context "when the constraint is a String" $ do + it "accepts version ranges" $ do + [i| + hpack: '>=2' + |] `parsesAs` Right [("hpack", VersionRange ">=2")] + + it "accepts specific versions" $ do + [i| + hpack: 0.10.8.2 + |] `parsesAs` Right [("hpack", VersionRange "==0.10.8.2")] + + it "accepts wildcard versions" $ do + [i| + hpack: 2.* + |] `parsesAs` Right [("hpack", VersionRange "==2.*")] + + it "reports parse errors" $ do + [i| + hpack: foo + |] `parsesAs` Left "Error in $.hpack: invalid constraint \"foo\"" + + context "when the constraint is an Object" $ do + it "accepts github dependencies" $ do + [i| + Cabal: + github: haskell/cabal + ref: d53b6e0d908dfedfdf4337b2935519fb1d689e76 + subdir: Cabal + |] `parsesAs` Right [("Cabal", SourceDependency (GitRef "https://github.com/haskell/cabal" "d53b6e0d908dfedfdf4337b2935519fb1d689e76" (Just "Cabal")))] + + it "ignores names in nested hashes" $ do + [i| + outer-name: + name: inner-name + path: somewhere + |] `parsesAs` Right [("outer-name", SourceDependency (Local "somewhere"))] diff --git a/test/Hpack/RunSpec.hs b/test/Hpack/RunSpec.hs --- a/test/Hpack/RunSpec.hs +++ b/test/Hpack/RunSpec.hs @@ -3,6 +3,7 @@ import Helper import Data.List.Compat +import qualified Data.Map.Lazy as Map import Hpack.ConfigSpec hiding (spec) import Hpack.Config hiding (package) @@ -128,7 +129,7 @@ context "when rendering custom-setup section" $ do it "includes setup-depends" $ do let setup = CustomSetup - { customSetupDependencies = ["foo >1.0", "bar ==2.0"] } + { customSetupDependencies = deps ["foo", "bar"] } renderPackage_ package {packageCustomSetup = Just setup} `shouldBe` unlines [ "name: foo" , "version: 0.0.0" @@ -137,8 +138,8 @@ , "" , "custom-setup" , " setup-depends:" - , " foo >1.0" - , " , bar ==2.0" + , " bar" + , " , foo" ] context "when rendering library section" $ do @@ -210,7 +211,7 @@ ] it "retains section field order" $ do - renderPackage defaultRenderSettings 0 [] [("executable foo", ["default-language", "main-is", "ghc-options"])] package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionGhcOptions = ["-Wall", "-Werror"]}]} `shouldBe` unlines [ + renderPackage defaultRenderSettings 0 [] [("executable foo", ["default-language", "main-is", "ghc-options"])] package {packageExecutables = [(section $ Executable "foo" "Main.hs" []) {sectionGhcOptions = ["-Wall", "-Werror"]}]} `shouldBe` unlines [ "name: foo" , "version: 0.0.0" , "build-type: Simple" @@ -225,7 +226,8 @@ context "when rendering executable section" $ do it "includes dependencies" $ do - renderPackage_ package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionDependencies = ["foo", "bar", "foo", "baz"]}]} `shouldBe` unlines [ + renderPackage_ package {packageExecutables = [(section $ Executable "foo" "Main.hs" []) {sectionDependencies = Dependencies $ Map.fromList + [("foo", VersionRange "== 0.1.0"), ("bar", AnyVersion)]}]} `shouldBe` unlines [ "name: foo" , "version: 0.0.0" , "build-type: Simple" @@ -234,15 +236,13 @@ , "executable foo" , " main-is: Main.hs" , " build-depends:" - , " foo" - , " , bar" - , " , foo" - , " , baz" + , " bar" + , " , foo == 0.1.0" , " default-language: Haskell2010" ] it "includes GHC options" $ do - renderPackage_ package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionGhcOptions = ["-Wall", "-Werror"]}]} `shouldBe` unlines [ + renderPackage_ package {packageExecutables = [(section $ Executable "foo" "Main.hs" []) {sectionGhcOptions = ["-Wall", "-Werror"]}]} `shouldBe` unlines [ "name: foo" , "version: 0.0.0" , "build-type: Simple" @@ -255,7 +255,7 @@ ] it "includes GHC profiling options" $ do - renderPackage_ package {packageExecutables = [(section $ executable "foo" "Main.hs") {sectionGhcProfOptions = ["-fprof-auto", "-rtsopts"]}]} `shouldBe` unlines [ + renderPackage_ package {packageExecutables = [(section $ Executable "foo" "Main.hs" []) {sectionGhcProfOptions = ["-fprof-auto", "-rtsopts"]}]} `shouldBe` unlines [ "name: foo" , "version: 0.0.0" , "build-type: Simple" @@ -269,7 +269,7 @@ describe "renderConditional" $ do it "renders conditionals" $ do - let conditional = Conditional "os(windows)" (section ()) {sectionDependencies = ["Win32"]} Nothing + let conditional = Conditional "os(windows)" (section ()) {sectionDependencies = deps ["Win32"]} Nothing render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [ "if os(windows)" , " build-depends:" @@ -277,7 +277,7 @@ ] it "renders conditionals with else-branch" $ do - let conditional = Conditional "os(windows)" (section ()) {sectionDependencies = ["Win32"]} (Just $ (section ()) {sectionDependencies = ["unix"]}) + let conditional = Conditional "os(windows)" (section ()) {sectionDependencies = deps ["Win32"]} (Just $ (section ()) {sectionDependencies = deps ["unix"]}) render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [ "if os(windows)" , " build-depends:" @@ -289,7 +289,7 @@ it "renders nested conditionals" $ do let conditional = Conditional "arch(i386)" (section ()) {sectionGhcOptions = ["-threaded"], sectionConditionals = [innerConditional]} Nothing - innerConditional = Conditional "os(windows)" (section ()) {sectionDependencies = ["Win32"]} Nothing + innerConditional = Conditional "os(windows)" (section ()) {sectionDependencies = deps ["Win32"]} Nothing render defaultRenderSettings 0 (renderConditional conditional) `shouldBe` [ "if arch(i386)" , " ghc-options: -threaded" diff --git a/test/Hpack/UtilSpec.hs b/test/Hpack/UtilSpec.hs --- a/test/Hpack/UtilSpec.hs +++ b/test/Hpack/UtilSpec.hs @@ -3,12 +3,10 @@ module Hpack.UtilSpec (main, spec) where import Data.Aeson -import Data.Aeson.QQ import Data.Aeson.Types import Helper import System.Directory -import Hpack.Config import Hpack.Util main :: IO () @@ -72,26 +70,23 @@ getModuleFilesRecursive "foo" `shouldReturn` empty describe "List" $ do - let invalid = [aesonQQ|{ - name: "hpack", - gi: "sol/hpack", - ref: "master" - }|] - parseError :: String -> Either String (List Dependency) - parseError prefix = Left (prefix ++ ": neither key \"git\" nor key \"github\" present") + let + parseError :: String -> Either String (List Int) + parseError prefix = Left (prefix ++ ": expected Int, encountered String") + context "when parsing single values" $ do it "returns the value in a singleton list" $ do fromJSON (toJSON $ Number 23) `shouldBe` Success (List [23 :: Int]) it "returns error messages from element parsing" $ do - parseEither parseJSON invalid `shouldBe` parseError "Error in $" + parseEither parseJSON (String "foo") `shouldBe` parseError "Error in $" context "when parsing a list of values" $ do it "returns the list" $ do fromJSON (toJSON [Number 23, Number 42]) `shouldBe` Success (List [23, 42 :: Int]) it "propagates parse error messages of invalid elements" $ do - parseEither parseJSON (toJSON [String "foo", invalid]) `shouldBe` parseError "Error in $[1]" + parseEither parseJSON (toJSON [Number 23, String "foo"]) `shouldBe` parseError "Error in $[1]" describe "tryReadFile" $ do it "reads file" $ do