[commit: ghc] wip/nfs-locking: Implement joinArgs and joinArgsWithSpaces as variadic functions. (c6870b2)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/c6870b2f0e46782ad6a094cff9809150fe2eebf7/ghc

>---------------------------------------------------------------

commit c6870b2f0e46782ad6a094cff9809150fe2eebf7
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sat Jan 3 23:57:51 2015 +0000

    Implement joinArgs and joinArgsWithSpaces as variadic functions.


>---------------------------------------------------------------

c6870b2f0e46782ad6a094cff9809150fe2eebf7
 src/Base.hs | 37 ++++++++++++++++++++++---------------
 1 file changed, 22 insertions(+), 15 deletions(-)

diff --git a/src/Base.hs b/src/Base.hs
index 645d5dc..283d62f 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -23,6 +23,7 @@ data Stage = Stage0 | Stage1 | Stage2 | Stage3 deriving (Eq, Enum)
 
 type Args = Action [String]
 
+
 type Condition = Action Bool
 
 instance Monoid a => Monoid (Action a) where
@@ -35,36 +36,42 @@ class ShowAction a where
 instance ShowAction String where
     showAction = return
 
+instance ShowAction (Action String) where
+    showAction = id
+
 arg :: ShowAction a => [a] -> Args
 arg = mapM showAction
 
+type ArgsCombine = Args -> Args -> Args
+
 class Collect a where
-    collect :: Args -> a
+    collect :: ArgsCombine -> Args -> a
 
 instance Collect Args where
-    collect = id
+    collect = const id
 
 instance (ShowAction a, Collect r) => Collect (a -> r) where
-    collect prev next = collect $ do
-        next' <- showAction next
-        prev <> return [next']
+    collect combine x = \y -> collect combine $ x `combine` arg [y]
+
+instance Collect r => Collect (Args -> r) where
+    collect combine x = \y -> collect combine $ x `combine` y
 
 args :: Collect a => a
-args = collect mempty
+args = collect (<>) mempty
 
-intercalateArgs :: String -> Args -> Args
-intercalateArgs s args = do
-    as <- args
-    return [intercalate s as]
+joinArgs :: Collect a => a
+joinArgs = collect (\x y -> intercalateArgs "" x <> y) mempty
 
-joinArgsWithSpaces :: Args -> Args
-joinArgsWithSpaces = intercalateArgs " "
+joinArgsWithSpaces :: Collect a => a
+joinArgsWithSpaces = collect (\x y -> intercalateArgs " " x <> y) mempty
 
-joinArgs :: Args -> Args
-joinArgs = intercalateArgs ""
+intercalateArgs :: String -> Args -> Args
+intercalateArgs s as = do
+    as' <- as
+    return [intercalate s as']
 
 splitArgs :: Args -> Args
 splitArgs = fmap (concatMap words)
 
 filterOut :: Args -> [String] -> Args
-filterOut args list = filter (`notElem` list) <$> args
+filterOut as list = filter (`notElem` list) <$> as