{-# 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


---------------------------------------------------------------------
-- FileName newtype

-- | UTF8 ByteString
newtype FileName = FileName BS.ByteString
    deriving (Int -> FileName -> Int
FileName -> Int
(Int -> FileName -> Int) -> (FileName -> Int) -> Hashable FileName
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: FileName -> Int
$chash :: FileName -> Int
hashWithSalt :: Int -> FileName -> Int
$chashWithSalt :: Int -> FileName -> Int
Hashable, Get FileName
[FileName] -> Put
FileName -> Put
(FileName -> Put)
-> Get FileName -> ([FileName] -> Put) -> Binary FileName
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [FileName] -> Put
$cputList :: [FileName] -> Put
get :: Get FileName
$cget :: Get FileName
put :: FileName -> Put
$cput :: FileName -> Put
Binary, ByteString -> FileName
FileName -> Builder
(FileName -> Builder)
-> (ByteString -> FileName) -> BinaryEx FileName
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> FileName
$cgetEx :: ByteString -> FileName
putEx :: FileName -> Builder
$cputEx :: FileName -> Builder
BinaryEx, FileName -> FileName -> Bool
(FileName -> FileName -> Bool)
-> (FileName -> FileName -> Bool) -> Eq FileName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileName -> FileName -> Bool
$c/= :: FileName -> FileName -> Bool
== :: FileName -> FileName -> Bool
$c== :: FileName -> FileName -> Bool
Eq, FileName -> ()
(FileName -> ()) -> NFData FileName
forall a. (a -> ()) -> NFData a
rnf :: FileName -> ()
$crnf :: FileName -> ()
NFData)

instance Show FileName where
    show :: FileName -> String
show = FileName -> String
fileNameToString

instance BinaryEx [FileName] where
    putEx :: [FileName] -> Builder
putEx = [ByteString] -> Builder
forall a. BinaryEx a => a -> Builder
putEx ([ByteString] -> Builder)
-> ([FileName] -> [ByteString]) -> [FileName] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileName -> ByteString) -> [FileName] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\(FileName ByteString
x) -> ByteString
x)
    getEx :: ByteString -> [FileName]
getEx = (ByteString -> FileName) -> [ByteString] -> [FileName]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> FileName
FileName ([ByteString] -> [FileName])
-> (ByteString -> [ByteString]) -> ByteString -> [FileName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall a. BinaryEx a => ByteString -> a
getEx

fileNameToString :: FileName -> FilePath
fileNameToString :: FileName -> String
fileNameToString = ByteString -> String
UTF8.toString (ByteString -> String)
-> (FileName -> ByteString) -> FileName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> ByteString
fileNameToByteString

fileNameToByteString :: FileName -> BS.ByteString
fileNameToByteString :: FileName -> ByteString
fileNameToByteString (FileName ByteString
x) = ByteString
x

fileNameFromString :: FilePath -> FileName
fileNameFromString :: String -> FileName
fileNameFromString = ByteString -> FileName
fileNameFromByteString (ByteString -> FileName)
-> (String -> ByteString) -> String -> FileName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString

fileNameFromByteString :: BS.ByteString -> FileName
fileNameFromByteString :: ByteString -> FileName
fileNameFromByteString = ByteString -> FileName
FileName (ByteString -> FileName)
-> (ByteString -> ByteString) -> ByteString -> FileName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
filepathNormalise


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

-- | Equivalent to @toStandard . normaliseEx@ from "Development.Shake.FilePath".
filepathNormalise :: BS.ByteString -> BS.ByteString
filepathNormalise :: ByteString -> ByteString
filepathNormalise ByteString
xs
    | Bool
isWindows, Just (Char
a,ByteString
xs) <- ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
xs, Char -> Bool
sep Char
a, Just (Char
b,ByteString
_) <- ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
xs, Char -> Bool
sep Char
b = Char
'/' Char -> ByteString -> ByteString
`BS.cons` ByteString -> ByteString
f ByteString
xs
    | Bool
otherwise = ByteString -> ByteString
f ByteString
xs
    where
        sep :: Char -> Bool
sep = Char -> Bool
Native.isPathSeparator
        f :: ByteString -> ByteString
f ByteString
o = ByteString -> ByteString -> ByteString
deslash ByteString
o (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString
slashByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
intersperse ByteString
slash ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ (ByteString
BS.emptyByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> [ByteString] -> [ByteString]
g Int
0 ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
split ByteString
o

        deslash :: ByteString -> ByteString -> ByteString
deslash ByteString
o ByteString
x
            | ByteString
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
slash = case (Bool
pre,Bool
pos) of
                (Bool
True,Bool
True) -> ByteString
slash
                (Bool
True,Bool
False) -> String -> ByteString
BS.pack String
"/."
                (Bool
False,Bool
True) -> String -> ByteString
BS.pack String
"./"
                (Bool
False,Bool
False) -> ByteString
dot
            | Bool
otherwise = (if Bool
pre then ByteString -> ByteString
forall a. a -> a
id else ByteString -> ByteString
BS.tail) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (if Bool
pos then ByteString -> ByteString
forall a. a -> a
id else ByteString -> ByteString
BS.init) ByteString
x
            where pre :: Bool
pre = Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
o) Bool -> Bool -> Bool
&& Char -> Bool
sep (ByteString -> Char
BS.head ByteString
o)
                  pos :: Bool
pos = Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
o) Bool -> Bool -> Bool
&& Char -> Bool
sep (ByteString -> Char
BS.last ByteString
o)

        g :: Int -> [ByteString] -> [ByteString]
g Int
i [] = Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate Int
i ByteString
dotDot
        g Int
i (ByteString
x:[ByteString]
xs) | ByteString -> Bool
BS.null ByteString
x = Int -> [ByteString] -> [ByteString]
g Int
i [ByteString]
xs
        g Int
i (ByteString
x:[ByteString]
xs) | ByteString
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
dotDot = Int -> [ByteString] -> [ByteString]
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [ByteString]
xs
        g Int
i (ByteString
x:[ByteString]
xs) | ByteString
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
dot = Int -> [ByteString] -> [ByteString]
g Int
i [ByteString]
xs
        g Int
0 (ByteString
x:[ByteString]
xs) = ByteString
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> [ByteString] -> [ByteString]
g Int
0 [ByteString]
xs
        g Int
i (ByteString
_:[ByteString]
xs) = Int -> [ByteString] -> [ByteString]
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [ByteString]
xs -- equivalent to eliminating ../x

        split :: ByteString -> [ByteString]
split = (Char -> Bool) -> ByteString -> [ByteString]
BS.splitWith Char -> Bool
sep

dotDot :: ByteString
dotDot = String -> ByteString
BS.pack String
".."
dot :: ByteString
dot = Char -> ByteString
BS.singleton Char
'.'
slash :: ByteString
slash = Char -> ByteString
BS.singleton Char
'/'