Support deeper subdirectory for github

CHANGELOG.md

@@ -1,3 +1,6 @@
+## Changes in 0.34.5
+  - Support deeper subdirectory for github
+
 ## Changes in 0.34.4
   - Render `default-extensions` / `other-extensions` line-separated
   - Compatibility with `Cabal-3.4.0.0`

hpack.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           hpack
-version:        0.34.4
+version:        0.34.5
 synopsis:       A modern format for Haskell packages
 description:    See README at <https://github.com/sol/hpack#readme>
 category:       Development

package.yaml

@@ -1,5 +1,5 @@
 name: hpack
-version: 0.34.4
+version: 0.34.5
 synopsis: A modern format for Haskell packages
 description: See README at <https://github.com/sol/hpack#readme>
 maintainer: Simon Hengel <sol@typeful.net>

src/Hpack/Config.hs

@@ -583,10 +583,37 @@ data GitHub = GitHub {
 instance FromValue GitHub where
   fromValue v = do
     input <- fromValue v
-    case map T.unpack $ T.splitOn "/" input of
-      [owner, repo, subdir] -> return $ GitHub owner repo (Just subdir)
-      [owner, repo] -> return $ GitHub owner repo Nothing
-      _ -> fail $ "expected owner/repo or owner/repo/subdir, but encountered " ++ show input
+    let parsed = case map T.unpack $ T.splitOn "/" input of
+          -- Bad: empty: ""
+          [] ->
+            Nothing
+
+          -- Bad: starts with a slash: "/..."
+          "" : _rest ->
+            Nothing
+
+          -- Bad: starts with an URL-like protocol: "https:...", "git:..."
+          proto : _rest | last proto == ':' ->
+            Nothing
+
+          -- Bad: single path piece: "sol"
+          [_owner] ->
+            Nothing
+
+          -- Good: "sol/hpack"
+          [owner, repo] ->
+
+            Just $ GitHub owner repo Nothing
+
+          -- Good: "sol/hpack/subdir", "sol/hpack/deep/subdir/..."
+          owner : repo : subdirs ->
+            Just $ GitHub owner repo (Just $ intercalate "/" subdirs)
+
+    case parsed of
+      Nothing ->
+        fail $ "expected \"owner/repo\" or \"owner/repo/subdir\", but encountered " ++ show input
+      Just ok ->
+        return ok
 
 data DefaultsConfig = DefaultsConfig {
   defaultsConfigDefaults :: Maybe (List Defaults)