%  Copyright (C) 2002-2003 David Roundy
%
%  This program is free software; you can redistribute it and/or modify
%  it under the terms of the GNU General Public License as published by
%  the Free Software Foundation; either version 2, or (at your option)
%  any later version.
%
%  This program is distributed in the hope that it will be useful,
%  but WITHOUT ANY WARRANTY; without even the implied warranty of
%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%  GNU General Public License for more details.
%
%  You should have received a copy of the GNU General Public License
%  along with this program; if not, write to the Free Software Foundation,
%  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

FileName is an abstract type intended to facilitate the input and output of
unicode filenames.

\begin{code}
module FileName ( FileName( ),
                  fp2fn, fn2fp,
                  fn2ps, fn2s, s2fn, ps2fn,
                  break_on_dir, norm_path, own_name, super_name,
                  (///),
                ) where

import IO
import Char ( isSpace, chr, ord )
import qualified UTF8 ( encode, decode )
import Data.Word ( Word8( ) )
import FastPackedString ( PackedString( ),
                          packWords, unpackPSfromUTF8,
                        )
\end{code}

\begin{code}
newtype FileName = FN FilePath deriving ( Eq, Ord )
encode :: [Char] -> [Word8]
encode = UTF8.encode
decode :: [Word8] -> [Char]
decode = fst . UTF8.decode

{-# INLINE fp2fn #-}
fp2fn :: FilePath -> FileName
fp2fn fp = FN fp

{-# INLINE fn2fp #-}
fn2fp :: FileName -> FilePath
fn2fp (FN fp) = fp

{-# INLINE fn2ps #-}
fn2ps :: FileName -> PackedString
fn2ps (FN fp) = packWords $ encode $ encode_white fp

{-# INLINE fn2s #-}
fn2s :: FileName -> String
fn2s (FN fp) = encode_white fp

{-# INLINE s2fn #-}
s2fn :: String -> FileName
s2fn s = FN $ decode_white $ decode $ map (fromIntegral.ord) s

{-# INLINE ps2fn #-}
ps2fn :: PackedString -> FileName
ps2fn ps = FN $ decode_white $ unpackPSfromUTF8 ps

encode_white :: FilePath -> String
encode_white (c:cs) | isSpace c || c == '\\' =
    '\\' : (show $ ord c) ++ "\\" ++ encode_white cs
encode_white (c:cs) = c : encode_white cs
encode_white [] = []

decode_white :: String -> FilePath
decode_white ('\\':cs) =
    case break (=='\\') cs of
    (theord, '\\':rest) ->
        chr (read theord) : decode_white rest
    _ -> error "malformed filename"
decode_white (c:cs) = c: decode_white cs
decode_white "" = ""
\end{code}

\begin{code}
own_name :: FileName -> FileName
own_name (FN f) = case breakLast '/' f of Nothing -> FN f
                                          Just (_,f') -> FN f'
super_name :: FileName -> FileName
super_name fn = case norm_path fn of
                FN f -> case breakLast '/' f of
                        Nothing -> FN "."
                        Just (d,_) -> FN d
break_on_dir :: FileName -> Maybe (FileName,FileName)
break_on_dir (FN p) = case breakFirst '/' p of
                      Nothing -> Nothing
                      Just (d,f) | d == "." -> break_on_dir $ FN f
                                 | otherwise -> Just (FN d, FN f)
norm_path :: FileName -> FileName -- remove "./"
norm_path (FN p) = FN $ repath $ drop_dotdot $
                   filter (/= "") $ filter (/= ".") $ breakup p

repath :: [String] -> String
repath [] = ""
repath [f] = f
repath (d:p) = d ++ "/" ++ repath p

drop_dotdot :: [String] -> [String]
drop_dotdot (_:"..":p) = drop_dotdot p
drop_dotdot (d:p) = case drop_dotdot p of
                    ("..":p') -> p'
                    p' -> d : p'
drop_dotdot [] = []

breakup :: String -> [String]
breakup p = case break (=='/') p of
            (d,"") -> [d]
            (d,p') -> d : breakup (tail p')

breakFirst :: Char -> String -> Maybe (String,String)
breakFirst c l = bf [] l
    where bf a (r:rs) | r == c = Just (reverse a,rs)
                      | otherwise = bf (r:a) rs
          bf _ [] = Nothing
breakLast :: Char -> String -> Maybe (String,String)
breakLast c l = case breakFirst c (reverse l) of
                Nothing -> Nothing
                Just (a,b) -> Just (reverse b, reverse a)

(///) :: FileName -> FileName -> FileName
(FN "")///b = norm_path b
a///b = norm_path $ fp2fn $ fn2fp a ++ "/" ++ fn2fp b
\end{code}