From fa5cbd91f46e35ece6d9cd64230a831dade042c0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 16 May 2017 01:06:26 -0400 Subject: merge fixes from git-annex --- src/Utility/DataUnits.hs | 8 ++++++-- src/Utility/FileSystemEncoding.hs | 2 ++ src/Utility/Path.hs | 14 +++++++++----- src/Utility/Split.hs | 2 ++ 4 files changed, 19 insertions(+), 7 deletions(-) (limited to 'src/Utility') diff --git a/src/Utility/DataUnits.hs b/src/Utility/DataUnits.hs index 6e40932e..a6c9ffcf 100644 --- a/src/Utility/DataUnits.hs +++ b/src/Utility/DataUnits.hs @@ -45,6 +45,7 @@ module Utility.DataUnits ( ByteSize, roughSize, + roughSize', compareSizes, readSize ) where @@ -109,7 +110,10 @@ oldSchoolUnits = zipWith (curry mingle) storageUnits memoryUnits {- approximate display of a particular number of bytes -} roughSize :: [Unit] -> Bool -> ByteSize -> String -roughSize units short i +roughSize units short i = roughSize' units short 2 i + +roughSize' :: [Unit] -> Bool -> Int -> ByteSize -> String +roughSize' units short precision i | i < 0 = '-' : findUnit units' (negate i) | otherwise = findUnit units' i where @@ -123,7 +127,7 @@ roughSize units short i showUnit x (Unit size abbrev name) = s ++ " " ++ unit where v = (fromInteger x :: Double) / fromInteger size - s = showImprecise 2 v + s = showImprecise precision v unit | short = abbrev | s == "1" = name diff --git a/src/Utility/FileSystemEncoding.hs b/src/Utility/FileSystemEncoding.hs index 862f0721..444dc4a9 100644 --- a/src/Utility/FileSystemEncoding.hs +++ b/src/Utility/FileSystemEncoding.hs @@ -21,6 +21,8 @@ module Utility.FileSystemEncoding ( truncateFilePath, s2w8, w82s, + c2w8, + w82c, ) where import qualified GHC.Foreign as GHC diff --git a/src/Utility/Path.hs b/src/Utility/Path.hs index 2383ad06..0779d167 100644 --- a/src/Utility/Path.hs +++ b/src/Utility/Path.hs @@ -27,6 +27,7 @@ import Utility.Exception import Utility.Monad import Utility.UserInfo import Utility.Directory +import Utility.Split {- Simplifies a path, removing any "." component, collapsing "dir/..", - and removing the trailing path separator. @@ -75,11 +76,13 @@ parentDir = takeDirectory . dropTrailingPathSeparator upFrom :: FilePath -> Maybe FilePath upFrom dir | length dirs < 2 = Nothing - | otherwise = Just $ joinDrive drive $ joinPath $ init dirs + | otherwise = Just $ joinDrive drive $ intercalate s $ init dirs where - -- on Unix, the drive will be "/" when the dir is absolute, otherwise "" + -- on Unix, the drive will be "/" when the dir is absolute, + -- otherwise "" (drive, path) = splitDrive dir - dirs = filter (not . null) $ splitPath path + s = [pathSeparator] + dirs = filter (not . null) $ split s path prop_upFrom_basics :: FilePath -> Bool prop_upFrom_basics dir @@ -136,8 +139,9 @@ relPathDirToFileAbs from to | takeDrive from /= takeDrive to = to | otherwise = joinPath $ dotdots ++ uncommon where - pfrom = splitPath from - pto = splitPath to + pfrom = sp from + pto = sp to + sp = map dropTrailingPathSeparator . splitPath common = map fst $ takeWhile same $ zip pfrom pto same (c,d) = c == d uncommon = drop numcommon pto diff --git a/src/Utility/Split.hs b/src/Utility/Split.hs index b3e5e276..decfe7d3 100644 --- a/src/Utility/Split.hs +++ b/src/Utility/Split.hs @@ -5,6 +5,8 @@ - License: BSD-2-clause -} +{-# OPTIONS_GHC -fno-warn-tabs #-} + module Utility.Split where import Data.List (intercalate) -- cgit v1.2.3