Make hackageIndexLayout faster (#343)

Before these patches `hackageIndexLayout` takes up to 50% of `cabal
update` time. With the patches applied this reduces to ~10% of `cabal
update`, making it almost 2x faster.

I originally developed this code for
[`hackage-revdeps`](https://github.com/Bodigrim/hackage-revdeps/blob/master/src/Hackage/RevDeps.hs#L133),
so the approach has been exercised for some time. Besides,
`hackageIndexLayout` is covered by tests for `hackage-security`.

Author: Mikolaj

hackage-security/src/Hackage/Security/TUF/Layout/Index.hs

@@ -10,9 +10,12 @@ module Hackage.Security.TUF.Layout.Index (
   ) where
 
 import Prelude
+import Data.Char (ord)
 import Data.Kind (Type)
 import Distribution.Package
 import Distribution.Text
+import Distribution.Types.Version (mkVersion)
+import System.FilePath.Posix (isPathSeparator)
 
 import Hackage.Security.TUF.Paths
 import Hackage.Security.TUF.Signed
@@ -91,17 +94,38 @@ hackageIndexLayout = IndexLayout {
     fromFragments :: [String] -> IndexPath
     fromFragments = rootPath . joinFragments
 
+    -- This function is called in a hot loop, take care when modifying it.
+    -- Especially avoid 'splitFragments' / 'splitDirectories' and other high-level helpers,
+    -- they are very slow.
     fromPath :: IndexPath -> Maybe (Some IndexFile)
-    fromPath fp = case splitFragments (unrootPath fp) of
-      [pkg, version, _file] -> do
-        pkgId <- simpleParse (pkg ++ "-" ++ version)
-        case takeExtension fp of
-          ".cabal"   -> return $ Some $ IndexPkgCabal    pkgId
-          ".json"    -> return $ Some $ IndexPkgMetadata pkgId
-          _otherwise -> Nothing
-      [pkg, "preferred-versions"] ->
-        Some . IndexPkgPrefs <$> simpleParse pkg
-      _otherwise -> Nothing
+    fromPath fp = case break isPathSeparator (toUnrootedFilePath (unrootPath fp)) of
+      (pkg, "/preferred-versions") ->
+        return $ Some $ IndexPkgPrefs $ mkPackageName pkg
+      (pkg, rest) -> case break isPathSeparator (drop 1 rest) of
+        (_, []) -> Nothing
+        (version, basename) -> do
+          let pkgName = mkPackageName pkg
+              pkgVersion = mkVersion $ readVersion version
+              pkgId = PackageIdentifier { pkgName, pkgVersion }
+          case reverse basename of
+            -- ".cabal" reversed
+            'l' : 'a' : 'b' : 'a' : 'c' : '.' : _ ->
+              return $ Some $ IndexPkgCabal pkgId
+            -- ".json" reversed
+            'n' : 'o' : 's' : 'j' : '.' : _ ->
+              return $ Some $ IndexPkgMetadata pkgId
+            _ -> Nothing
+
+-- Convert "3.12.1.0" to [3,12,1,0].
+-- Copied from hackage-revdeps package.
+readVersion :: String -> [Int]
+readVersion = (\(acc, _mult, rest) -> acc : rest) . foldr go (0, 1, [])
+  where
+    go c (acc, mult, rest)
+      | fromIntegral d < (10 :: Word) = (acc + d * mult, mult * 10, rest)
+      | otherwise = (0, 1, acc : rest)
+      where
+        d = ord c - ord '0'
 
 {-------------------------------------------------------------------------------
   Utility