diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +## Changes in 0.31.0 + - Add `mixin` to the fields read by dependencies when they are + objects (see #318) + - `hpack` now returns with a successful exit code if the `.cabal` + file is up to date, even if it was generated by a newer version of + `hpack`. + ## Changes in 0.30.0 - Warn on duplicate fields (see #283) - Always render `cabal-version` as `x.y` instead of `>= x.y` so that `cabal diff --git a/hpack.cabal b/hpack.cabal --- a/hpack.cabal +++ b/hpack.cabal @@ -1,13 +1,13 @@ -cabal-version: >= 1.10 +cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.29.6. +-- This file has been generated from package.yaml by hpack version 0.30.0. -- -- see: https://github.com/sol/hpack -- --- hash: a1136b4a83bc50abf6e1fac6ef221b3df0c837b248aa357568449996e9d20078 +-- hash: 3d155641237ff3e777fbdcb7ea2f36ada952f78ea89a02794019752f6b0705a9 name: hpack -version: 0.30.0 +version: 0.31.0 synopsis: A modern format for Haskell packages description: See README at category: Development @@ -70,9 +70,10 @@ Hpack.Render.Hints Hpack.Syntax.BuildTools Hpack.Syntax.Defaults - Hpack.Syntax.Dependency + Hpack.Syntax.Dependencies Hpack.Syntax.DependencyVersion Hpack.Syntax.Git + Hpack.Syntax.ParseDependencies Hpack.Utf8 Hpack.Util Paths_hpack @@ -149,6 +150,8 @@ , unordered-containers , vector , yaml >=0.10.0 + build-tool-depends: + hspec-discover:hspec-discover other-modules: Data.Aeson.Config.FromValueSpec Data.Aeson.Config.TypesSpec @@ -166,7 +169,7 @@ Hpack.RenderSpec Hpack.Syntax.BuildToolsSpec Hpack.Syntax.DefaultsSpec - Hpack.Syntax.DependencySpec + Hpack.Syntax.DependenciesSpec Hpack.Syntax.GitSpec Hpack.Utf8Spec Hpack.UtilSpec @@ -187,9 +190,10 @@ Hpack.Render.Hints Hpack.Syntax.BuildTools Hpack.Syntax.Defaults - Hpack.Syntax.Dependency + Hpack.Syntax.Dependencies Hpack.Syntax.DependencyVersion Hpack.Syntax.Git + Hpack.Syntax.ParseDependencies Hpack.Utf8 Hpack.Util Hpack.Yaml diff --git a/src/Data/Aeson/Config/FromValue.hs b/src/Data/Aeson/Config/FromValue.hs --- a/src/Data/Aeson/Config/FromValue.hs +++ b/src/Data/Aeson/Config/FromValue.hs @@ -29,6 +29,7 @@ , withBool , parseArray +, traverseObject , (.:) , (.:?) @@ -43,6 +44,7 @@ import Control.Monad import Control.Applicative +import Data.Bifunctor import Data.Map.Lazy (Map) import qualified Data.Map.Lazy as Map import Data.Text (Text) @@ -102,9 +104,13 @@ instance FromValue a => FromValue (Map String a) where fromValue = withObject $ \ o -> do - xs <- forM (HashMap.toList o) $ \ (name, value) -> - (,) (T.unpack name) <$> fromValue value Key name - return $ Map.fromList xs + xs <- traverseObject fromValue o + return $ Map.fromList (map (first T.unpack) xs) + +traverseObject :: (Value -> Parser a) -> Object -> Parser [(Text, a)] +traverseObject f o = do + forM (HashMap.toList o) $ \ (name, value) -> + (,) name <$> f value Key name instance (FromValue a, FromValue b) => FromValue (a, b) where fromValue v = (,) <$> fromValue v <*> fromValue v diff --git a/src/Hpack.hs b/src/Hpack.hs --- a/src/Hpack.hs +++ b/src/Hpack.hs @@ -159,9 +159,9 @@ (Just oldVersion, _) | oldVersion < makeVersion [0, 20, 0] -> Generated (_, Nothing) -> ExistingCabalFileWasModifiedManually (Just oldVersion, Just hash) + | old == new -> OutputUnchanged | v < oldVersion -> AlreadyGeneratedByNewerHpack | sha256 (unlines old) /= hash -> ExistingCabalFileWasModifiedManually - | old == new -> OutputUnchanged | otherwise -> Generated hpackResult :: Options -> IO Result diff --git a/src/Hpack/Config.hs b/src/Hpack/Config.hs --- a/src/Hpack/Config.hs +++ b/src/Hpack/Config.hs @@ -38,6 +38,7 @@ , section , Package(..) , Dependencies(..) +, VersionConstraint(..) , DependencyVersion(..) , SourceDependency(..) , GitRef @@ -114,7 +115,7 @@ import Hpack.Defaults import qualified Hpack.Yaml as Yaml import Hpack.Syntax.DependencyVersion -import Hpack.Syntax.Dependency +import Hpack.Syntax.Dependencies import Hpack.Syntax.BuildTools import Hpack.License import Hpack.CabalFile (parseVersion) @@ -171,14 +172,14 @@ renameConditional :: Conditional (Section a) -> Conditional (Section a) renameConditional (Conditional condition then_ else_) = Conditional condition (renameDependencies old new then_) (renameDependencies old new <$> else_) -packageDependencies :: Package -> [(String, DependencyVersion)] +packageDependencies :: Package -> [(String, DependencyInfo)] 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] + deps xs = [(name, info) | (name, info) <- (Map.toList . unDependencies . sectionDependencies) xs] section :: a -> Section a section a = Section a [] mempty [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] Nothing [] mempty mempty [] @@ -719,6 +720,7 @@ sectionCabalVersion 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) ] ++ map versionFromSystemBuildTool systemBuildTools where versionFromSystemBuildTool name @@ -775,6 +777,9 @@ 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) + 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) @@ -1340,13 +1345,12 @@ , sectionVerbatim = fromMaybeList commonOptionsVerbatim } toBuildTools :: Monad m => BuildTools -> Warnings m (SystemBuildTools, Map BuildTool DependencyVersion) - toBuildTools = fmap (mkSystemBuildTools &&& mkBuildTools) . mapM toBuildTool_ . unBuildTools + toBuildTools = fmap (mkSystemBuildTools &&& mkBuildTools) . mapM (toBuildTool packageName_ executableNames). unBuildTools where + mkSystemBuildTools :: [Either (String, VersionConstraint) b] -> SystemBuildTools mkSystemBuildTools = SystemBuildTools . Map.fromList . lefts + mkBuildTools = Map.fromList . rights - toBuildTool_ (t, v) = bimap addVersion addVersion <$> toBuildTool packageName_ executableNames t - where - addVersion = flip (,) v toConditional :: Monad m => ConditionalSection CSources CxxSources JsSources a -> Warnings m (Conditional (Section a)) toConditional x = case x of @@ -1355,22 +1359,28 @@ where conditional (Condition (Cond c)) = Conditional c -toBuildTool :: Monad m => String -> [String] -> ParseBuildTool -> Warnings m (Either String BuildTool) +type SystemBuildTool = (String, VersionConstraint) + +toBuildTool :: Monad m => String -> [String] -> (ParseBuildTool, DependencyVersion) + -> Warnings m (Either SystemBuildTool (BuildTool, DependencyVersion)) toBuildTool packageName_ executableNames = \ case - QualifiedBuildTool pkg executable - | pkg == packageName_ && executable `elem` executableNames -> localBuildTool executable - | otherwise -> buildTool pkg executable - UnqualifiedBuildTool executable - | executable `elem` executableNames -> localBuildTool executable - | Just pkg <- lookup executable legacyTools -> legacyBuildTool pkg executable - | executable `elem` legacySystemTools -> legacySystemBuildTool executable - | otherwise -> buildTool executable executable + (QualifiedBuildTool pkg executable, v) + | pkg == packageName_ && executable `elem` executableNames -> localBuildTool executable v + | otherwise -> buildTool pkg executable v + (UnqualifiedBuildTool executable, v) + | executable `elem` executableNames -> localBuildTool executable v + | Just pkg <- lookup executable legacyTools -> legacyBuildTool pkg executable v + | executable `elem` legacySystemTools, DependencyVersion Nothing c <- v -> legacySystemBuildTool executable c + | otherwise -> buildTool executable executable v where - buildTool pkg = return . Right . BuildTool pkg + buildTool pkg executable v = return . Right $ (BuildTool pkg executable, v) + systemBuildTool = return . Left - localBuildTool = return . Right . LocalBuildTool - legacyBuildTool pkg executable = warnLegacyTool pkg executable >> buildTool pkg executable - legacySystemBuildTool executable = warnLegacySystemTool executable >> systemBuildTool executable + + localBuildTool executable v = return . Right $ (LocalBuildTool executable, v) + legacyBuildTool pkg executable v = warnLegacyTool pkg executable >> buildTool pkg executable v + legacySystemBuildTool executable c = warnLegacySystemTool executable >> systemBuildTool (executable, c) + legacyTools = [ ("gtk2hsTypeGen", "gtk2hs-buildtools") , ("gtk2hsHookGenerator", "gtk2hs-buildtools") diff --git a/src/Hpack/Render.hs b/src/Hpack/Render.hs --- a/src/Hpack/Render.hs +++ b/src/Hpack/Render.hs @@ -24,6 +24,7 @@ , CommaStyle(..) #ifdef TEST , renderConditional +, renderDependencies , renderLibraryFields , renderExecutableFields , renderFlag @@ -44,6 +45,7 @@ import Hpack.Config import Hpack.Render.Hints import Hpack.Render.Dsl +import Hpack.Syntax.Dependencies renderPackage :: [String] -> Package -> String renderPackage oldCabalFile = renderPackageWith settings alignment formattingHintsFieldOrder formattingHintsSectionsFieldOrder @@ -195,7 +197,7 @@ renderCustomSetup :: CustomSetup -> Element renderCustomSetup CustomSetup{..} = - Stanza "custom-setup" [renderDependencies "setup-depends" customSetupDependencies] + Stanza "custom-setup" $ renderDependencies "setup-depends" customSetupDependencies renderLibrary :: Section Library -> Element renderLibrary sect = Stanza "library" $ renderLibrarySection sect @@ -239,10 +241,10 @@ , renderDirectories "extra-frameworks-dirs" sectionExtraFrameworksDirs , Field "frameworks" (LineSeparatedList sectionFrameworks) , renderLdOptions sectionLdOptions - , renderDependencies "build-depends" sectionDependencies , Field "pkgconfig-depends" (CommaSeparatedList sectionPkgConfigDependencies) ] ++ renderBuildTools sectionBuildTools sectionSystemBuildTools + ++ renderDependencies "build-depends" sectionDependencies ++ maybe [] (return . renderBuildable) sectionBuildable ++ map (renderConditional renderSectionData) sectionConditionals ++ extraFieldsEnd @@ -309,17 +311,27 @@ renderSignatures :: [String] -> Element renderSignatures = Field "signatures" . CommaSeparatedList -renderDependencies :: String -> Dependencies -> Element -renderDependencies name = Field name . CommaSeparatedList . map renderDependency . Map.toList . unDependencies +renderDependencies :: String -> Dependencies -> [Element] +renderDependencies name deps = [ + Field name (CommaSeparatedList renderedDeps) + , Field "mixins" (CommaSeparatedList $ concat mixins) + ] + where + (renderedDeps, mixins) = unzip . map renderDependency . Map.toList $ unDependencies deps -renderDependency :: (String, DependencyVersion) -> String -renderDependency (name, version) = name ++ renderVersion version +renderDependency :: (String, DependencyInfo) -> (String, [String]) +renderDependency (name, DependencyInfo mixins version) = ( + name ++ renderVersion version + , [ name ++ " " ++ mixin | mixin <- mixins ] + ) renderVersion :: DependencyVersion -> String -renderVersion version = case version of +renderVersion (DependencyVersion _ c) = renderVersionConstraint c + +renderVersionConstraint :: VersionConstraint -> String +renderVersionConstraint version = case version of AnyVersion -> "" VersionRange x -> " " ++ x - SourceDependency _ -> "" renderBuildTools :: Map BuildTool DependencyVersion -> SystemBuildTools -> [Element] renderBuildTools (map renderBuildTool . Map.toList -> xs) systemBuildTools = [ @@ -349,7 +361,10 @@ ] renderSystemBuildTools :: SystemBuildTools -> [String] -renderSystemBuildTools = map renderDependency . Map.toList . unSystemBuildTools +renderSystemBuildTools = map renderSystemBuildTool . Map.toList . unSystemBuildTools + +renderSystemBuildTool :: (String, VersionConstraint) -> String +renderSystemBuildTool (name, constraint) = name ++ renderVersionConstraint constraint renderGhcOptions :: [GhcOption] -> Element renderGhcOptions = Field "ghc-options" . WordList diff --git a/src/Hpack/Syntax/BuildTools.hs b/src/Hpack/Syntax/BuildTools.hs --- a/src/Hpack/Syntax/BuildTools.hs +++ b/src/Hpack/Syntax/BuildTools.hs @@ -23,72 +23,65 @@ import Data.Aeson.Config.FromValue import Hpack.Syntax.DependencyVersion -import Hpack.Syntax.Dependency (parseDependency) +import Hpack.Syntax.Dependencies (parseDependency) -newtype BuildTools = BuildTools { - unBuildTools :: [(ParseBuildTool, DependencyVersion)] -} deriving (Show, Eq, Semigroup, Monoid) +import Hpack.Syntax.ParseDependencies data ParseBuildTool = QualifiedBuildTool String String | UnqualifiedBuildTool String deriving (Show, Eq) -instance FromValue BuildTools where - fromValue v = case v of - String s -> BuildTools . return <$> buildToolFromString s - Array xs -> BuildTools <$> parseArray buildToolFromValue xs - Object _ -> BuildTools . map (first nameToBuildTool) . Map.toList <$> fromValue v - _ -> typeMismatch "Array, Object, or String" v +newtype BuildTools = BuildTools { + unBuildTools :: [(ParseBuildTool, DependencyVersion)] +} deriving (Show, Eq, Semigroup, Monoid) -nameToBuildTool :: String -> ParseBuildTool -nameToBuildTool name = case break (== ':') name of - (executable, "") -> UnqualifiedBuildTool executable - (package, executable) -> QualifiedBuildTool package (drop 1 executable) +instance FromValue BuildTools where + fromValue = fmap BuildTools . parseDependencies parse + where + parse :: Parse ParseBuildTool DependencyVersion + parse = Parse { + parseString = buildToolFromString + , parseListItem = objectDependency + , parseDictItem = dependencyVersion + , parseName = nameToBuildTool + } -buildToolFromValue :: Value -> Parser (ParseBuildTool, DependencyVersion) -buildToolFromValue v = case v of - String s -> buildToolFromString s - Object o -> sourceDependency o - _ -> typeMismatch "Object or String" v - where - sourceDependency o = (,) <$> (nameToBuildTool <$> name) <*> (SourceDependency <$> fromValue v) - where - name :: Parser String - name = o .: "name" + nameToBuildTool :: Text -> ParseBuildTool + nameToBuildTool (T.unpack -> name) = case break (== ':') name of + (executable, "") -> UnqualifiedBuildTool executable + (package, executable) -> QualifiedBuildTool package (drop 1 executable) -buildToolFromString :: Text -> Parser (ParseBuildTool, DependencyVersion) -buildToolFromString s = parseQualifiedBuildTool s <|> parseUnqualifiedBuildTool s + buildToolFromString :: Text -> Parser (ParseBuildTool, DependencyVersion) + buildToolFromString s = parseQualifiedBuildTool s <|> parseUnqualifiedBuildTool s -parseQualifiedBuildTool :: Monad m => Text -> m (ParseBuildTool, DependencyVersion) -parseQualifiedBuildTool = fmap f . cabalParse "build tool" . T.unpack - where - f :: D.ExeDependency -> (ParseBuildTool, DependencyVersion) - f (D.ExeDependency package executable version) = ( - QualifiedBuildTool (D.unPackageName package) (D.unUnqualComponentName executable) - , dependencyVersionFromCabal version - ) + parseQualifiedBuildTool :: Monad m => Text -> m (ParseBuildTool, DependencyVersion) + parseQualifiedBuildTool = fmap fromCabal . cabalParse "build tool" . T.unpack + where + fromCabal :: D.ExeDependency -> (ParseBuildTool, DependencyVersion) + fromCabal (D.ExeDependency package executable version) = ( + QualifiedBuildTool (D.unPackageName package) (D.unUnqualComponentName executable) + , DependencyVersion Nothing $ versionConstraintFromCabal version + ) -parseUnqualifiedBuildTool :: Monad m => Text -> m (ParseBuildTool, DependencyVersion) -parseUnqualifiedBuildTool = fmap (first UnqualifiedBuildTool) . parseDependency "build tool" + parseUnqualifiedBuildTool :: Monad m => Text -> m (ParseBuildTool, DependencyVersion) + parseUnqualifiedBuildTool = fmap (first UnqualifiedBuildTool) . parseDependency "build tool" newtype SystemBuildTools = SystemBuildTools { - unSystemBuildTools :: Map String DependencyVersion + unSystemBuildTools :: Map String VersionConstraint } deriving (Show, Eq, Semigroup, Monoid) instance FromValue SystemBuildTools where - fromValue v = case v of - String s -> fromList . return <$> parseSystemBuildTool s - Array xs -> fromList <$> parseArray (withText parseSystemBuildTool) xs - Object _ -> SystemBuildTools <$> fromValue v - _ -> typeMismatch "Array, Object, or String" v + fromValue = fmap (SystemBuildTools . Map.fromList) . parseDependencies parse where - fromList :: [(String, DependencyVersion)] -> SystemBuildTools - fromList = SystemBuildTools . Map.fromList - -parseSystemBuildTool :: Monad m => Text -> m (String, DependencyVersion) -parseSystemBuildTool = fmap fromCabal . parseCabalBuildTool . T.unpack - where - fromCabal :: D.LegacyExeDependency -> (String, DependencyVersion) - fromCabal (D.LegacyExeDependency name version) = (name, dependencyVersionFromCabal version) + parse :: Parse String VersionConstraint + parse = Parse { + parseString = parseSystemBuildTool + , parseListItem = (.: "version") + , parseDictItem = versionConstraint + , parseName = T.unpack + } - parseCabalBuildTool :: Monad m => String -> m D.LegacyExeDependency - parseCabalBuildTool = cabalParse "system build tool" + parseSystemBuildTool :: Monad m => Text -> m (String, VersionConstraint) + parseSystemBuildTool = fmap fromCabal . cabalParse "system build tool" . T.unpack + where + fromCabal :: D.LegacyExeDependency -> (String, VersionConstraint) + fromCabal (D.LegacyExeDependency name version) = (name, versionConstraintFromCabal version) diff --git a/src/Hpack/Syntax/Dependencies.hs b/src/Hpack/Syntax/Dependencies.hs new file mode 100644 --- /dev/null +++ b/src/Hpack/Syntax/Dependencies.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +module Hpack.Syntax.Dependencies ( + Dependencies(..) +, DependencyInfo(..) +, parseDependency +) where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Semigroup (Semigroup(..)) +import qualified Distribution.Package as D +import Data.Map.Lazy (Map) +import qualified Data.Map.Lazy as Map +import GHC.Exts + +import Data.Aeson.Config.FromValue +import Data.Aeson.Config.Types + +import Hpack.Syntax.DependencyVersion +import Hpack.Syntax.ParseDependencies + +newtype Dependencies = Dependencies { + unDependencies :: Map String DependencyInfo +} deriving (Eq, Show, Semigroup, Monoid) + +instance IsList Dependencies where + type Item Dependencies = (String, DependencyInfo) + fromList = Dependencies . Map.fromList + toList = Map.toList . unDependencies + +instance FromValue Dependencies where + fromValue = fmap (Dependencies . Map.fromList) . parseDependencies parse + where + parse :: Parse String DependencyInfo + parse = Parse { + parseString = \ input -> do + (name, version) <- parseDependency "dependency" input + return (name, DependencyInfo [] version) + , parseListItem = objectDependencyInfo + , parseDictItem = dependencyInfo + , parseName = T.unpack + } + +data DependencyInfo = DependencyInfo { + dependencyInfoMixins :: [String] +, dependencyInfoVersion :: DependencyVersion +} deriving (Eq, Show) + +addMixins :: Object -> DependencyVersion -> Parser DependencyInfo +addMixins o version = do + mixinsMay <- o .:? "mixin" + return $ DependencyInfo (fromMaybeList mixinsMay) version + +objectDependencyInfo :: Object -> Parser DependencyInfo +objectDependencyInfo o = objectDependency o >>= addMixins o + +dependencyInfo :: Value -> Parser DependencyInfo +dependencyInfo = withDependencyVersion (DependencyInfo []) addMixins + +parseDependency :: Monad m => String -> Text -> m (String, DependencyVersion) +parseDependency subject = fmap fromCabal . cabalParse subject . T.unpack + where + fromCabal :: D.Dependency -> (String, DependencyVersion) + fromCabal d = (D.unPackageName $ D.depPkgName d, DependencyVersion Nothing . versionConstraintFromCabal $ D.depVerRange d) diff --git a/src/Hpack/Syntax/Dependency.hs b/src/Hpack/Syntax/Dependency.hs deleted file mode 100644 --- a/src/Hpack/Syntax/Dependency.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TypeFamilies #-} -module Hpack.Syntax.Dependency ( - Dependencies(..) -, parseDependency -) where - -import Data.Text (Text) -import qualified Data.Text as T -import Data.Semigroup (Semigroup(..)) -import Control.Monad -import qualified Distribution.Package as D -import Data.Map.Lazy (Map) -import qualified Data.Map.Lazy as Map -import GHC.Exts - -import Data.Aeson.Config.FromValue - -import Hpack.Syntax.DependencyVersion - -newtype Dependencies = Dependencies { - unDependencies :: Map String DependencyVersion -} deriving (Eq, Show, Semigroup, Monoid) - -instance IsList Dependencies where - type Item Dependencies = (String, DependencyVersion) - fromList = Dependencies . Map.fromList - toList = Map.toList . unDependencies - -instance FromValue Dependencies where - fromValue v = case v of - String _ -> dependenciesFromList . return <$> fromValue v - Array _ -> dependenciesFromList <$> fromValue v - Object _ -> Dependencies <$> fromValue 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 - -data Dependency = Dependency { - _dependencyName :: String -, _dependencyVersion :: DependencyVersion -} deriving (Eq, Show) - -instance FromValue Dependency where - fromValue v = case v of - String s -> uncurry Dependency <$> parseDependency "dependency" s - Object o -> sourceDependency o - _ -> typeMismatch "Object or String" v - where - sourceDependency o = Dependency <$> name <*> (SourceDependency <$> fromValue v) - where - name :: Parser String - name = o .: "name" - -parseDependency :: Monad m => String -> Text -> m (String, DependencyVersion) -parseDependency subject = liftM fromCabal . parseCabalDependency subject . T.unpack - where - fromCabal :: D.Dependency -> (String, DependencyVersion) - fromCabal d = (D.unPackageName $ D.depPkgName d, dependencyVersionFromCabal $ D.depVerRange d) - -parseCabalDependency :: Monad m => String -> String -> m D.Dependency -parseCabalDependency = cabalParse 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 @@ -4,17 +4,31 @@ githubBaseUrl , GitRef , GitUrl + +, VersionConstraint(..) +, versionConstraint +, anyVersion +, versionRange + , DependencyVersion(..) +, withDependencyVersion +, dependencyVersion + , SourceDependency(..) -, dependencyVersionFromCabal +, objectDependency +, versionConstraintFromCabal + , scientificToVersion , cabalParse ) where import Control.Applicative +import Data.Maybe import Data.Scientific +import Data.Text (Text) import qualified Data.Text as T +import qualified Data.HashMap.Strict as HashMap import Text.PrettyPrint (renderStyle, Style(..), Mode(..)) import Distribution.Version (VersionRangeF(..)) @@ -30,28 +44,51 @@ type GitUrl = String type GitRef = String -data DependencyVersion = - AnyVersion - | VersionRange String - | SourceDependency SourceDependency +data VersionConstraint = AnyVersion | VersionRange String deriving (Eq, Show) -instance FromValue DependencyVersion where - fromValue v = case v of - Null -> return AnyVersion - Object _ -> SourceDependency <$> fromValue v - Number n -> return (scientificToDependencyVersion n) - String s -> parseVersionRange ("== " ++ input) <|> parseVersionRange input - where - input = T.unpack s +instance FromValue VersionConstraint where + fromValue = versionConstraint - _ -> typeMismatch "Null, Object, Number, or String" v +versionConstraint :: Value -> Parser VersionConstraint +versionConstraint v = case v of + Null -> return AnyVersion + Number n -> return (numericVersionConstraint n) + String s -> stringVersionConstraint s + _ -> typeMismatch "Null, Number, or String" v +anyVersion :: DependencyVersion +anyVersion = DependencyVersion Nothing AnyVersion + +versionRange :: String -> DependencyVersion +versionRange = DependencyVersion Nothing . VersionRange + +data DependencyVersion = DependencyVersion (Maybe SourceDependency) VersionConstraint + deriving (Eq, Show) + +withDependencyVersion + :: (DependencyVersion -> a) + -> (Object -> DependencyVersion -> Parser a) + -> Value + -> Parser a +withDependencyVersion k obj v = case v of + Null -> return $ k anyVersion + Object o -> objectDependency o >>= obj o + Number n -> return $ k (DependencyVersion Nothing $ numericVersionConstraint n) + String s -> k . DependencyVersion Nothing <$> stringVersionConstraint s + _ -> typeMismatch "Null, Object, Number, or String" v + +dependencyVersion :: Value -> Parser DependencyVersion +dependencyVersion = withDependencyVersion id (const return) + data SourceDependency = GitRef GitUrl GitRef (Maybe FilePath) | Local FilePath deriving (Eq, Show) -instance FromValue SourceDependency where - fromValue = withObject (\o -> let +objectDependency :: Object -> Parser DependencyVersion +objectDependency o = let + version :: Parser VersionConstraint + version = fromMaybe AnyVersion <$> (o .:? "version") + local :: Parser SourceDependency local = Local <$> o .: "path" @@ -70,13 +107,23 @@ subdir :: Parser (Maybe FilePath) subdir = o .:? "subdir" - in local <|> git) + source :: Parser (Maybe SourceDependency) + source + | any (`HashMap.member` o) ["path", "git", "github", "ref", "subdir"] = Just <$> (local <|> git) + | otherwise = return Nothing -scientificToDependencyVersion :: Scientific -> DependencyVersion -scientificToDependencyVersion n = VersionRange ("==" ++ version) + in DependencyVersion <$> source <*> version + +numericVersionConstraint :: Scientific -> VersionConstraint +numericVersionConstraint n = VersionRange ("==" ++ version) where version = scientificToVersion n +stringVersionConstraint :: Text -> Parser VersionConstraint +stringVersionConstraint s = parseVersionRange ("== " ++ input) <|> parseVersionRange input + where + input = T.unpack s + scientificToVersion :: Scientific -> String scientificToVersion n = version where @@ -86,8 +133,8 @@ | otherwise = 0 e = base10Exponent n -parseVersionRange :: Monad m => String -> m DependencyVersion -parseVersionRange = fmap dependencyVersionFromCabal . parseCabalVersionRange +parseVersionRange :: Monad m => String -> m VersionConstraint +parseVersionRange = fmap versionConstraintFromCabal . parseCabalVersionRange parseCabalVersionRange :: Monad m => String -> m D.VersionRange parseCabalVersionRange = cabalParse "constraint" @@ -97,10 +144,10 @@ Right d -> return d Left _ ->fail $ unwords ["invalid", subject, show s] -dependencyVersionFromCabal :: D.VersionRange -> DependencyVersion -dependencyVersionFromCabal versionRange - | D.isAnyVersion versionRange = AnyVersion - | otherwise = VersionRange . renderStyle style . D.disp $ toPreCabal2VersionRange versionRange +versionConstraintFromCabal :: D.VersionRange -> VersionConstraint +versionConstraintFromCabal range + | D.isAnyVersion range = AnyVersion + | otherwise = VersionRange . renderStyle style . D.disp $ toPreCabal2VersionRange range where style = Style OneLineMode 0 0 diff --git a/src/Hpack/Syntax/ParseDependencies.hs b/src/Hpack/Syntax/ParseDependencies.hs new file mode 100644 --- /dev/null +++ b/src/Hpack/Syntax/ParseDependencies.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Hpack.Syntax.ParseDependencies where + +import Data.Text (Text) +import Data.Bifunctor +import Data.Aeson.Config.FromValue + +data Parse k v = Parse { + parseString :: Text -> Parser (k, v) +, parseListItem :: Object -> Parser v +, parseDictItem :: Value -> Parser v +, parseName :: Text -> k +} + +parseDependencies :: Parse k v -> Value -> Parser [(k, v)] +parseDependencies parse@Parse{..} v = case v of + String s -> return <$> parseString s + Array xs -> parseArray (buildToolFromValue parse) xs + Object o -> map (first parseName) <$> traverseObject parseDictItem o + _ -> typeMismatch "Array, Object, or String" v + +buildToolFromValue :: Parse k v -> Value -> Parser (k, v) +buildToolFromValue Parse{..} v = case v of + String s -> parseString s + Object o -> sourceDependency o + _ -> typeMismatch "Object or String" v + where + sourceDependency o = (,) <$> (parseName <$> name) <*> parseListItem o + where + name :: Parser Text + name = o .: "name" diff --git a/test/EndToEndSpec.hs b/test/EndToEndSpec.hs --- a/test/EndToEndSpec.hs +++ b/test/EndToEndSpec.hs @@ -1099,6 +1099,23 @@ 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" diff --git a/test/Hpack/ConfigSpec.hs b/test/Hpack/ConfigSpec.hs --- a/test/Hpack/ConfigSpec.hs +++ b/test/Hpack/ConfigSpec.hs @@ -12,6 +12,7 @@ , package , deps +, defaultInfo ) where import Helper @@ -25,7 +26,8 @@ import qualified Data.Map.Lazy as Map import Control.Monad.Trans.Writer (runWriter) -import Hpack.Syntax.Dependency +import Hpack.Syntax.Dependencies +import Hpack.Syntax.DependencyVersion import Hpack.Syntax.BuildTools import Hpack.Config hiding (package) import qualified Hpack.Config as Config @@ -39,8 +41,11 @@ fromList = Just . List toList = undefined +defaultInfo :: DependencyInfo +defaultInfo = DependencyInfo [] anyVersion + deps :: [String] -> Dependencies -deps = Dependencies . Map.fromList . map (flip (,) AnyVersion) +deps = Dependencies . Map.fromList . map (flip (,) defaultInfo) package :: Package package = Config.package "foo" "0.0.0" @@ -161,36 +166,36 @@ getModules dir "./." `shouldReturn` ["Foo"] describe "toBuildTool" $ do - let toBuildTool_ = runWriter . toBuildTool "my-package" ["foo"] + let toBuildTool_ name = runWriter $ toBuildTool "my-package" ["foo"] (name, anyVersion) context "with an UnqualifiedBuildTool" $ do context "when name does not match a local executable" $ do it "returns a BuildTool" $ do - toBuildTool_ (UnqualifiedBuildTool "bar") `shouldBe` (Right (BuildTool "bar" "bar"), []) + toBuildTool_ (UnqualifiedBuildTool "bar") `shouldBe` (Right (BuildTool "bar" "bar", anyVersion), []) context "when name matches a local executable" $ do it "returns a LocalBuildTool" $ do - toBuildTool_ (UnqualifiedBuildTool "foo") `shouldBe` (Right (LocalBuildTool "foo"), []) + toBuildTool_ (UnqualifiedBuildTool "foo") `shouldBe` (Right (LocalBuildTool "foo", anyVersion), []) context "when name matches a legacy executable" $ do it "warns" $ do - toBuildTool_ (UnqualifiedBuildTool "gtk2hsTypeGen") `shouldBe` (Right (BuildTool "gtk2hs-buildtools" "gtk2hsTypeGen"), ["Usage of the unqualified build-tool name \"gtk2hsTypeGen\" is deprecated! Please use the qualified name \"gtk2hs-buildtools:gtk2hsTypeGen\" instead!"]) + toBuildTool_ (UnqualifiedBuildTool "gtk2hsTypeGen") `shouldBe` (Right (BuildTool "gtk2hs-buildtools" "gtk2hsTypeGen", anyVersion), ["Usage of the unqualified build-tool name \"gtk2hsTypeGen\" is deprecated! Please use the qualified name \"gtk2hs-buildtools:gtk2hsTypeGen\" instead!"]) context "when name matches a legacy system build tool" $ do it "warns" $ do - toBuildTool_ (UnqualifiedBuildTool "ghc") `shouldBe` (Left "ghc", ["Listing \"ghc\" under build-tools is deperecated! Please list system executables under system-build-tools instead!"]) + toBuildTool_ (UnqualifiedBuildTool "ghc") `shouldBe` (Left ("ghc", AnyVersion), ["Listing \"ghc\" under build-tools is deperecated! Please list system executables under system-build-tools instead!"]) context "with a QualifiedBuildTool" $ do context "when only package matches the current package" $ do it "returns a BuildTool" $ do - toBuildTool_ (QualifiedBuildTool "my-package" "bar") `shouldBe` (Right (BuildTool "my-package" "bar"), []) + toBuildTool_ (QualifiedBuildTool "my-package" "bar") `shouldBe` (Right (BuildTool "my-package" "bar", anyVersion), []) context "when only executable matches a local executable" $ do it "returns a BuildTool" $ do - toBuildTool_ (QualifiedBuildTool "other-package" "foo") `shouldBe` (Right (BuildTool "other-package" "foo"), []) + toBuildTool_ (QualifiedBuildTool "other-package" "foo") `shouldBe` (Right (BuildTool "other-package" "foo", anyVersion), []) context "when both package matches the current package and executable matches a local executable" $ do it "returns a LocalBuildTool" $ do - toBuildTool_ (QualifiedBuildTool "my-package" "foo") `shouldBe` (Right (LocalBuildTool "foo"), []) + toBuildTool_ (QualifiedBuildTool "my-package" "foo") `shouldBe` (Right (LocalBuildTool "foo", anyVersion), []) describe "readPackageConfig" $ do it "warns on missing name" $ do diff --git a/test/Hpack/RenderSpec.hs b/test/Hpack/RenderSpec.hs --- a/test/Hpack/RenderSpec.hs +++ b/test/Hpack/RenderSpec.hs @@ -5,10 +5,12 @@ import Helper import Data.List +import Hpack.Syntax.DependencyVersion import Hpack.ConfigSpec hiding (spec) import Hpack.Config hiding (package) import Hpack.Render.Dsl import Hpack.Render +import Hpack.Syntax.Dependencies library :: Library library = Library Nothing [] [] [] [] [] @@ -160,8 +162,11 @@ context "when rendering executable section" $ do it "includes dependencies" $ do - renderPackage_ package {packageExecutables = [("foo", executable {sectionDependencies = Dependencies - [("foo", VersionRange "== 0.1.0"), ("bar", AnyVersion)]})]} `shouldBe` unlines [ + let dependencies = Dependencies + [ ("foo", defaultInfo { dependencyInfoVersion = versionRange "== 0.1.0" }) + , ("bar", defaultInfo) + ] + renderPackage_ package {packageExecutables = [("foo", executable {sectionDependencies = dependencies})]} `shouldBe` unlines [ "name: foo" , "version: 0.0.0" , "build-type: Simple" @@ -257,6 +262,17 @@ , " Win32" ] + it "conditionalises both build-depends and mixins" $ do + let conditional = Conditional "os(windows)" (section Empty) {sectionDependencies = [("Win32", depInfo)]} Nothing + depInfo = defaultInfo { dependencyInfoMixins = ["hiding (Blah)"] } + render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [ + "if os(windows)" + , " build-depends:" + , " Win32" + , " mixins:" + , " Win32 hiding (Blah)" + ] + describe "renderFlag" $ do it "renders flags" $ do let flag = (Flag "foo" (Just "some flag") True False) @@ -329,3 +345,43 @@ "name:" , " ./." ] + + describe "renderDependencies" $ do + it "renders build-depends" $ do + let deps_ = + [ ("foo", DependencyInfo [] anyVersion) + ] + renderDependencies "build-depends" deps_ `shouldBe` + [ Field "build-depends" $ CommaSeparatedList + [ "foo" + ] + , Field "mixins" $ CommaSeparatedList [] + ] + + it "renders build-depends with versions" $ do + let deps_ = + [ ("foo", DependencyInfo [] (versionRange ">= 2 && < 3")) + ] + renderDependencies "build-depends" deps_ `shouldBe` + [ Field "build-depends" $ CommaSeparatedList + [ "foo >= 2 && < 3" + ] + , Field "mixins" $ CommaSeparatedList [] + ] + + it "renders mixins and build-depends for multiple modules" $ do + let deps_ = + [ ("foo", DependencyInfo ["(Foo as Foo1)"] anyVersion) + , ("bar", DependencyInfo ["hiding (Spam)", "(Spam as Spam1) requires (Mod as Sig)"] anyVersion) + ] + renderDependencies "build-depends" deps_ `shouldBe` + [ Field "build-depends" $ CommaSeparatedList + [ "bar" + , "foo" + ] + , Field "mixins" $ CommaSeparatedList + [ "bar hiding (Spam)" + , "bar (Spam as Spam1) requires (Mod as Sig)" + , "foo (Foo as Foo1)" + ] + ] diff --git a/test/Hpack/Syntax/BuildToolsSpec.hs b/test/Hpack/Syntax/BuildToolsSpec.hs --- a/test/Hpack/Syntax/BuildToolsSpec.hs +++ b/test/Hpack/Syntax/BuildToolsSpec.hs @@ -17,33 +17,33 @@ it "accepts qualified names" $ do [yaml| foo:bar - |] `shouldDecodeTo_` BuildTools [(QualifiedBuildTool "foo" "bar", AnyVersion)] + |] `shouldDecodeTo_` BuildTools [(QualifiedBuildTool "foo" "bar", anyVersion)] it "accepts qualified names with a version" $ do [yaml| foo:bar >= 0.1.0 - |] `shouldDecodeTo_` BuildTools [(QualifiedBuildTool "foo" "bar", VersionRange ">=0.1.0")] + |] `shouldDecodeTo_` BuildTools [(QualifiedBuildTool "foo" "bar", versionRange ">=0.1.0")] it "accepts unqualified names" $ do [yaml| foo - |] `shouldDecodeTo_` BuildTools [(UnqualifiedBuildTool "foo", AnyVersion)] + |] `shouldDecodeTo_` BuildTools [(UnqualifiedBuildTool "foo", anyVersion)] it "accepts unqualified names with a version" $ do [yaml| foo >= 0.1.0 - |] `shouldDecodeTo_` BuildTools [(UnqualifiedBuildTool "foo", VersionRange ">=0.1.0")] + |] `shouldDecodeTo_` BuildTools [(UnqualifiedBuildTool "foo", versionRange ">=0.1.0")] context "with a mapping" $ do it "accepts qualified names" $ do [yaml| foo:bar: 0.1.0 - |] `shouldDecodeTo_` BuildTools [(QualifiedBuildTool "foo" "bar", VersionRange "==0.1.0")] + |] `shouldDecodeTo_` BuildTools [(QualifiedBuildTool "foo" "bar", versionRange "==0.1.0")] it "accepts unqualified names" $ do [yaml| foo: 0.1.0 - |] `shouldDecodeTo_` BuildTools [(UnqualifiedBuildTool "foo", VersionRange "==0.1.0")] + |] `shouldDecodeTo_` BuildTools [(UnqualifiedBuildTool "foo", versionRange "==0.1.0")] context "with a list" $ do it "accepts a list of build tools" $ do @@ -52,26 +52,26 @@ - bar:two >= 0.1.0 - baz == 0.2.0 |] `shouldDecodeTo_` BuildTools [ - (QualifiedBuildTool "foo" "one", AnyVersion) - , (QualifiedBuildTool "bar" "two", VersionRange ">=0.1.0") - , (UnqualifiedBuildTool "baz", VersionRange "==0.2.0") + (QualifiedBuildTool "foo" "one", anyVersion) + , (QualifiedBuildTool "bar" "two", versionRange ">=0.1.0") + , (UnqualifiedBuildTool "baz", versionRange "==0.2.0") ] it "accepts source dependencies with a qualified name" $ do - let source = GitRef "https://github.com/sol/hpack" "master" Nothing + let source = Just (GitRef "https://github.com/sol/hpack" "master" Nothing) [yaml| - name: hpack:foo github: sol/hpack ref: master - |] `shouldDecodeTo_` BuildTools [(QualifiedBuildTool "hpack" "foo", SourceDependency source)] + |] `shouldDecodeTo_` BuildTools [(QualifiedBuildTool "hpack" "foo", DependencyVersion source AnyVersion)] it "accepts source dependencies with an unqualified name" $ do - let source = GitRef "https://github.com/sol/hpack" "master" Nothing + let source = Just (GitRef "https://github.com/sol/hpack" "master" Nothing) [yaml| - name: hpack github: sol/hpack ref: master - |] `shouldDecodeTo_` BuildTools [(UnqualifiedBuildTool "hpack", SourceDependency source)] + |] `shouldDecodeTo_` BuildTools [(UnqualifiedBuildTool "hpack", DependencyVersion source AnyVersion)] context "when parsing SystemBuildTools" $ do context "with a scalar" $ do @@ -99,4 +99,12 @@ |] `shouldDecodeTo_` SystemBuildTools [ ("foo", AnyVersion) , ("bar", VersionRange ">=0.1.0") + ] + + it "accepts objects with name and version" $ do + [yaml| + - name: foo + version: 0.1.0 + |] `shouldDecodeTo_` SystemBuildTools [ + ("foo", VersionRange "==0.1.0") ] diff --git a/test/Hpack/Syntax/DependenciesSpec.hs b/test/Hpack/Syntax/DependenciesSpec.hs new file mode 100644 --- /dev/null +++ b/test/Hpack/Syntax/DependenciesSpec.hs @@ -0,0 +1,249 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedLists #-} +module Hpack.Syntax.DependenciesSpec (spec) where + +import Helper + +import Data.Aeson.Config.FromValueSpec (shouldDecodeTo, shouldDecodeTo_) + +import Data.Aeson.Config.FromValue +import Hpack.Syntax.DependencyVersion +import Hpack.Syntax.Dependencies + +left :: String -> Result Dependencies +left = Left + +defaultInfo :: DependencyInfo +defaultInfo = DependencyInfo [] anyVersion + +spec :: Spec +spec = do + describe "fromValue" $ do + context "when parsing Dependencies" $ do + context "with a scalar" $ do + it "accepts dependencies without constraints" $ do + [yaml| + hpack + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo)] + + it "accepts dependencies with constraints" $ do + [yaml| + hpack >= 2 && < 3 + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange ">=2 && <3" })] + + context "with invalid constraint" $ do + it "returns an error message" $ do + [yaml| + hpack == + |] `shouldDecodeTo` left "Error while parsing $ - invalid dependency \"hpack ==\"" + + context "with a list" $ do + it "accepts dependencies without constraints" $ do + [yaml| + - hpack + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo)] + + it "accepts dependencies with constraints" $ do + [yaml| + - hpack >= 2 && < 3 + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange ">=2 && <3" })] + + it "accepts ^>=" $ do + [yaml| + - hpack ^>= 1.2.3.4 + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange ">=1.2.3.4 && <1.3" })] + + it "accepts objects with name and version" $ do + [yaml| + - name: hpack + version: 0.1.0 + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange "==0.1.0" })] + + it "accepts git dependencies with version" $ do + let source = Just (GitRef "https://github.com/sol/hpack" "master" Nothing) + [yaml| + - name: hpack + version: 0.1.0 + git: https://github.com/sol/hpack + ref: master + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = DependencyVersion source (VersionRange "==0.1.0") })] + + it "accepts git dependencies" $ do + let source = Just (GitRef "https://github.com/sol/hpack" "master" Nothing) + [yaml| + - name: hpack + git: https://github.com/sol/hpack + ref: master + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = DependencyVersion source AnyVersion })] + + it "accepts github dependencies" $ do + let source = Just (GitRef "https://github.com/sol/hpack" "master" Nothing) + [yaml| + - name: hpack + github: sol/hpack + ref: master + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = DependencyVersion source AnyVersion })] + + it "accepts an optional subdirectory for git dependencies" $ do + let source = Just (GitRef "https://github.com/yesodweb/wai" "master" (Just "warp")) + [yaml| + - name: warp + github: yesodweb/wai + ref: master + subdir: warp + |] `shouldDecodeTo_` Dependencies [("warp", defaultInfo { dependencyInfoVersion = DependencyVersion source AnyVersion })] + + it "accepts local dependencies" $ do + let source = Just (Local "../hpack") + [yaml| + - name: hpack + path: ../hpack + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo {dependencyInfoVersion = DependencyVersion source AnyVersion })] + + context "when ref is missing" $ do + it "produces accurate error messages" $ do + [yaml| + - name: hpack + git: sol/hpack + ef: master + |] `shouldDecodeTo` left "Error while parsing $[0] - key \"ref\" not present" + + context "when both git and github are missing" $ do + it "produces accurate error messages" $ do + [yaml| + - name: hpack + gi: sol/hpack + ref: master + |] `shouldDecodeTo` left "Error while parsing $[0] - neither key \"git\" nor key \"github\" present" + + context "with a mapping from dependency names to constraints" $ do + it "accepts dependencies without constraints" $ do + [yaml| + array: + |] `shouldDecodeTo_` Dependencies [("array", defaultInfo)] + + it "rejects invalid values" $ do + [yaml| + hpack: [] + |] `shouldDecodeTo` left "Error while parsing $.hpack - expected Null, Object, Number, or String, encountered Array" + + context "when the constraint is a Number" $ do + it "accepts 1" $ do + [yaml| + hpack: 1 + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange "==1" })] + + it "accepts 1.0" $ do + [yaml| + hpack: 1.0 + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange "==1.0" })] + + it "accepts 0.11" $ do + [yaml| + hpack: 0.11 + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange "==0.11" })] + + it "accepts 0.110" $ do + [yaml| + hpack: 0.110 + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange "==0.110" })] + + it "accepts 1e2" $ do + [yaml| + hpack: 1e2 + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange "==100" })] + + context "when the constraint is a String" $ do + it "accepts version ranges" $ do + [yaml| + hpack: '>=2' + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange ">=2" })] + + it "accepts specific versions" $ do + [yaml| + hpack: 0.10.8.2 + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange "==0.10.8.2" })] + + it "accepts wildcard versions" $ do + [yaml| + hpack: 2.* + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange "==2.*" })] + + it "accepts ^>=" $ do + [yaml| + hpack: ^>= 1.2.3.4 + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange ">=1.2.3.4 && <1.3" })] + + it "reports parse errors" $ do + [yaml| + hpack: foo + |] `shouldDecodeTo` left "Error while parsing $.hpack - invalid constraint \"foo\"" + + context "when the constraint is an Object" $ do + it "accepts explicit version field" $ do + [yaml| + hpack: + version: 0.1.0 + |] `shouldDecodeTo_` Dependencies [("hpack", defaultInfo { dependencyInfoVersion = versionRange "==0.1.0" })] + + it "accepts github dependencies" $ do + let source = Just (GitRef "https://github.com/haskell/cabal" "d53b6e0d908dfedfdf4337b2935519fb1d689e76" (Just "Cabal")) + [yaml| + Cabal: + github: haskell/cabal + ref: d53b6e0d908dfedfdf4337b2935519fb1d689e76 + subdir: Cabal + |] `shouldDecodeTo_` Dependencies [("Cabal", defaultInfo { dependencyInfoVersion = DependencyVersion source AnyVersion })] + + it "ignores names in nested hashes" $ do + let source = Just (Local "somewhere") + [yaml| + outer-name: + name: inner-name + path: somewhere + |] `shouldDecodeTo` Right (Dependencies [("outer-name", defaultInfo { dependencyInfoVersion = DependencyVersion source AnyVersion })], ["$.outer-name.name"]) + + it "defaults to any version" $ do + [yaml| + foo: {} + |] `shouldDecodeTo_` Dependencies [("foo", defaultInfo)] + + context "with a version key" $ do + it "rejects objects" $ do + [yaml| + foo: + version: {} + |] `shouldDecodeTo` left "Error while parsing $.foo.version - expected Null, Number, or String, encountered Object" + + it "accepts a string" $ do + [yaml| + foo: + version: ">= 3.2.5 && < 3.3" + |] `shouldDecodeTo_` Dependencies [("foo", defaultInfo { dependencyInfoVersion = versionRange ">=3.2.5 && <3.3" })] + + it "accepts a specific version as a number" $ do + [yaml| + foo: + version: 3.0 + |] `shouldDecodeTo_` Dependencies [("foo", defaultInfo { dependencyInfoVersion = versionRange "==3.0" })] + + it "accepts a specific version as a string" $ do + [yaml| + foo: + version: 3.0.2 + |] `shouldDecodeTo_` Dependencies [("foo", defaultInfo { dependencyInfoVersion = versionRange "==3.0.2" })] + + context "with mixin" $ do + it "accepts a single value" $ do + [yaml| + foo: + mixin: (Foo as Bar) + |] `shouldDecodeTo_` Dependencies [("foo", defaultInfo { dependencyInfoMixins = ["(Foo as Bar)"] })] + + it "accepts a list" $ do + [yaml| + foo: + mixin: + - (Foo as Bar) + - hiding (Spam) + |] `shouldDecodeTo_` Dependencies [("foo", defaultInfo { dependencyInfoMixins = ["(Foo as Bar)", "hiding (Spam)"] })] diff --git a/test/Hpack/Syntax/DependencySpec.hs b/test/Hpack/Syntax/DependencySpec.hs deleted file mode 100644 --- a/test/Hpack/Syntax/DependencySpec.hs +++ /dev/null @@ -1,178 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE OverloadedLists #-} -module Hpack.Syntax.DependencySpec (spec) where - -import Helper - -import Data.Aeson.Config.FromValueSpec (shouldDecodeTo, shouldDecodeTo_) - -import Data.Aeson.Config.FromValue -import Hpack.Syntax.DependencyVersion -import Hpack.Syntax.Dependency - -left :: String -> Result Dependencies -left = Left - -spec :: Spec -spec = do - describe "fromValue" $ do - context "when parsing Dependencies" $ do - context "with a scalar" $ do - it "accepts dependencies without constraints" $ do - [yaml| - hpack - |] `shouldDecodeTo_` Dependencies [("hpack", AnyVersion)] - - it "accepts dependencies with constraints" $ do - [yaml| - hpack >= 2 && < 3 - |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange ">=2 && <3")] - - context "with invalid constraint" $ do - it "returns an error message" $ do - [yaml| - hpack == - |] `shouldDecodeTo` left "Error while parsing $ - invalid dependency \"hpack ==\"" - - context "with a list" $ do - it "accepts dependencies without constraints" $ do - [yaml| - - hpack - |] `shouldDecodeTo_` Dependencies [("hpack", AnyVersion)] - - it "accepts dependencies with constraints" $ do - [yaml| - - hpack >= 2 && < 3 - |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange ">=2 && <3")] - - it "accepts ^>=" $ do - [yaml| - - hpack ^>= 1.2.3.4 - |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange ">=1.2.3.4 && <1.3")] - - it "accepts git dependencies" $ do - let source = GitRef "https://github.com/sol/hpack" "master" Nothing - [yaml| - - name: hpack - git: https://github.com/sol/hpack - ref: master - |] `shouldDecodeTo_` Dependencies [("hpack", SourceDependency source)] - - it "accepts github dependencies" $ do - let source = GitRef "https://github.com/sol/hpack" "master" Nothing - [yaml| - - name: hpack - github: sol/hpack - ref: master - |] `shouldDecodeTo_` Dependencies [("hpack", SourceDependency source)] - - it "accepts an optional subdirectory for git dependencies" $ do - let source = GitRef "https://github.com/yesodweb/wai" "master" (Just "warp") - [yaml| - - name: warp - github: yesodweb/wai - ref: master - subdir: warp - |] `shouldDecodeTo_` Dependencies [("warp", SourceDependency source)] - - it "accepts local dependencies" $ do - let source = Local "../hpack" - [yaml| - - name: hpack - path: ../hpack - |] `shouldDecodeTo_` Dependencies [("hpack", SourceDependency source)] - - context "when ref is missing" $ do - it "produces accurate error messages" $ do - [yaml| - - name: hpack - git: sol/hpack - ef: master - |] `shouldDecodeTo` left "Error while parsing $[0] - key \"ref\" not present" - - context "when both git and github are missing" $ do - it "produces accurate error messages" $ do - [yaml| - - name: hpack - gi: sol/hpack - ref: master - |] `shouldDecodeTo` left "Error while parsing $[0] - neither key \"git\" nor key \"github\" present" - - context "with a mapping from dependency names to constraints" $ do - it "accepts dependencies without constraints" $ do - [yaml| - array: - |] `shouldDecodeTo_` Dependencies [("array", AnyVersion)] - - it "rejects invalid values" $ do - [yaml| - hpack: [] - |] `shouldDecodeTo` left "Error while parsing $.hpack - expected Null, Object, Number, or String, encountered Array" - - context "when the constraint is a Number" $ do - it "accepts 1" $ do - [yaml| - hpack: 1 - |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==1")] - - it "accepts 1.0" $ do - [yaml| - hpack: 1.0 - |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==1.0")] - - it "accepts 0.11" $ do - [yaml| - hpack: 0.11 - |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==0.11")] - - it "accepts 0.110" $ do - [yaml| - hpack: 0.110 - |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==0.110")] - - it "accepts 1e2" $ do - [yaml| - hpack: 1e2 - |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==100")] - - context "when the constraint is a String" $ do - it "accepts version ranges" $ do - [yaml| - hpack: '>=2' - |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange ">=2")] - - it "accepts specific versions" $ do - [yaml| - hpack: 0.10.8.2 - |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==0.10.8.2")] - - it "accepts wildcard versions" $ do - [yaml| - hpack: 2.* - |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange "==2.*")] - - it "accepts ^>=" $ do - [yaml| - hpack: ^>= 1.2.3.4 - |] `shouldDecodeTo_` Dependencies [("hpack", VersionRange ">=1.2.3.4 && <1.3")] - - it "reports parse errors" $ do - [yaml| - hpack: foo - |] `shouldDecodeTo` left "Error while parsing $.hpack - invalid constraint \"foo\"" - - context "when the constraint is an Object" $ do - it "accepts github dependencies" $ do - [yaml| - Cabal: - github: haskell/cabal - ref: d53b6e0d908dfedfdf4337b2935519fb1d689e76 - subdir: Cabal - |] `shouldDecodeTo_` Dependencies [("Cabal", SourceDependency (GitRef "https://github.com/haskell/cabal" "d53b6e0d908dfedfdf4337b2935519fb1d689e76" (Just "Cabal")))] - - it "ignores names in nested hashes" $ do - [yaml| - outer-name: - name: inner-name - path: somewhere - |] `shouldDecodeTo` Right (Dependencies [("outer-name", SourceDependency (Local "somewhere"))], ["$.outer-name.name"]) diff --git a/test/HpackSpec.hs b/test/HpackSpec.hs --- a/test/HpackSpec.hs +++ b/test/HpackSpec.hs @@ -94,3 +94,9 @@ old <- readFile file hpack `shouldReturn` outputUnchanged readFile file `shouldReturn` old + + it "does not complain if it's newer" $ do + _ <- hpackWithVersion (makeVersion [999,999,0]) + old <- readFile file + hpack `shouldReturn` outputUnchanged + readFile file `shouldReturn` old