forked from GitHub/gf-core
decd7122de
+ References to modules under src/compiler have been eliminated from the PGF library (under src/runtime/haskell). Only two functions had to be moved (from GF.Data.Utilities to PGF.Utilities) to make this possible, other apparent dependencies turned out to be vacuous. + In gf.cabal, the GF executable no longer directly depends on the PGF library source directory, but only on the exposed library modules. This means that there is less duplication in gf.cabal and that the 30 modules in the PGF library will no longer be compiled twice while building GF. To make this possible, additional PGF library modules have been exposed, even though they should probably be considered for internal use only. They could be collected in a PGF.Internal module, or marked as "unstable", to make this explicit. + Also, by using the -fwarn-unused-imports flag, ~220 redundant imports were found and removed, reducing the total number of imports by ~15%.
91 lines
3.2 KiB
Haskell
91 lines
3.2 KiB
Haskell
-- | Shell IO: a monad that can restrict acesss to arbitrary IO and has the
|
|
-- ability to capture output that normally would be sent to stdout.
|
|
module GF.Infra.SIO(
|
|
-- * The SIO monad
|
|
SIO,
|
|
-- * Running SIO operations
|
|
runSIO,hRunSIO,captureSIO,
|
|
-- * Unrestricted, safe operations
|
|
-- ** From the standard libraries
|
|
getCPUTime,getCurrentDirectory,getLibraryDirectory,
|
|
newStdGen,print,putStrLn,
|
|
-- ** Specific to GF
|
|
importGrammar,importSource,
|
|
putStrLnFlush,runInterruptibly,
|
|
-- * Restricted accesss to arbitrary (potentially unsafe) IO operations
|
|
-- | If the environment variable GF_RESTRICTED is defined, these
|
|
-- operations will fail. Otherwise, they will be executed normally.
|
|
-- Output to stdout will /not/ be captured or redirected.
|
|
restricted,restrictedSystem
|
|
) where
|
|
import Prelude hiding (putStrLn,print)
|
|
import Control.Monad(liftM)
|
|
import System.IO(hPutStrLn,hFlush,stdout)
|
|
import GF.System.Catch(try)
|
|
import System.Cmd(system)
|
|
import System.Environment(getEnv)
|
|
import Control.Concurrent.Chan(newChan,writeChan,getChanContents)
|
|
import qualified System.CPUTime as IO(getCPUTime)
|
|
import qualified System.Directory as IO(getCurrentDirectory)
|
|
import qualified System.Random as IO(newStdGen)
|
|
import qualified GF.Infra.UseIO as IO(getLibraryDirectory)
|
|
import qualified GF.System.Signal as IO(runInterruptibly)
|
|
import qualified GF.Command.Importing as GF(importGrammar, importSource)
|
|
|
|
-- * The SIO monad
|
|
|
|
type PutStrLn = String -> IO ()
|
|
newtype SIO a = SIO {unS::PutStrLn->IO a}
|
|
|
|
instance Functor SIO where fmap = liftM
|
|
|
|
instance Monad SIO where
|
|
return x = SIO (const (return x))
|
|
SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h
|
|
|
|
-- * Running SIO operations
|
|
|
|
-- | Run normally
|
|
runSIO = hRunSIO stdout
|
|
|
|
-- | Redirect 'stdout' to the given handle
|
|
hRunSIO h sio = unS sio (\s->hPutStrLn h s>>hFlush h)
|
|
|
|
-- | Capture 'stdout'
|
|
captureSIO sio = do ch <- newChan
|
|
result <- unS sio (writeChan ch . Just)
|
|
writeChan ch Nothing
|
|
output <- fmap takeJust (getChanContents ch)
|
|
return (output,result)
|
|
where
|
|
takeJust (Just xs:ys) = xs++'\n':takeJust ys
|
|
takeJust _ = []
|
|
|
|
-- * Restricted accesss to arbitrary (potentially unsafe) IO operations
|
|
|
|
restricted io = SIO (const (restrictedIO io))
|
|
restrictedSystem = restricted . system
|
|
|
|
restrictedIO io =
|
|
either (const io) (const $ fail message) =<< try (getEnv "GF_RESTRICTED")
|
|
where
|
|
message =
|
|
"This operation is not allowed when GF is running in restricted mode."
|
|
|
|
-- * Unrestricted, safe IO operations
|
|
|
|
lift0 io = SIO $ const io
|
|
lift1 f io = SIO $ f . unS io
|
|
|
|
putStrLn = putStrLnFlush
|
|
putStrLnFlush s = SIO ($ s)
|
|
print x = putStrLn (show x)
|
|
|
|
getCPUTime = lift0 IO.getCPUTime
|
|
getCurrentDirectory = lift0 IO.getCurrentDirectory
|
|
getLibraryDirectory = lift0 . IO.getLibraryDirectory
|
|
newStdGen = lift0 IO.newStdGen
|
|
runInterruptibly = lift1 IO.runInterruptibly
|
|
|
|
importGrammar pgf opts files = lift0 $ GF.importGrammar pgf opts files
|
|
importSource src opts files = lift0 $ GF.importSource src opts files |