From b1f1315ec0d65e59deea5479d998dc513a662312 Mon Sep 17 00:00:00 2001 From: Simon Hengel Date: Thu, 21 Sep 2017 18:58:43 +0800 Subject: [PATCH] Depend on Cabal for dependency parsing (similar to #64, needed for #193) --- hpack.cabal | 9 +++ package.yaml | 2 + src/Hpack/Config.hs | 25 +++--- src/Hpack/Dependency.hs | 47 +++++++++++ src/Hpack/Run.hs | 24 +++--- test/Hpack/ConfigSpec.hs | 146 ++++++++++++++++++++--------------- test/Hpack/DependencySpec.hs | 14 ++++ test/Hpack/RunSpec.hs | 6 +- 8 files changed, 185 insertions(+), 88 deletions(-) create mode 100644 src/Hpack/Dependency.hs create mode 100644 test/Hpack/DependencySpec.hs diff --git a/hpack.cabal b/hpack.cabal index aec9012a..fb17b7dc 100644 --- a/hpack.cabal +++ b/hpack.cabal @@ -39,12 +39,15 @@ library , unordered-containers , yaml , aeson >= 0.11 + , Cabal + , pretty exposed-modules: Hpack Hpack.Config Hpack.Run Hpack.Yaml other-modules: + Hpack.Dependency Hpack.FormattingHints Hpack.GenericsUtil Hpack.Haskell @@ -72,6 +75,8 @@ executable hpack , unordered-containers , yaml , aeson >= 0.11 + , Cabal + , pretty , hpack default-language: Haskell2010 @@ -96,6 +101,8 @@ test-suite spec , unordered-containers , yaml , aeson >= 0.11 + , Cabal + , pretty , hspec == 2.* , QuickCheck , temporary @@ -105,6 +112,7 @@ test-suite spec other-modules: Helper Hpack.ConfigSpec + Hpack.DependencySpec Hpack.FormattingHintsSpec Hpack.GenericsUtilSpec Hpack.HaskellSpec @@ -115,6 +123,7 @@ test-suite spec HpackSpec Hpack Hpack.Config + Hpack.Dependency Hpack.FormattingHints Hpack.GenericsUtil Hpack.Haskell diff --git a/package.yaml b/package.yaml index 5bdb7461..803ad33f 100644 --- a/package.yaml +++ b/package.yaml @@ -24,6 +24,8 @@ dependencies: - unordered-containers - yaml - aeson >= 0.11 + - Cabal + - pretty library: source-dirs: src diff --git a/src/Hpack/Config.hs b/src/Hpack/Config.hs index 0662ba2d..b724885e 100644 --- a/src/Hpack/Config.hs +++ b/src/Hpack/Config.hs @@ -22,9 +22,10 @@ module Hpack.Config ( , section , Package(..) , Dependency(..) +, DependencyVersion(..) , SourceDependency(..) -, GitUrl , GitRef +, GitUrl , GhcOption , CustomSetup(..) , Section(..) @@ -66,6 +67,7 @@ import System.FilePath import Hpack.GenericsUtil import Hpack.Util import Hpack.Yaml +import Hpack.Dependency package :: String -> String -> Package package name version = Package { @@ -377,19 +379,18 @@ readPackageConfig file = do data Dependency = Dependency { dependencyName :: String -, dependencyGitRef :: Maybe SourceDependency -} deriving (Eq, Show, Ord, Generic) - -instance IsString Dependency where - fromString name = Dependency name Nothing +, dependencyVersion :: DependencyVersion +} deriving (Eq, Show) instance FromJSON Dependency where parseJSON v = case v of - String _ -> fromString <$> parseJSON v + String _ -> do + (name, versionRange) <- parseJSON v >>= parseDependency + return (Dependency name $ maybe AnyVersion VersionRange versionRange) Object o -> addSourceDependency o _ -> typeMismatch "String or an Object" v where - addSourceDependency o = Dependency <$> name <*> (Just <$> (local <|> git)) + addSourceDependency o = Dependency <$> name <*> (SourceDependency <$> (local <|> git)) where name :: Parser String name = o .: "name" @@ -412,8 +413,14 @@ instance FromJSON Dependency where subdir :: Parser (Maybe FilePath) subdir = o .:? "subdir" +data DependencyVersion = + AnyVersion + | VersionRange String + | SourceDependency SourceDependency + deriving (Eq, Show) + data SourceDependency = GitRef GitUrl GitRef (Maybe FilePath) | Local FilePath - deriving (Eq, Show, Ord) + deriving (Eq, Show) type GitUrl = String type GitRef = String diff --git a/src/Hpack/Dependency.hs b/src/Hpack/Dependency.hs new file mode 100644 index 00000000..482936df --- /dev/null +++ b/src/Hpack/Dependency.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE CPP #-} +module Hpack.Dependency ( + parseDependency +) where + +import Prelude () +import Prelude.Compat + +import Text.PrettyPrint (renderStyle, Style(..), Mode(..)) +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 + +dependencyName :: D.Dependency -> String +#if MIN_VERSION_Cabal(2,0,0) +dependencyName = D.unPackageName . D.depPkgName +#else +dependencyName (D.Dependency (D.PackageName name) _) = name +#endif + +dependencyVersionRange :: D.Dependency -> D.VersionRange +#if MIN_VERSION_Cabal(2,0,0) +dependencyVersionRange = D.depVerRange +#else +dependencyVersionRange (D.Dependency _ versionRange) = versionRange +#endif + +parseDependency :: Monad m => String -> m (String, Maybe String) +parseDependency = fmap render . parseCabalDependency + where + render :: D.Dependency -> (String, Maybe String) + render d = (name, range) + where + name = dependencyName d + versionRange = dependencyVersionRange d + + range + | D.isAnyVersion versionRange = Nothing + | otherwise = Just . renderStyle style . D.disp $ versionRange + where + style = Style OneLineMode 0 0 + +parseCabalDependency :: Monad m => String -> m D.Dependency +parseCabalDependency s = case [d | (d, "") <- D.readP_to_S D.parse s] of + [d] -> return d + _ -> fail $ "invalid dependency " ++ show s diff --git a/src/Hpack/Run.hs b/src/Hpack/Run.hs index 875d820e..ccf4b412 100644 --- a/src/Hpack/Run.hs +++ b/src/Hpack/Run.hs @@ -200,7 +200,7 @@ renderExecutableSection sect@(sectionData -> Executable{..}) = 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 +232,8 @@ renderSection Section{..} = [ , 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,8 +265,16 @@ renderOtherModules = Field "other-modules" . LineSeparatedList renderReexportedModules :: [String] -> Element renderReexportedModules = Field "reexported-modules" . LineSeparatedList -renderDependencies :: [Dependency] -> Element -renderDependencies = Field "build-depends" . CommaSeparatedList . map dependencyName +renderDependencies :: String -> [Dependency] -> Element +renderDependencies name = Field name . CommaSeparatedList . map renderDependency + +renderDependency :: Dependency -> String +renderDependency (Dependency name version) = name ++ v + where + v = case version of + AnyVersion -> "" + VersionRange x -> " " ++ x + SourceDependency _ -> "" renderGhcOptions :: [GhcOption] -> Element renderGhcOptions = Field "ghc-options" . WordList @@ -294,9 +302,3 @@ renderDefaultExtensions = Field "default-extensions" . WordList 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 index 34f6bc84..8cde2b5b 100644 --- a/test/Hpack/ConfigSpec.hs +++ b/test/Hpack/ConfigSpec.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Hpack.ConfigSpec ( spec @@ -17,11 +18,15 @@ import Control.Arrow import System.Directory (createDirectory) import Data.Yaml import Data.Either.Compat +import Data.String import Hpack.Util import Hpack.Config hiding (package) import qualified Hpack.Config as Config +instance IsString Dependency where + fromString name = Dependency name AnyVersion + package :: Package package = Config.package "foo" "0.0.0" @@ -219,67 +224,76 @@ spec = do `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) + context "when parsing simple dependencies" $ do + it "accepts simple dependencies" $ do + parseEither parseJSON "hpack" `shouldBe` Right (Dependency "hpack" AnyVersion) + + it "accepts dependencies with version" $ do + parseEither parseJSON "hpack >= 2 && < 3" `shouldBe` Right (Dependency "hpack" (VersionRange ">=2 && <3")) + + context "with invalid version" $ do + it "returns an error message" $ do + parseEither parseJSON "hpack ==" `shouldBe` (Left "Error in $: invalid dependency \"hpack ==\"" :: Either String Dependency) + + context "when parsing source dependencies" $ do + 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" (SourceDependency 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" (SourceDependency 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" (SourceDependency source)) + + it "accepts local dependencies" $ do + let value = [aesonQQ|{ + name: "hpack", + path: "../hpack" + }|] + source = Local "../hpack" + parseEither parseJSON value `shouldBe` Right (Dependency "hpack" (SourceDependency 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 @@ -721,10 +735,14 @@ spec = do 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 >>> (`shouldBe` Just [ + Dependency "foo" (VersionRange ">1.0") + , Dependency "bar" (VersionRange "==2.0") + ]) + ) it "allows yaml merging and overriding fields" $ do withPackageConfig_ [i| diff --git a/test/Hpack/DependencySpec.hs b/test/Hpack/DependencySpec.hs new file mode 100644 index 00000000..3b83062a --- /dev/null +++ b/test/Hpack/DependencySpec.hs @@ -0,0 +1,14 @@ +module Hpack.DependencySpec (spec) where + +import Test.Hspec + +import Hpack.Dependency + +spec :: Spec +spec = do + describe "parseDependency" $ do + it "parses a dependency" $ do + parseDependency "foo" `shouldBe` Just ("foo", Nothing) + + it "parses a dependency with version range" $ do + parseDependency "foo == 1.0" `shouldBe` Just ("foo", Just "==1.0") diff --git a/test/Hpack/RunSpec.hs b/test/Hpack/RunSpec.hs index b93805a0..ac212a11 100644 --- a/test/Hpack/RunSpec.hs +++ b/test/Hpack/RunSpec.hs @@ -225,7 +225,7 @@ spec = do 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 = [Dependency "foo" (VersionRange "== 0.1.0"), Dependency "bar" AnyVersion]}]} `shouldBe` unlines [ "name: foo" , "version: 0.0.0" , "build-type: Simple" @@ -234,10 +234,8 @@ spec = do , "executable foo" , " main-is: Main.hs" , " build-depends:" - , " foo" + , " foo == 0.1.0" , " , bar" - , " , foo" - , " , baz" , " default-language: Haskell2010" ]