Depend on Cabal for dependency parsing

(similar to #64, needed for #193)

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

package.yaml

@@ -24,6 +24,8 @@ dependencies:
   - unordered-containers
   - yaml
   - aeson >= 0.11
+  - Cabal
+  - pretty
 
 library:
   source-dirs: src

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

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

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

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|