Newer haddock, newer odditiesHEADmaster

2 files changed, 44 insertions, 20 deletions

diff --git a/Main.hs b/Main.hs
index 052827b..a570670 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ViewPatterns #-}
 module Main (main) where
 
 import Control.Monad (ap, void, forM)
@@ -21,13 +22,13 @@ import System.IO (hPutStrLn, stderr, hFlush, stdout)
 import Control.Applicative (Alternative(..))
 
 
-data Link = BootLib ByteString  -- ^ packagename-version
+data Link = Package ByteString  -- ^ packagename-version
                     ByteString  -- ^ path (including #anchor)
           | Broken ByteString  -- ^ packagename-version
   deriving (Show)
 
 renderLink :: Link -> Builder
-renderLink (BootLib pkg path) =
+renderLink (Package pkg path) =
   mconcat [BSB.string8 "https://hackage.haskell.org/package/"
           ,BSB.byteString pkg
           ,BSB.string8 "/docs/"
@@ -48,24 +49,47 @@ instance Alternative Parser where
   Parser f <|> Parser g = Parser $ \s -> f s <|> g s
 
 parseLink :: Parser Link
-parseLink = do
-  let endOfLink c = isSpace c || c `elem` "\"'"
-  string "../" <|> return ()
-  string "file:///"
-  search (void $ satisfy endOfLink)
-         (string ".ghcup")
-  string "/ghc/"
-  _ <- word (/= '/')  -- "9.2.2"
-  string "/share/doc/ghc-"
-  _ <- word (/= '/')  -- "9.2.2"
-  string "/html/libraries/"
-  pkg <- word (/= '/')
-  string "/"
-  path <- word (not . endOfLink)
-  if path == Char8.pack "src"
-    then return (Broken pkg)
-    else return (BootLib pkg path)
+parseLink = parsePackageLink <|> parseBootlibLink
   where
+    endOfLink c = isSpace c || c `elem` "\"'"
+
+    parseBootlibLink :: Parser Link
+    parseBootlibLink = do
+      string "${pkgroot}/"  -- wtf haddock?
+      _ <- many (string "../")
+      string "share/doc/ghc-"
+      _ghcversion <- word (/= '/')
+      string "/html/libraries/"
+      pkg <- word (/= '/')
+      string "/"
+      path <- word (not . endOfLink)
+      if path == Char8.pack "src"
+        then return (Broken pkg)  -- not sure if this happens in practice
+        else return (Package pkg path)
+
+    parsePackageLink :: Parser Link
+    parsePackageLink = do
+      string "file://"
+      search (void $ satisfy endOfLink)
+             (string "/.cabal/")
+      string "store/ghc-"
+      _ghcversion <- word (/= '/')
+      string "/"
+      namewithhash <- word (/= '/')
+      let pkg =
+            case BS.spanEnd ((`elem` "0123456789abcdefABCDEF") . tochar) namewithhash of
+              (pre, hash)
+                | BS.length hash == 64
+                , Just (pre', tochar -> '-') <- BS.unsnoc pre ->
+                    pre'
+                | otherwise ->
+                    namewithhash
+      string "/share/doc/html/"
+      path <- word (not . endOfLink)
+      if path == Char8.pack "src"
+        then return (Broken pkg)
+        else return (Package pkg path)
+
     string :: String -> Parser ()
     string w =
       let w' = Char8.pack w
diff --git a/haddock-to-standalone.cabal b/haddock-to-standalone.cabal
index 795914a..609b80b 100644
--- a/haddock-to-standalone.cabal
+++ b/haddock-to-standalone.cabal
@@ -11,7 +11,7 @@ executable haddock-to-standalone
   main-is:
     Main.hs
   build-depends:
-    base >= 4.13 && < 4.15,
+    base >= 4.13 && < 4.19,
     bytestring >= 0.11.3.1 && < 0.12,
     directory >= 1.3.7.0 && < 1.4,
     filepath >= 1.4.2.2 && < 1.5