1{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-} 2 3module Development.Shake.Internal.FileName( 4 FileName, 5 fileNameFromString, fileNameFromByteString, 6 fileNameToString, fileNameToByteString, 7 filepathNormalise 8 ) where 9 10import qualified Data.ByteString.Char8 as BS 11import qualified Data.ByteString.UTF8 as UTF8 12import Development.Shake.Classes 13import qualified System.FilePath as Native 14import General.Binary 15import System.Info.Extra 16import Data.List 17 18 19--------------------------------------------------------------------- 20-- FileName newtype 21 22-- | UTF8 ByteString 23newtype FileName = FileName BS.ByteString 24 deriving (Hashable, Binary, BinaryEx, Eq, NFData) 25 26instance Show FileName where 27 show = fileNameToString 28 29instance BinaryEx [FileName] where 30 putEx = putEx . map (\(FileName x) -> x) 31 getEx = map FileName . getEx 32 33fileNameToString :: FileName -> FilePath 34fileNameToString = UTF8.toString . fileNameToByteString 35 36fileNameToByteString :: FileName -> BS.ByteString 37fileNameToByteString (FileName x) = x 38 39fileNameFromString :: FilePath -> FileName 40fileNameFromString = fileNameFromByteString . UTF8.fromString 41 42fileNameFromByteString :: BS.ByteString -> FileName 43fileNameFromByteString = FileName . filepathNormalise 44 45 46--------------------------------------------------------------------- 47-- NORMALISATION 48 49-- | Equivalent to @toStandard . normaliseEx@ from "Development.Shake.FilePath". 50filepathNormalise :: BS.ByteString -> BS.ByteString 51filepathNormalise xs 52 | isWindows, Just (a,xs) <- BS.uncons xs, sep a, Just (b,_) <- BS.uncons xs, sep b = '/' `BS.cons` f xs 53 | otherwise = f xs 54 where 55 sep = Native.isPathSeparator 56 f o = deslash o $ BS.concat $ (slash:) $ intersperse slash $ reverse $ (BS.empty:) $ g 0 $ reverse $ split o 57 58 deslash o x 59 | x == slash = case (pre,pos) of 60 (True,True) -> slash 61 (True,False) -> BS.pack "/." 62 (False,True) -> BS.pack "./" 63 (False,False) -> dot 64 | otherwise = (if pre then id else BS.tail) $ (if pos then id else BS.init) x 65 where pre = not (BS.null o) && sep (BS.head o) 66 pos = not (BS.null o) && sep (BS.last o) 67 68 g i [] = replicate i dotDot 69 g i (x:xs) | BS.null x = g i xs 70 g i (x:xs) | x == dotDot = g (i+1) xs 71 g i (x:xs) | x == dot = g i xs 72 g 0 (x:xs) = x : g 0 xs 73 g i (_:xs) = g (i-1) xs -- equivalent to eliminating ../x 74 75 split = BS.splitWith sep 76 77dotDot = BS.pack ".." 78dot = BS.singleton '.' 79slash = BS.singleton '/' 80