Haskell script for rewriting absolute docs/ links in Docusaurus docs to relative ones.

link-rewrite.hs

#!/usr/bin/env cabal

{- cabal:
  build-depends: base >= 4.7 && < 5, split, directory, filepath, extra
-}
{-# LANGUAGE BangPatterns #-}

import Control.Monad (forM, forM_)
import Control.Monad.Extra (partitionM)
import Data.List.Split (splitOn)
import qualified System.Directory as SD
import System.FilePath (splitPath, (</>))

main :: IO ()
main = do
  files <- listAllFiles "docs"
  forM_ files $ \filePath -> do
    !content <- readFile filePath
    content' <- rewriteLinks filePath content
    writeFile filePath content'

rewriteLinks :: FilePath -> String -> IO String
rewriteLinks filePath contents = do
  let chunks = splitOn "(/docs/" contents
  let snippets = zip chunks (tail chunks)
  rewrites <- forM snippets $ \(left, right) -> do
    putStrLn ""
    putStrLn $ "\ESC[33m" <> "== " <> filePath <> " ==" <> "\ESC[0m"
    putStrLn $ last (lines left) <> "\ESC[32m" <> "(/docs/" <> "\ESC[0m" <> head (lines right)
    answer <- getLine
    let rewrite =
          if answer == "n"
            then "(/docs/"
            else case fileDepth of
              0 -> "(./"
              n -> "(" <> concat (replicate n "../")
    putStrLn $ "Rewrite: " <> rewrite
    return rewrite
  return $ concat $ zipWith (<>) chunks $ rewrites <> [""]
  where
    fileDepth = length (splitPath filePath) - 2

listAllFiles :: FilePath -> IO [FilePath]
listAllFiles rootDir = do
  items <- map (rootDir </>) <$> SD.listDirectory rootDir
  (files, dirs) <- partitionM SD.doesFileExist items
  (files <>) . concat <$> mapM listAllFiles dirs