module General.FileName(
FileName,
fileNameFromString, fileNameFromByteString,
fileNameToString, fileNameToByteString,
byteStringToFileName
) where
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.UTF8 as UTF8
import Development.Shake.Classes
import qualified System.FilePath as Native
import System.Info.Extra
import Data.List
data FileName = FileName Int !BS.ByteString
deriving Eq
instance NFData FileName where
rnf FileName{} = ()
instance Ord FileName where
compare (FileName _ a) (FileName _ b) = compare a b
instance Hashable FileName where
hashWithSalt _ = hash
hash (FileName x _) = x
instance Show FileName where
show = fileNameToString
fileNameToString :: FileName -> FilePath
fileNameToString = UTF8.toString . fileNameToByteString
fileNameToByteString :: FileName -> BS.ByteString
fileNameToByteString (FileName _ x) = x
fileNameFromString :: FilePath -> FileName
fileNameFromString = fileNameFromByteString . UTF8.fromString
fileNameFromByteString :: BS.ByteString -> FileName
fileNameFromByteString = byteStringToFileName . filepathNormalise
byteStringToFileName :: BS.ByteString -> FileName
byteStringToFileName x = FileName (hash x) x
filepathNormalise :: BS.ByteString -> BS.ByteString
filepathNormalise xs
| isWindows, Just (a,xs) <- BS.uncons xs, sep a, Just (b,_) <- BS.uncons xs, sep b = '/' `BS.cons` f xs
| otherwise = f xs
where
sep = Native.isPathSeparator
f o = deslash o $ BS.concat $ (slash:) $ intersperse slash $ reverse $ (BS.empty:) $ g 0 $ reverse $ split o
deslash o x
| x == slash = case (pre,pos) of
(True,True) -> slash
(True,False) -> BS.pack "/."
(False,True) -> BS.pack "./"
(False,False) -> dot
| otherwise = (if pre then id else BS.tail) $ (if pos then id else BS.init) x
where pre = not (BS.null o) && sep (BS.head o)
pos = not (BS.null o) && sep (BS.last o)
g i [] = replicate i dotDot
g i (x:xs) | BS.null x = g i xs
g i (x:xs) | x == dotDot = g (i+1) xs
g i (x:xs) | x == dot = g i xs
g 0 (x:xs) = x : g 0 xs
g i (_:xs) = g (i-1) xs
split = BS.splitWith sep
dotDot = BS.pack ".."
dot = BS.singleton '.'
slash = BS.singleton '/'