diff options
| -rw-r--r-- | Test.hs | 3 | ||||
| -rw-r--r-- | Utility/FileSystemEncoding.hs | 5 | ||||
| -rw-r--r-- | Utility/FreeDesktop.hs | 2 | ||||
| -rw-r--r-- | Utility/Path.hs | 4 | ||||
| -rw-r--r-- | Utility/SafeCommand.hs | 3 | ||||
| -rw-r--r-- | Utility/Scheduled.hs | 37 | ||||
| -rw-r--r-- | Utility/Scheduled/QuickCheck.hs | 51 | ||||
| -rw-r--r-- | doc/bugs/ipfs_initremote_failing_with___34__unable_to_parse_command__34__/comment_1_f1da699581e72aad0c3433d8fc02ce9c._comment | 31 |
8 files changed, 92 insertions, 44 deletions
@@ -83,6 +83,7 @@ import qualified Utility.Matcher import qualified Utility.Exception import qualified Utility.Hash import qualified Utility.Scheduled +import qualified Utility.Scheduled.QuickCheck import qualified Utility.HumanTime import qualified Utility.ThreadScheduler import qualified Utility.Base64 @@ -157,7 +158,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" , testProperty "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog , testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable , testProperty "prop_mac_stable" Utility.Hash.prop_mac_stable - , testProperty "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips + , testProperty "prop_schedule_roundtrips" Utility.Scheduled.QuickCheck.prop_schedule_roundtrips , testProperty "prop_past_sane" Utility.Scheduled.prop_past_sane , testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips , testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs index 2d9691d52..67341d371 100644 --- a/Utility/FileSystemEncoding.hs +++ b/Utility/FileSystemEncoding.hs @@ -29,6 +29,7 @@ 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 @@ -125,12 +126,12 @@ decodeW8 = s2w8 . _encodeFilePath {- Like encodeW8 and decodeW8, but NULs are passed through unchanged. -} encodeW8NUL :: [Word8] -> FilePath -encodeW8NUL = join nul . map encodeW8 . split (s2w8 nul) +encodeW8NUL = intercalate nul . map encodeW8 . split (s2w8 nul) where nul = ['\NUL'] decodeW8NUL :: FilePath -> [Word8] -decodeW8NUL = join (s2w8 nul) . map decodeW8 . split nul +decodeW8NUL = intercalate (s2w8 nul) . map decodeW8 . split nul where nul = ['\NUL'] diff --git a/Utility/FreeDesktop.hs b/Utility/FreeDesktop.hs index 70332490b..f8b9fd709 100644 --- a/Utility/FreeDesktop.hs +++ b/Utility/FreeDesktop.hs @@ -59,7 +59,7 @@ toString (ListV l) | null l = "" | otherwise = (intercalate ";" $ map (escapesemi . toString) l) ++ ";" where - escapesemi = join "\\;" . split ";" + escapesemi = intercalate "\\;" . split ";" genDesktopEntry :: String -> String -> Bool -> FilePath -> Maybe String -> [String] -> DesktopEntry genDesktopEntry name comment terminal program icon categories = catMaybes diff --git a/Utility/Path.hs b/Utility/Path.hs index 4c2dd5c8b..1771d1e6d 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -89,7 +89,7 @@ parentDir = takeDirectory . dropTrailingPathSeparator upFrom :: FilePath -> Maybe FilePath upFrom dir | length dirs < 2 = Nothing - | otherwise = Just $ joinDrive drive (join s $ init dirs) + | otherwise = Just $ joinDrive drive (intercalate s $ init dirs) where -- on Unix, the drive will be "/" when the dir is absolute, otherwise "" (drive, path) = splitDrive dir @@ -149,7 +149,7 @@ relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to relPathDirToFileAbs :: FilePath -> FilePath -> FilePath relPathDirToFileAbs from to | takeDrive from /= takeDrive to = to - | otherwise = join s $ dotdots ++ uncommon + | otherwise = intercalate s $ dotdots ++ uncommon where s = [pathSeparator] pfrom = split s from diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs index 40d41c7a2..5ce17a845 100644 --- a/Utility/SafeCommand.hs +++ b/Utility/SafeCommand.hs @@ -14,6 +14,7 @@ import Utility.Process import Data.String.Utils import System.FilePath import Data.Char +import Data.List import Control.Applicative import Prelude @@ -85,7 +86,7 @@ shellEscape :: String -> String shellEscape f = "'" ++ escaped ++ "'" where -- replace ' with '"'"' - escaped = join "'\"'\"'" $ split "'" f + escaped = intercalate "'\"'\"'" $ split "'" f -- | Unescapes a set of shellEscaped words or filenames. shellUnEscape :: String -> [String] diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs index 5e813d4a2..ead8f7716 100644 --- a/Utility/Scheduled.hs +++ b/Utility/Scheduled.hs @@ -23,12 +23,10 @@ module Utility.Scheduled ( toRecurrance, toSchedule, parseSchedule, - prop_schedule_roundtrips, prop_past_sane, ) where import Utility.Data -import Utility.QuickCheck import Utility.PartialPrelude import Utility.Misc @@ -337,41 +335,6 @@ parseSchedule s = do recurrance = unwords rws scheduledtime = unwords tws -instance Arbitrary Schedule where - arbitrary = Schedule <$> arbitrary <*> arbitrary - -instance Arbitrary ScheduledTime where - arbitrary = oneof - [ pure AnyTime - , SpecificTime - <$> choose (0, 23) - <*> choose (1, 59) - ] - -instance Arbitrary Recurrance where - arbitrary = oneof - [ pure Daily - , Weekly <$> arbday - , Monthly <$> arbday - , Yearly <$> arbday - , Divisible - <$> positive arbitrary - <*> oneof -- no nested Divisibles - [ pure Daily - , Weekly <$> arbday - , Monthly <$> arbday - , Yearly <$> arbday - ] - ] - where - arbday = oneof - [ Just <$> nonNegative arbitrary - , pure Nothing - ] - -prop_schedule_roundtrips :: Schedule -> Bool -prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s - prop_past_sane :: Bool prop_past_sane = and [ all (checksout oneMonthPast) (mplus1 ++ yplus1) diff --git a/Utility/Scheduled/QuickCheck.hs b/Utility/Scheduled/QuickCheck.hs new file mode 100644 index 000000000..a2051cd2a --- /dev/null +++ b/Utility/Scheduled/QuickCheck.hs @@ -0,0 +1,51 @@ +{- quickcheck for scheduled activities + - + - Copyright 2013-2014 Joey Hess <id@joeyh.name> + - + - License: BSD-2-clause + -} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Utility.Scheduled.QuickCheck where + +import Utility.Scheduled +import Utility.QuickCheck + +import Control.Applicative +import Prelude + +instance Arbitrary Schedule where + arbitrary = Schedule <$> arbitrary <*> arbitrary + +instance Arbitrary ScheduledTime where + arbitrary = oneof + [ pure AnyTime + , SpecificTime + <$> choose (0, 23) + <*> choose (1, 59) + ] + +instance Arbitrary Recurrance where + arbitrary = oneof + [ pure Daily + , Weekly <$> arbday + , Monthly <$> arbday + , Yearly <$> arbday + , Divisible + <$> positive arbitrary + <*> oneof -- no nested Divisibles + [ pure Daily + , Weekly <$> arbday + , Monthly <$> arbday + , Yearly <$> arbday + ] + ] + where + arbday = oneof + [ Just <$> nonNegative arbitrary + , pure Nothing + ] + +prop_schedule_roundtrips :: Schedule -> Bool +prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s diff --git a/doc/bugs/ipfs_initremote_failing_with___34__unable_to_parse_command__34__/comment_1_f1da699581e72aad0c3433d8fc02ce9c._comment b/doc/bugs/ipfs_initremote_failing_with___34__unable_to_parse_command__34__/comment_1_f1da699581e72aad0c3433d8fc02ce9c._comment new file mode 100644 index 000000000..c8b248fdc --- /dev/null +++ b/doc/bugs/ipfs_initremote_failing_with___34__unable_to_parse_command__34__/comment_1_f1da699581e72aad0c3433d8fc02ce9c._comment @@ -0,0 +1,31 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2015-11-18T16:09:03Z" + content=""" +It works here, no problem. And, the ipfs special remote does not actually +use ipfs at all when initremote is run, so there's no possibility of some +change in ipfs versions having broken it. + +My best guess is something in your shell or environment is making the +git-annex-remote-ipfs script not work right, and apparently output an extra +newline. I can reproduce that error message from git-annex if I modify +git-annex-remote-ipfs to echo a blank link on startup. I can't see any +way that shell script could output an extra newline normally however. + +Passing --debug will cause the protocol output to be dumped, which could +help debug this. All I'd expect to see in the protocol dump is +git-annex sending "INITREMOTE" and git-annex-remote-ipfs responding +with "INITREMOTE-SUCCESS". So another way to see what's going wrong with +the script's output is this: + + # echo INITREMOTE | git-annex-remote-ipfs + VERSION 1 + INITREMOTE-SUCCESS + # + +And if that outputs an extra newline as I hypothesize, this should help +pinpoint what line of the script is doing that: + + # echo INITREMOTE | sh -x $(which git-annex-remote-ipfs) +"""]] |