Utility to make symlinks relative

Relativize.hs

import Control.Monad
import Data.Functor
import Numeric
import System.Directory (canonicalizePath)
import System.Environment
import System.FilePath
import System.IO
import System.Posix.Files
import Text.Printf

main = getArgs
    >>= filterM fileExist
    >>= filterM isLink
    >>= mapM withLink
    >>= filterM nonRelative
    >>= mapM relativize
    >>= mapM_ relink

isLink fp = isSymbolicLink <$> getSymbolicLinkStatus fp

withLink fp = do
    lp <- readSymbolicLink fp
    return (fp, lp)

nonRelative = return . not . isRelative . snd

relativize (fp, lp) = do
    base <- canonicalizePath (takeDirectory fp)
    return (fp, makeRelative' base lp)

makeRelative' fromPath toPath = reversePath fromPath'' </> toPath''
  where fromPath'  = splitPath' fromPath ++ repeat ""
        toPath'    = splitPath' toPath   ++ repeat ""
        paired     = zip fromPath' toPath'
        paired'    = dropWhile (uncurry (==)) paired
        fromPath'' = joinPath $ takeWhile (not . null) $ map fst paired'
        toPath''   = joinPath $ takeWhile (not . null) $ map snd paired'

reversePath = joinPath . map (const "..") . splitPath

splitPath' = drop 1 . map (takeWhile (/= '/')) . splitPath

relink (f, l) = putStrLn $ printf "ln -sf %s %s" (show l) (show f)