summaryrefslogtreecommitdiff
path: root/src/Utility
diff options
context:
space:
mode:
authorJoey Hess2017-05-15 20:09:31 -0400
committerJoey Hess2017-05-15 20:09:31 -0400
commitba3bd76f4ade7ffeea3c1837f868f5264d284a8c (patch)
treedfeb81f4649ddc65f5e1eac8aff59c5f83bade63 /src/Utility
parent9e667d3fe370edc6b0557f5746e20f2d7ab812ca (diff)
Removed dependency on MissingH, instead depends on split and hashable.
MissingH is a heavy dependency, which pulls in parsec and a bunch of stuff. So eliminating it makes propellor easier to install and less likely to fail to build. changesFileContent now uses hashable's hash. This may not be stable across upgrades, I'm not sure -- but it's surely ok here, as the hash is not stored. socketFile also uses hash. I *think* this is ok, even if it's not stable. If it's not stable, an upgrade might make propellor hash a hostname to a different number, but with 9 digets of number in use, the chances of a collision are small. In any case, I've opned a bug report asking for the stability to be documented, and I think it's intended to be stable, only the documentation is bad. NB: I have not checked that the arch linux and freebsd packages for the new deps, that Propellor.Bootstrap lists, are the right names or even exist. Since propellor depends on hashable, it could be changed to use unordered-containers, rather than containers, which would be faster and perhaps less deps too. This commit was sponsored by Alexander Thompson on Patreon.
Diffstat (limited to 'src/Utility')
-rw-r--r--src/Utility/FileMode.hs22
-rw-r--r--src/Utility/FileSystemEncoding.hs39
-rw-r--r--src/Utility/LinuxMkLibs.hs2
-rw-r--r--src/Utility/PartialPrelude.hs2
-rw-r--r--src/Utility/Path.hs28
-rw-r--r--src/Utility/Process.hs28
-rw-r--r--src/Utility/SafeCommand.hs4
-rw-r--r--src/Utility/Scheduled.hs2
-rw-r--r--src/Utility/Split.hs28
-rw-r--r--src/Utility/Tuple.hs17
10 files changed, 117 insertions, 55 deletions
diff --git a/src/Utility/FileMode.hs b/src/Utility/FileMode.hs
index bb3780c6..d9a26944 100644
--- a/src/Utility/FileMode.hs
+++ b/src/Utility/FileMode.hs
@@ -1,6 +1,6 @@
{- File mode utilities.
-
- - Copyright 2010-2012 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2017 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
@@ -130,6 +130,21 @@ withUmask umask a = bracket setup cleanup go
withUmask _ a = a
#endif
+getUmask :: IO FileMode
+#ifndef mingw32_HOST_OS
+getUmask = bracket setup cleanup return
+ where
+ setup = setFileCreationMask nullFileMode
+ cleanup = setFileCreationMask
+#else
+getUmask = return nullFileMode
+#endif
+
+defaultFileMode :: IO FileMode
+defaultFileMode = do
+ umask <- getUmask
+ return $ intersectFileModes (complement umask) stdFileMode
+
combineModes :: [FileMode] -> FileMode
combineModes [] = 0
combineModes [m] = m
@@ -162,7 +177,10 @@ writeFileProtected file content = writeFileProtected' file
(\h -> hPutStr h content)
writeFileProtected' :: FilePath -> (Handle -> IO ()) -> IO ()
-writeFileProtected' file writer = withUmask 0o0077 $
+writeFileProtected' file writer = protectedOutput $
withFile file WriteMode $ \h -> do
void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
writer h
+
+protectedOutput :: IO a -> IO a
+protectedOutput = withUmask 0o0077
diff --git a/src/Utility/FileSystemEncoding.hs b/src/Utility/FileSystemEncoding.hs
index be43ace9..862f0721 100644
--- a/src/Utility/FileSystemEncoding.hs
+++ b/src/Utility/FileSystemEncoding.hs
@@ -10,8 +10,8 @@
module Utility.FileSystemEncoding (
useFileSystemEncoding,
+ fileEncoding,
withFilePath,
- md5FilePath,
decodeBS,
encodeBS,
decodeW8,
@@ -19,6 +19,8 @@ module Utility.FileSystemEncoding (
encodeW8NUL,
decodeW8NUL,
truncateFilePath,
+ s2w8,
+ w82s,
) where
import qualified GHC.Foreign as GHC
@@ -26,17 +28,15 @@ import qualified GHC.IO.Encoding as Encoding
import Foreign.C
import System.IO
import System.IO.Unsafe
-import qualified Data.Hash.MD5 as MD5
import Data.Word
-import Data.Bits.Utils
import Data.List
-import Data.List.Utils
import qualified Data.ByteString.Lazy as L
#ifdef mingw32_HOST_OS
import qualified Data.ByteString.Lazy.UTF8 as L8
#endif
import Utility.Exception
+import Utility.Split
{- Makes all subsequent Handles that are opened, as well as stdio Handles,
- use the filesystem encoding, instead of the encoding of the current
@@ -63,6 +63,13 @@ useFileSystemEncoding = do
hSetEncoding stderr e
Encoding.setLocaleEncoding e
+fileEncoding :: Handle -> IO ()
+#ifndef mingw32_HOST_OS
+fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding
+#else
+fileEncoding h = hSetEncoding h Encoding.utf8
+#endif
+
{- Marshal a Haskell FilePath into a NUL terminated C string using temporary
- storage. The FilePath is encoded using the filesystem encoding,
- reversing the decoding that should have been done when the FilePath
@@ -93,10 +100,6 @@ _encodeFilePath fp = unsafePerformIO $ do
GHC.withCString enc fp (GHC.peekCString Encoding.char8)
`catchNonAsync` (\_ -> return fp)
-{- Encodes a FilePath into a Md5.Str, applying the filesystem encoding. -}
-md5FilePath :: FilePath -> MD5.Str
-md5FilePath = MD5.Str . _encodeFilePath
-
{- Decodes a ByteString into a FilePath, applying the filesystem encoding. -}
decodeBS :: L.ByteString -> FilePath
#ifndef mingw32_HOST_OS
@@ -137,14 +140,26 @@ decodeW8 = s2w8 . _encodeFilePath
{- Like encodeW8 and decodeW8, but NULs are passed through unchanged. -}
encodeW8NUL :: [Word8] -> FilePath
-encodeW8NUL = intercalate nul . map encodeW8 . split (s2w8 nul)
+encodeW8NUL = intercalate [nul] . map encodeW8 . splitc (c2w8 nul)
where
- nul = ['\NUL']
+ nul = '\NUL'
decodeW8NUL :: FilePath -> [Word8]
-decodeW8NUL = intercalate (s2w8 nul) . map decodeW8 . split nul
+decodeW8NUL = intercalate [c2w8 nul] . map decodeW8 . splitc nul
where
- nul = ['\NUL']
+ nul = '\NUL'
+
+c2w8 :: Char -> Word8
+c2w8 = fromIntegral . fromEnum
+
+w82c :: Word8 -> Char
+w82c = toEnum . fromIntegral
+
+s2w8 :: String -> [Word8]
+s2w8 = map c2w8
+
+w82s :: [Word8] -> String
+w82s = map w82c
{- Truncates a FilePath to the given number of bytes (or less),
- as represented on disk.
diff --git a/src/Utility/LinuxMkLibs.hs b/src/Utility/LinuxMkLibs.hs
index 122f3964..15f82fd1 100644
--- a/src/Utility/LinuxMkLibs.hs
+++ b/src/Utility/LinuxMkLibs.hs
@@ -12,10 +12,10 @@ import Utility.Directory
import Utility.Process
import Utility.Monad
import Utility.Path
+import Utility.Split
import Data.Maybe
import System.FilePath
-import Data.List.Utils
import System.Posix.Files
import Data.Char
import Control.Monad.IfElse
diff --git a/src/Utility/PartialPrelude.hs b/src/Utility/PartialPrelude.hs
index 55795563..47e98318 100644
--- a/src/Utility/PartialPrelude.hs
+++ b/src/Utility/PartialPrelude.hs
@@ -2,7 +2,7 @@
- bugs.
-
- This exports functions that conflict with the prelude, which avoids
- - them being accidentially used.
+ - them being accidentally used.
-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
diff --git a/src/Utility/Path.hs b/src/Utility/Path.hs
index 3ee5ff39..2383ad06 100644
--- a/src/Utility/Path.hs
+++ b/src/Utility/Path.hs
@@ -10,7 +10,6 @@
module Utility.Path where
-import Data.String.Utils
import System.FilePath
import Data.List
import Data.Maybe
@@ -25,7 +24,6 @@ import System.Posix.Files
import Utility.Exception
#endif
-import qualified "MissingH" System.Path as MissingH
import Utility.Monad
import Utility.UserInfo
import Utility.Directory
@@ -68,18 +66,6 @@ simplifyPath path = dropTrailingPathSeparator $
absPathFrom :: FilePath -> FilePath -> FilePath
absPathFrom dir path = simplifyPath (combine dir path)
-{- On Windows, this converts the paths to unix-style, in order to run
- - MissingH's absNormPath on them. -}
-absNormPathUnix :: FilePath -> FilePath -> Maybe FilePath
-#ifndef mingw32_HOST_OS
-absNormPathUnix dir path = MissingH.absNormPath dir path
-#else
-absNormPathUnix dir path = todos <$> MissingH.absNormPath (fromdos dir) (fromdos path)
- where
- fromdos = replace "\\" "/"
- todos = replace "/" "\\"
-#endif
-
{- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -}
parentDir :: FilePath -> FilePath
parentDir = takeDirectory . dropTrailingPathSeparator
@@ -89,12 +75,11 @@ parentDir = takeDirectory . dropTrailingPathSeparator
upFrom :: FilePath -> Maybe FilePath
upFrom dir
| length dirs < 2 = Nothing
- | otherwise = Just $ joinDrive drive (intercalate s $ init dirs)
+ | otherwise = Just $ joinDrive drive $ joinPath $ init dirs
where
-- on Unix, the drive will be "/" when the dir is absolute, otherwise ""
(drive, path) = splitDrive dir
- dirs = filter (not . null) $ split s path
- s = [pathSeparator]
+ dirs = filter (not . null) $ splitPath path
prop_upFrom_basics :: FilePath -> Bool
prop_upFrom_basics dir
@@ -149,11 +134,10 @@ relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
relPathDirToFileAbs from to
| takeDrive from /= takeDrive to = to
- | otherwise = intercalate s $ dotdots ++ uncommon
+ | otherwise = joinPath $ dotdots ++ uncommon
where
- s = [pathSeparator]
- pfrom = split s from
- pto = split s to
+ pfrom = splitPath from
+ pto = splitPath to
common = map fst $ takeWhile same $ zip pfrom pto
same (c,d) = c == d
uncommon = drop numcommon pto
@@ -227,6 +211,8 @@ inPath command = isJust <$> searchPath command
-
- The command may be fully qualified already, in which case it will
- be returned if it exists.
+ -
+ - Note that this will find commands in PATH that are not executable.
-}
searchPath :: String -> IO (Maybe FilePath)
searchPath command
diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs
index ed02f49e..6d981cb5 100644
--- a/src/Utility/Process.hs
+++ b/src/Utility/Process.hs
@@ -174,22 +174,21 @@ createBackgroundProcess p a = a =<< createProcess p
-- returns a transcript combining its stdout and stderr, and
-- whether it succeeded or failed.
processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
-processTranscript = processTranscript' id
+processTranscript cmd opts = processTranscript' (proc cmd opts)
-processTranscript' :: (CreateProcess -> CreateProcess) -> String -> [String] -> Maybe String -> IO (String, Bool)
-processTranscript' modproc cmd opts input = do
+processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)
+processTranscript' cp input = do
#ifndef mingw32_HOST_OS
{- This implementation interleves stdout and stderr in exactly the order
- the process writes them. -}
(readf, writef) <- System.Posix.IO.createPipe
readh <- System.Posix.IO.fdToHandle readf
writeh <- System.Posix.IO.fdToHandle writef
- p@(_, _, _, pid) <- createProcess $ modproc $
- (proc cmd opts)
- { std_in = if isJust input then CreatePipe else Inherit
- , std_out = UseHandle writeh
- , std_err = UseHandle writeh
- }
+ p@(_, _, _, pid) <- createProcess $ cp
+ { std_in = if isJust input then CreatePipe else Inherit
+ , std_out = UseHandle writeh
+ , std_err = UseHandle writeh
+ }
hClose writeh
get <- mkreader readh
@@ -200,12 +199,11 @@ processTranscript' modproc cmd opts input = do
return (transcript, ok)
#else
{- This implementation for Windows puts stderr after stdout. -}
- p@(_, _, _, pid) <- createProcess $ modproc $
- (proc cmd opts)
- { std_in = if isJust input then CreatePipe else Inherit
- , std_out = CreatePipe
- , std_err = CreatePipe
- }
+ p@(_, _, _, pid) <- createProcess $ cp
+ { std_in = if isJust input then CreatePipe else Inherit
+ , std_out = CreatePipe
+ , std_err = CreatePipe
+ }
getout <- mkreader (stdoutHandle p)
geterr <- mkreader (stderrHandle p)
diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs
index 5ce17a84..eb34d3de 100644
--- a/src/Utility/SafeCommand.hs
+++ b/src/Utility/SafeCommand.hs
@@ -11,7 +11,7 @@ module Utility.SafeCommand where
import System.Exit
import Utility.Process
-import Data.String.Utils
+import Utility.Split
import System.FilePath
import Data.Char
import Data.List
@@ -86,7 +86,7 @@ shellEscape :: String -> String
shellEscape f = "'" ++ escaped ++ "'"
where
-- replace ' with '"'"'
- escaped = intercalate "'\"'\"'" $ split "'" f
+ escaped = intercalate "'\"'\"'" $ splitc '\'' f
-- | Unescapes a set of shellEscaped words or filenames.
shellUnEscape :: String -> [String]
diff --git a/src/Utility/Scheduled.hs b/src/Utility/Scheduled.hs
index d23aaf03..b68ff901 100644
--- a/src/Utility/Scheduled.hs
+++ b/src/Utility/Scheduled.hs
@@ -29,6 +29,7 @@ module Utility.Scheduled (
import Utility.Data
import Utility.PartialPrelude
import Utility.Misc
+import Utility.Tuple
import Data.List
import Data.Time.Clock
@@ -37,7 +38,6 @@ import Data.Time.Calendar
import Data.Time.Calendar.WeekDate
import Data.Time.Calendar.OrdinalDate
import Data.Time.Format ()
-import Data.Tuple.Utils
import Data.Char
import Control.Applicative
import Prelude
diff --git a/src/Utility/Split.hs b/src/Utility/Split.hs
new file mode 100644
index 00000000..b3e5e276
--- /dev/null
+++ b/src/Utility/Split.hs
@@ -0,0 +1,28 @@
+{- split utility functions
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+module Utility.Split where
+
+import Data.List (intercalate)
+import Data.List.Split (splitOn)
+
+-- | same as Data.List.Utils.split
+--
+-- intercalate x . splitOn x === id
+split :: Eq a => [a] -> [a] -> [[a]]
+split = splitOn
+
+-- | Split on a single character. This is over twice as fast as using
+-- split on a list of length 1, while producing identical results. -}
+splitc :: Eq c => c -> [c] -> [[c]]
+splitc c s = case break (== c) s of
+ (i, _c:rest) -> i : splitc c rest
+ (i, []) -> i : []
+
+-- | same as Data.List.Utils.replace
+replace :: Eq a => [a] -> [a] -> [a] -> [a]
+replace old new = intercalate new . split old
diff --git a/src/Utility/Tuple.hs b/src/Utility/Tuple.hs
new file mode 100644
index 00000000..25c6e8f3
--- /dev/null
+++ b/src/Utility/Tuple.hs
@@ -0,0 +1,17 @@
+{- tuple utility functions
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+module Utility.Tuple where
+
+fst3 :: (a,b,c) -> a
+fst3 (a,_,_) = a
+
+snd3 :: (a,b,c) -> b
+snd3 (_,b,_) = b
+
+thd3 :: (a,b,c) -> c
+thd3 (_,_,c) = c