src/UglyFileName.lhs

   1 %  Copyright (C) 2002-2003,2008 David Roundy
   2 %
   3 %  This program is free software; you can redistribute it and/or modify
   4 %  it under the terms of the GNU General Public License as published by
   5 %  the Free Software Foundation; either version 2, or (at your option)
   6 %  any later version.
   7 %
   8 %  This program is distributed in the hope that it will be useful,
   9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 %  GNU General Public License for more details.
  12 %
  13 %  You should have received a copy of the GNU General Public License
  14 %  along with this program; see the file COPYING.  If not, write to
  15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  16 %  Boston, MA 02110-1301, USA.
  17
  18
  19 THIS MODULE IS DEPRECATED.  DON'T USE IT FOR ANYTHING NEW, AND REMOVE
  20 CODE FROM IT WHEN POSSIBLE!
  21
  22 \begin{code}
  23 module UglyFileName ( fp2fn, fn2fp,
  24                       norm_path, own_name, super_name,
  25                       patch_filename,
  26                       breakup, is_explicitly_relative,
  27                     ) where
  28
  29 -- THIS MODULE IS DEPRECATED.  DON'T USE IT FOR ANYTHING NEW, AND
  30 -- REMOVE CODE FROM IT WHEN POSSIBLE! WE'D LIKE TO REMOVE IT SOON...
  31
  32 import System.IO
  33 import Data.Char ( isAlpha, isSpace, isDigit, toLower )
  34 \end{code}
  35
  36 \begin{code}
  37 newtype FileName = FN FilePath deriving ( Eq, Ord )
  38
  39 instance Show FileName where
  40    showsPrec d (FN fp) = showParen (d > app_prec) $ showString "fp2fn " . showsPrec (app_prec + 1) fp
  41       where app_prec = 10
  42
  43 {-# INLINE fp2fn #-}
  44 fp2fn :: FilePath -> FileName
  45 fp2fn fp = FN fp
  46
  47 {-# INLINE fn2fp #-}
  48 fn2fp :: FileName -> FilePath
  49 fn2fp (FN fp) = fp
  50 \end{code}
  51
  52 \begin{code}
  53 own_name :: FileName -> FileName
  54 own_name (FN f) = case breakLast '/' f of Nothing -> FN f
  55                                           Just (_,f') -> FN f'
  56 super_name :: FileName -> FileName
  57 super_name fn = case norm_path fn of
  58                 FN f -> case breakLast '/' f of
  59                         Nothing -> FN "."
  60                         Just ("",_) -> FN "/"
  61                         Just (d ,_) -> FN d
  62
  63 norm_path :: FileName -> FileName -- remove "./"
  64 norm_path (FN p) = FN $ repath $ drop_dotdot $ breakup p
  65
  66 repath :: [String] -> String
  67 repath [] = ""
  68 repath [f] = f
  69 repath (d:p) = d ++ "/" ++ repath p
  70
  71 drop_dotdot :: [String] -> [String]
  72 drop_dotdot [] = []
  73 drop_dotdot f@(a:b)
  74     | null a = "" : (drop_dotdot' b) -- first empty element is important
  75                                      -- for absolute paths
  76     | otherwise = drop_dotdot' f
  77     where drop_dotdot' ("":p) = drop_dotdot' p
  78           drop_dotdot' (".":p) = drop_dotdot' p
  79           drop_dotdot' ("..":p) = ".." : (drop_dotdot' p)
  80           drop_dotdot' (_:"..":p) = drop_dotdot' p
  81           drop_dotdot' (d:p) = case drop_dotdot' p of
  82                                  ("..":p') -> p'
  83                                  p' -> d : p'
  84           drop_dotdot' [] = []
  85
  86 breakup :: String -> [String]
  87 breakup p = case break (=='/') p of
  88             (d,"") -> [d]
  89             (d,p') -> d : breakup (tail p')
  90
  91 breakFirst :: Char -> String -> Maybe (String,String)
  92 breakFirst c l = bf [] l
  93     where bf a (r:rs) | r == c = Just (reverse a,rs)
  94                       | otherwise = bf (r:a) rs
  95           bf _ [] = Nothing
  96 breakLast :: Char -> String -> Maybe (String,String)
  97 breakLast c l = case breakFirst c (reverse l) of
  98                 Nothing -> Nothing
  99                 Just (a,b) -> Just (reverse b, reverse a)
 100
 101 safeFileChar :: Char -> Char
 102 safeFileChar c | isAlpha c = toLower c
 103                | isDigit c = c
 104                | isSpace c = '-'
 105 safeFileChar _ = '_'
 106
 107 patch_filename :: String -> String
 108 patch_filename summary = name ++ ".dpatch"
 109     where name = map safeFileChar summary
 110
 111 \end{code}
 112
 113 \begin{code}
 114 is_explicitly_relative :: String -> Bool
 115 is_explicitly_relative ('.':'/':_) = True  -- begins with "./"
 116 is_explicitly_relative _ = False
 117 \end{code}