summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog2
-rw-r--r--debian/control2
-rw-r--r--propellor.cabal6
-rw-r--r--src/Propellor/Bootstrap.hs1
-rw-r--r--src/Utility/ConcurrentOutput.hs35
5 files changed, 32 insertions, 14 deletions
diff --git a/debian/changelog b/debian/changelog
index c5538c7f..6f75bce9 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -20,7 +20,7 @@ propellor (2.13.0) UNRELEASED; urgency=medium
* Added Propellor.Property.Concurrent for concurrent properties.
* Made the execProcess exported by propellor, and everything built on it,
avoid scrambled output when run concurrently.
- * Propellor now depends on STM.
+ * Propellor now depends on STM and text.
* The cabal file now builds propellor with -O. While -O0 makes ghc
take less memory while building propellor, it can lead to bad memory
usage at runtime due to eg, disabled stream fusion.
diff --git a/debian/control b/debian/control
index 2956fdaa..97fb3e6d 100644
--- a/debian/control
+++ b/debian/control
@@ -18,6 +18,7 @@ Build-Depends:
libghc-transformers-dev,
libghc-exceptions-dev (>= 0.6),
libghc-stm-dev,
+ libghc-text-dev,
Maintainer: Gergely Nagy <algernon@madhouse-project.org>
Standards-Version: 3.9.6
Vcs-Git: git://git.joeyh.name/propellor
@@ -41,6 +42,7 @@ Depends: ${misc:Depends}, ${shlibs:Depends},
libghc-transformers-dev,
libghc-exceptions-dev (>= 0.6),
libghc-stm-dev,
+ libghc-text-dev,
git,
make,
Description: property-based host configuration management in haskell
diff --git a/propellor.cabal b/propellor.cabal
index a07109a7..6e871d6b 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -39,7 +39,7 @@ Executable propellor
Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
containers (>= 0.5), network, async, time, QuickCheck, mtl, transformers,
- exceptions (>= 0.6), stm
+ exceptions (>= 0.6), stm, text
if (! os(windows))
Build-Depends: unix
@@ -51,7 +51,7 @@ Executable propellor-config
Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
containers (>= 0.5), network, async, time, QuickCheck, mtl, transformers,
- exceptions, stm
+ exceptions, stm, text
if (! os(windows))
Build-Depends: unix
@@ -62,7 +62,7 @@ Library
Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
containers (>= 0.5), network, async, time, QuickCheck, mtl, transformers,
- exceptions, stm
+ exceptions, stm, text
if (! os(windows))
Build-Depends: unix
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 2318b910..21772b34 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -82,6 +82,7 @@ depsCommand = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) ++ "
, "libghc-transformers-dev"
, "libghc-exceptions-dev"
, "libghc-stm-dev"
+ , "libghc-text-dev"
, "make"
]
diff --git a/src/Utility/ConcurrentOutput.hs b/src/Utility/ConcurrentOutput.hs
index 94cd4202..c24744a3 100644
--- a/src/Utility/ConcurrentOutput.hs
+++ b/src/Utility/ConcurrentOutput.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
-- |
@@ -20,6 +20,7 @@
module Utility.ConcurrentOutput (
withConcurrentOutput,
flushConcurrentOutput,
+ Outputable(..),
outputConcurrent,
createProcessConcurrent,
waitForProcessConcurrent,
@@ -40,13 +41,14 @@ import Control.Concurrent.Async
import Data.Maybe
import Data.List
import Data.Monoid
-import qualified Data.ByteString as B
import qualified System.Process as P
import qualified Data.Set as S
+import qualified Data.ByteString as B
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
import Utility.Monad
import Utility.Exception
-import Utility.FileSystemEncoding
data OutputHandle = OutputHandle
{ outputLock :: TMVar Lock
@@ -137,27 +139,40 @@ flushConcurrentOutput = do
-- generating output, and flush any buffered output.
lockOutput $ return ()
--- | Displays a string to stdout, and flush output so it's displayed.
+-- | Values that can be output.
+class Outputable v where
+ toOutput :: v -> B.ByteString
+
+instance Outputable B.ByteString where
+ toOutput = id
+
+instance Outputable T.Text where
+ toOutput = encodeUtf8
+
+instance Outputable String where
+ toOutput = toOutput . T.pack
+
+-- | Displays a value to stdout, and flush output so it's displayed.
--
--- Uses locking to ensure that the whole string is output atomically
+-- Uses locking to ensure that the whole output occurs atomically
-- even when other threads are concurrently generating output.
--
-- When something else is writing to the console at the same time, this does
--- not block. It buffers the string, so it will be displayed once the other
+-- not block. It buffers the value, so it will be displayed once the other
-- writer is done.
-outputConcurrent :: String -> IO ()
-outputConcurrent s = bracket setup cleanup go
+outputConcurrent :: Outputable v => v -> IO ()
+outputConcurrent v = bracket setup cleanup go
where
setup = tryTakeOutputLock
cleanup False = return ()
cleanup True = dropOutputLock
go True = do
- putStr s
+ B.hPut stdout (toOutput v)
hFlush stdout
go False = do
bv <- outputBuffer <$> getOutputHandle
oldbuf <- atomically $ takeTMVar bv
- newbuf <- addBuffer (Output (B.pack (decodeW8NUL s))) oldbuf
+ newbuf <- addBuffer (Output (toOutput v)) oldbuf
atomically $ putTMVar bv newbuf
-- | This must be used to wait for processes started with