{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-}

module Development.Shake.Internal.FileName(
    FileName,
    fileNameFromString, fileNameFromByteString,
    fileNameToString, fileNameToByteString,
    filepathNormalise
    ) 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 General.Binary
import System.Info.Extra
import Data.List


---------------------------------------------------------------------
-- Data.ByteString
-- Mostly because ByteString does not have an NFData instance in GHC 7.4

-- | UTF8 ByteString
newtype FileName = FileName BS.ByteString
    deriving (Hashable, Binary, BinaryEx, Eq)

instance NFData FileName where
    rnf (FileName x) = x `seq` ()

instance Show FileName where
    show = fileNameToString

instance BinaryEx [FileName] where
    putEx = putEx . map (\(FileName x) -> x)
    getEx = map FileName . getEx

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 = FileName . filepathNormalise


---------------------------------------------------------------------
-- NORMALISATION

-- | Equivalent to @toStandard . normaliseEx@ from "Development.Shake.FilePath".
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 -- equivalent to eliminating ../x

        split = BS.splitWith sep

dotDot = BS.pack ".."
dot = BS.singleton '.'
slash = BS.singleton '/'