summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2015-10-29 00:38:53 -0400
committerJoey Hess2015-10-29 00:46:49 -0400
commit39fa051833de3178639974fa4fc7c803c5918f0e (patch)
tree3e3dcae0886adb1c851bdfdbc1a1d5ee99cb26e2
parentceee9305dce89a9529b316db6d6a5eabe1ad8adb (diff)
generalize what can be output
This adds a dependency on Text, but I don't mind propellor depending on it and am somewhat surprised it doesn't already. Using Text also lets this use encodeUtf8 instead of the nasty hack it was using to go from String -> ByteString.
-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