relpath

module Main where

import System.Environment (getArgs)
import System.FilePath
import Data.Maybe (isJust)

main :: IO ()
main = do [from, to] <- getArgs
          print (relative from to)

relative :: FilePath -> FilePath -> FilePath
relative from to = case removePrefix (splitDirectories from) (splitDirectories to) of
    (Nothing:_, Nothing:_) -> "."
    (xs, ys) -> joinPath $ [".."| _ <- takeWhile isJust xs] ++ [y | Just y <- takeWhile isJust ys]

removePrefix :: [FilePath] -> [FilePath] -> ([Maybe FilePath], [Maybe FilePath])
removePrefix xs ys =
    unzip $ dropWhile (\z -> case z of {(Nothing, Nothing) -> False; (x, y) -> x == y }) $ zip (stream xs) (stream ys)
  where stream zs = fmap Just zs  ++ repeat Nothing