forked from haskell/cabal
/
Utils.hs
111 lines (99 loc) · 3.78 KB
/
Utils.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
module Distribution.Client.Utils where
import qualified Data.ByteString.Lazy as BS
import Data.Bits
( (.|.), shiftL, shiftR )
import Data.Char
( ord, chr )
import Data.List
( sortBy, groupBy )
import Data.Word
( Word8, Word32)
import System.Directory
( doesFileExist, getModificationTime
, getCurrentDirectory, setCurrentDirectory )
import System.FilePath
( (</>), isAbsolute )
import qualified Control.Exception as Exception
( finally )
-- | Generic merging utility. For sorted input lists this is a full outer join.
--
-- * The result list never contains @(Nothing, Nothing)@.
--
mergeBy :: (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy cmp = merge
where
merge [] ys = [ OnlyInRight y | y <- ys]
merge xs [] = [ OnlyInLeft x | x <- xs]
merge (x:xs) (y:ys) =
case x `cmp` y of
GT -> OnlyInRight y : merge (x:xs) ys
EQ -> InBoth x y : merge xs ys
LT -> OnlyInLeft x : merge xs (y:ys)
data MergeResult a b = OnlyInLeft a | InBoth a b | OnlyInRight b
duplicates :: Ord a => [a] -> [[a]]
duplicates = duplicatesBy compare
duplicatesBy :: (a -> a -> Ordering) -> [a] -> [[a]]
duplicatesBy cmp = filter moreThanOne . groupBy eq . sortBy cmp
where
eq a b = case cmp a b of
EQ -> True
_ -> False
moreThanOne (_:_:_) = True
moreThanOne _ = False
-- | Compare the modification times of two files to see if the first is newer
-- than the second. The first file must exist but the second need not.
-- The expected use case is when the second file is generated using the first.
-- In this use case, if the result is True then the second file is out of date.
--
moreRecentFile :: FilePath -> FilePath -> IO Bool
moreRecentFile a b = do
exists <- doesFileExist b
if not exists
then return True
else do tb <- getModificationTime b
ta <- getModificationTime a
return (ta > tb)
-- | Executes the action in the specified directory.
inDir :: Maybe FilePath -> IO () -> IO ()
inDir Nothing m = m
inDir (Just d) m = do
old <- getCurrentDirectory
setCurrentDirectory d
m `Exception.finally` setCurrentDirectory old
-- | Given a relative path, make it absolute relative to the current
-- directory. Absolute paths are returned unmodified.
makeAbsoluteToCwd :: FilePath -> IO FilePath
makeAbsoluteToCwd path | isAbsolute path = return path
| otherwise = do cwd <- getCurrentDirectory
return $! cwd </> path
-- | Convert a 'FilePath' to a lazy 'ByteString'. Each 'Char' is
-- encoded as a little-endian 'Word32'.
filePathToByteString :: FilePath -> BS.ByteString
filePathToByteString p =
BS.pack $ foldr conv [] codepts
where
codepts :: [Word32]
codepts = map (fromIntegral . ord) p
conv :: Word32 -> [Word8] -> [Word8]
conv w32 rest = b0:b1:b2:b3:rest
where
b0 = fromIntegral $ w32
b1 = fromIntegral $ w32 `shiftR` 8
b2 = fromIntegral $ w32 `shiftR` 16
b3 = fromIntegral $ w32 `shiftR` 24
-- | Reverse operation to 'filePathToByteString'.
byteStringToFilePath :: BS.ByteString -> FilePath
byteStringToFilePath bs | bslen `mod` 4 /= 0 = unexpected
| otherwise = go 0
where
unexpected = "Distribution.Client.Utils.byteStringToFilePath: unexpected"
bslen = BS.length bs
go i | i == bslen = []
| otherwise = (chr . fromIntegral $ w32) : go (i+4)
where
w32 :: Word32
w32 = b0 .|. (b1 `shiftL` 8) .|. (b2 `shiftL` 16) .|. (b3 `shiftL` 24)
b0 = fromIntegral $ BS.index bs i
b1 = fromIntegral $ BS.index bs (i + 1)
b2 = fromIntegral $ BS.index bs (i + 2)
b3 = fromIntegral $ BS.index bs (i + 3)