summaryrefslogtreecommitdiff
path: root/src/Utility
diff options
context:
space:
mode:
authorJoey Hess2017-05-16 01:06:26 -0400
committerJoey Hess2017-05-16 01:06:26 -0400
commitfa5cbd91f46e35ece6d9cd64230a831dade042c0 (patch)
tree50b94c88a16b956826395694e14e0bc4a0ac9afc /src/Utility
parentfe4a246419dcbc5700e048bbf074f5e9871d8546 (diff)
merge fixes from git-annex
Diffstat (limited to 'src/Utility')
-rw-r--r--src/Utility/DataUnits.hs8
-rw-r--r--src/Utility/FileSystemEncoding.hs2
-rw-r--r--src/Utility/Path.hs14
-rw-r--r--src/Utility/Split.hs2
4 files changed, 19 insertions, 7 deletions
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)