I'm using runCommand from System.Process but I use
"cd " ++ path ++ " & " ++ args
And it's not good, even will not work if path is on different local drive in windows.
How can I handle current directory change for runCommand ?
setCurrentDirectory from System.Directory changes the working directory of the main program.
If you do that before using runCommand, the command should use that directory too.
By looking at the source code of runCommand you can realize is just a thin wrapper for createProcess which is the one doing the real work. Here is an example taken from the createProcess documentation, which has been edited for convenience to address this question.
(_, Just hout, _, _) <- createProcess (proc "/path/to/my/executable" [])
{ cwd = Just "/path/to/working-directory"
, std_out = CreatePipe }
Related
I have a very peculiar dependency situation that I would like to package up in a single Stack/Cabal package: I need to build and run my program to get the input to a code-generator which produces output that needs to be linked in to... my program.
OK so in more concrete terms, here are the steps manually:
stack build to install all dependencies, and build all non-Verilator-using executables.
stack exec phase1 to run the first phase which generates, among other things, a Verilog file and a Clash .manifest file.
I have a custom source generator, which consumes the .manifest file from step 2, and produces C++ code and a Makefile that can be used to drive Verilator.
Run the Makefile generated in step 3:
It runs Verilator on the Verilog sources from step 2, which produces more C++ source code and a new Makefile
Then it runs the newly generated second Makefile, which produces a binary library
stack build --flag phase2 builds the second executable. This executable includes .hsc files that process headers produced in step 2, and it links to the C++ libraries produced in step 4/2.
I would like to automate this so that I can just run stack build and all this would happen behind the scenes. Where do I even start?!
To illustrate the whole process, here is a self-contained model:
package.yaml
name: clashilator-model
version: 0
category: acme
dependencies:
- base
- directory
source-dirs:
- src
flags:
phase2:
manual: True
default: False
executables:
phase1:
main: phase1.hs
phase2:
main: phase2.hs
when:
- condition: flag(phase2)
then:
source-dirs:
- src
- _build/generated
extra-libraries: stdc++
extra-lib-dirs: _build/compiled
ghc-options:
-O3 -fPIC -pgml g++
-optl-Wl,--allow-multiple-definition
-optl-Wl,--whole-archive -optl-Wl,-Bstatic
-optl-Wl,-L_build/compiled -optl-Wl,-lImpl
-optl-Wl,-Bdynamic -optl-Wl,--no-whole-archive
build-tools: hsc2hs
include-dirs: _build/generated
else:
buildable: false
src/phase1.hs
import System.Directory
main :: IO ()
main = do
createDirectoryIfMissing True "_build/generated"
writeFile "_build/generated/Interface.hsc" hsc
writeFile "_build/generated/Impl.h" h
writeFile "_build/generated/Impl.c" c
writeFile "_build/Makefile" makeFile
makeFile = unlines
[ "compiled/libImpl.a: compiled/Impl.o"
, "\trm -f $#"
, "\tmkdir -p compiled"
, "\tar rcsT $# $^"
, ""
, "compiled/Impl.o: generated/Impl.c generated/Impl.h"
, "\tmkdir -p compiled"
, "\t$(COMPILE.c) $(OUTPUT_OPTION) $<"
]
hsc = unlines
[ "module Interface where"
, "import Foreign.Storable"
, "import Foreign.Ptr"
, ""
, "data FOO = FOO Int deriving Show"
, ""
, "#include \"Impl.h\""
, ""
, "foreign import ccall unsafe \"bar\" bar :: Ptr FOO -> IO ()"
, "instance Storable FOO where"
, " alignment _ = #alignment FOO"
, " sizeOf _ = #size FOO"
, " peek ptr = FOO <$> (#peek FOO, fd1) ptr"
, " poke ptr (FOO x) = (#poke FOO, fd1) ptr x"
]
h = unlines
[ "#pragma once"
, ""
, "typedef struct{ int fd1; } FOO;"
]
c = unlines
[ "#include \"Impl.h\""
, "#include <stdio.h>"
, ""
, "void bar(FOO* arg)"
, "{ printf(\"bar: %d\\n\", arg->fd1); }"
]
src/phase2.hs
import Interface
import Foreign.Marshal.Utils
main :: IO ()
main = with (FOO 42) bar
Script to run the whole thing manually
stack build
stack run phase1
make -C _build
stack build --flag clashilator-model:phase2
stack exec phase2
The yak is fully bare: I managed to solve it with a custom Setup.hs.
In buildHook, I basically do whatever phase1 was supposed to do (instead of leaving it in a phase1 executable), putting all generated files in places below the buildDir of the LocalBuildInfo argument. These generated files are C++ source files and an .hsc file.
I then run make in the right directory, producing some libFoo.a.
Still in buildHook, now the fun part starts: editing the Executables in the PackageDescription.
I add the hsc file's location to hsSourceDirs, and the module itself to otherModules. Since hsc2hs requires access to the generated C++ headers, I also add the right directory to includeDirs. For the library itself, I add to extraLibDirs and edit options to link statically to libFoo.a, by passing flags directly to the linker.
The result of all this is a modified set of Executables, which I put back into the PackageDescription before passing it to the default buildHook. That one then runs hsc2hs and ghc to compile and link the phase2 executables.
I have put a full example project on Github. Look at Setup.hs and clashilator/src/Clash/Clashilator/Setup.hs to see this in action; in particular, here is the editing of the Executables in the PackageDescription:
-- TODO: Should we also edit `Library` components?
buildVerilator :: LocalBuildInfo -> BuildFlags -> [FilePath] -> String -> IO (Executable -> Executable)
buildVerilator localInfo buildFlags srcDir mod = do
let outDir = buildDir localInfo
(verilogDir, manifest) <- clashToVerilog localInfo buildFlags srcDir mod
let verilatorDir = "_verilator"
Clashilator.generateFiles (".." </> verilogDir) (outDir </> verilatorDir) manifest
-- TODO: bake in `pkg-config --cflags verilator`
() <- cmd (Cwd (outDir </> verilatorDir)) "make"
let incDir = outDir </> verilatorDir </> "src"
libDir = outDir </> verilatorDir </> "obj"
lib = "VerilatorFFI"
let fixupOptions f (PerCompilerFlavor x y) = PerCompilerFlavor (f x) (f y)
linkFlags =
[ "-fPIC"
, "-pgml", "g++"
, "-optl-Wl,--whole-archive"
, "-optl-Wl,-Bstatic"
, "-optl-Wl,-l" <> lib
, "-optl-Wl,-Bdynamic"
, "-optl-Wl,--no-whole-archive"
]
fixupExe = foldr (.) id $
[ includeDirs %~ (incDir:)
, extraLibDirs %~ (libDir:)
, options %~ fixupOptions (linkFlags++)
, hsSourceDirs %~ (incDir:)
, otherModules %~ (fromString lib:)
]
return fixupExe
I'm trying to create a process, and communicate with it via a handle that I provide outside the createProcess function:
stdOutH <- openFile (logDir </> "stdout.log") ReadWriteMode
hSetBuffering stdOutH LineBuffering
(_, _, _, ph) <- createProcess $
(proc "someproc" []) { std_out = UseHandle stdOutH
, std_err = UseHandle stdErrH
}
line <- hGetLine stdOutH
putStrLn $ "Got " ++ line
The "someproc" process spits a line out to the standard output, and I want to read it from the process that spawned it. However if I try to do this I get the following error:
hGetLine: illegal operation (handle is closed)
What I don't understand is why the handle is closed while the created process is running. This works if I use CreatePipe instead of UseHandle, the problem is that I only want to read the first line. But doing this requires to keep on reading from the pipe, otherwise it gets full after a certain amount of output by "someproc".
So, is there a way to use system.process to communicate two processes via stdOutH in the way described above?
This behavior of createProcess is documented:
Note that Handles provided for std_in, std_out, or std_err via the
UseHandle constructor will be closed by calling this function.
Documentation suggests to use createProcess_ function instead.
I am currently attempting to play audio files in Haskell using OpenAl. In order to do so, I am trying to get the example code at the ALUT git repository (https://github.com/haskell-openal/ALUT/blob/master/examples/Basic/PlayFile.hs) to work. However, it refuses to produce any sound. What am I missing here?
{-
PlayFile.hs (adapted from playfile.c in freealut)
Copyright (c) Sven Panne 2005-2016
This file is part of the ALUT package & distributed under a BSD-style license.
See the file LICENSE.
-}
import Control.Monad ( when, unless )
import Data.List ( intersperse )
import Sound.ALUT
import System.Exit ( exitFailure )
import System.IO ( hPutStrLn, stderr )
-- This program loads and plays a variety of files.
playFile :: FilePath -> IO ()
playFile fileName = do
-- Create an AL buffer from the given sound file.
buf <- createBuffer (File fileName)
-- Generate a single source, attach the buffer to it and start playing.
source <- genObjectName
buffer source $= Just buf
play [source]
-- Normally nothing should go wrong above, but one never knows...
errs <- get alErrors
unless (null errs) $ do
hPutStrLn stderr (concat (intersperse "," [ d | ALError _ d <- errs ]))
exitFailure
-- Check every 0.1 seconds if the sound is still playing.
let waitWhilePlaying = do
sleep 0.1
state <- get (sourceState source)
when (state == Playing) $
waitWhilePlaying
waitWhilePlaying
main :: IO ()
main = do
-- Initialise ALUT and eat any ALUT-specific commandline flags.
withProgNameAndArgs runALUT $ \progName args -> do
-- Check for correct usage.
unless (length args == 1) $ do
hPutStrLn stderr ("usage: " ++ progName ++ " <fileName>")
exitFailure
-- If everything is OK, play the sound file and exit when finished.
playFile (head args)
Unfortunately, while I don't get any errors, I also can\t hear any sound. Pavucontrol also does not seem to detect anything (no extra streams appear under the Playback tab).
Their HelloWorld example on the same git repository also gave neither errors nor sound.
I also tried the OpenALInfo function on the same git repository (https://github.com/haskell-openal/ALUT/blob/master/examples/Basic/OpenALInfo.hs), which further proves that I'm actually connecting to OpenAL, and gives some information about the versions which may or may not be useful:
ALC version: 1.1
ALC extensions:
ALC_ENUMERATE_ALL_EXT, ALC_ENUMERATION_EXT, ALC_EXT_CAPTURE,
ALC_EXT_DEDICATED, ALC_EXT_disconnect, ALC_EXT_EFX,
ALC_EXT_thread_local_context, ALC_SOFTX_device_clock,
ALC_SOFT_HRTF, ALC_SOFT_loopback, ALC_SOFT_pause_device
AL version: 1.1 ALSOFT 1.17.2
AL renderer: OpenAL Soft
AL vendor: OpenAL Community
AL extensions:
AL_EXT_ALAW, AL_EXT_BFORMAT, AL_EXT_DOUBLE,
AL_EXT_EXPONENT_DISTANCE, AL_EXT_FLOAT32, AL_EXT_IMA4,
AL_EXT_LINEAR_DISTANCE, AL_EXT_MCFORMATS, AL_EXT_MULAW,
AL_EXT_MULAW_BFORMAT, AL_EXT_MULAW_MCFORMATS, AL_EXT_OFFSET,
AL_EXT_source_distance_model, AL_LOKI_quadriphonic,
AL_SOFT_block_alignment, AL_SOFT_buffer_samples,
AL_SOFT_buffer_sub_data, AL_SOFT_deferred_updates,
AL_SOFT_direct_channels, AL_SOFT_loop_points, AL_SOFT_MSADPCM,
AL_SOFT_source_latency, AL_SOFT_source_length
Well, it turns out I posted here a bit too quickly. There was no problem with my code, but rather with my OpenAl settings. By adding
drivers=pulse,alsa
to /etc/openal/alsoft.conf OpenAl works. This is described in https://wiki.archlinux.org/index.php/PulseAudio#OpenAL.
I'm using the GHC API to parse a module. If the module contains syntax errors the GHC API writes them to stdout. This interferes with my program, which has another way to report errors. Example session:
$ prog ../stack/src/Stack/Package.hs
../stack/src/Stack/Package.hs:669:0:
error: missing binary operator before token "("
#if MIN_VERSION_Cabal(1, 22, 0)
^
../stack/src/Stack/Package.hs:783:0:
error: missing binary operator before token "("
#if MIN_VERSION_Cabal(1, 22, 0)
^
../stack/src/Stack/Package.hs
error: 1:1 argon: phase `C pre-processor' failed (exitcode = 1)
Only the last one should be outputted. How can I make sure the GHC API does not output anything? I'd like to avoid libraries like silently which solve the problem by redirecting stdout to a temporary file.
I already tried to use GHC.defaultErrorHandler, but while I can catch the exception, GHC API still writes to stdout. Relevant code:
-- | Parse a module with specific instructions for the C pre-processor.
parseModuleWithCpp :: CppOptions
-> FilePath
-> IO (Either (Span, String) LModule)
parseModuleWithCpp cppOptions file =
GHC.defaultErrorHandler GHC.defaultFatalMessager (GHC.FlushOut $ return ()) $
GHC.runGhc (Just libdir) $ do
dflags <- initDynFlags file
let useCpp = GHC.xopt GHC.Opt_Cpp dflags
fileContents <-
if useCpp
then getPreprocessedSrcDirect cppOptions file
else GHC.liftIO $ readFile file
return $
case parseFile dflags file fileContents of
GHC.PFailed ss m -> Left (srcSpanToSpan ss, GHC.showSDoc dflags m)
GHC.POk _ pmod -> Right pmod
Moreover, with this approach I cannot catch the error message (I just get ExitFailure). Removing the line with GHC.defaultErrorHandler gives me the output shown above.
Many thanks to #adamse for pointing me in the right direction! I have found the answer in Hint's code.
It suffices to override logging in the dynamic flags:
initDynFlags :: GHC.GhcMonad m => FilePath -> m GHC.DynFlags
initDynFlags file = do
dflags0 <- GHC.getSessionDynFlags
src_opts <- GHC.liftIO $ GHC.getOptionsFromFile dflags0 file
(dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 src_opts
let dflags2 = dflags1 { GHC.log_action = customLogAction }
void $ GHC.setSessionDynFlags dflags2
return dflags2
customLogAction :: GHC.LogAction
customLogAction dflags severity _ _ msg =
case severity of
GHC.SevFatal -> fail $ GHC.showSDoc dflags msg
_ -> return () -- do nothing in the other cases (debug, info, etc.)
The default implementation of GHC.log_action can be found here:
http://haddock.stackage.org/lts-3.10/ghc-7.10.2/src/DynFlags.html#defaultLogAction
The code for parsing remains the same in my question, after having removed the line about GHC.defaultErrorHandler, which is no longer needed, assuming one catches exceptions himself.
I have seen this question before and then the answer was to temporarily redirect stdout and stderr.
To redirect stdout to a file as an example:
import GHC.IO.Handle
import System.IO
main = do file <- openFile "stdout" WriteMode
stdout' <- hDuplicate stdout -- you might want to keep track
-- of the original stdout
hDuplicateTo file stdout -- makes the second Handle a
-- duplicate of the first
putStrLn "hi"
hClose file
I am trying to configure my xmonad.hs so that when I start my session I start an array of different programs on different workspaces (like Terminal in 1 ; Firefox in 2 ; Pidgin in 3).
I already looked into the XMonad.Actions.SpawnOn, but as spawnOn returns with an X () and not with a common m () I can not use it in main = do ....
Is there a function that takes an X-monad and returns with IO () or is there another workaround?
The common way is to use startupHook which takes X () action and performs it on each startup.
E.g.
main = xmonad $ defaultConfig
{ startupHook = do
spawnOn "workspace1" "program1"
…
spawnOn "workspaceN" "programN"
}