forked from GitHub/gf-core
GF.Infra.SIO: The SIO monad now supports putStr in addition to putStrLn
Also included some unrelated minor changes.
This commit is contained in:
2
.ghci
2
.ghci
@@ -1,2 +1,2 @@
|
||||
:set -isrc/compiler -isrc/binary -isrc/runtime/haskell -isrc/server -isrc/example-based -isrc/server/transfer -idist/build/autogen -idist/build/gf/gf-tmp
|
||||
:set -isrc/compiler -isrc/binary -isrc/runtime/haskell -isrc/server -isrc/example-based -isrc/server/transfer -idist/build/autogen -idist/build
|
||||
:set -fwarn-unused-imports -optP-DSERVER_MODE -optP-DUSE_INTERRUPT -optP-DCC_LAZY -optP-include -optPdist/build/autogen/cabal_macros.h -odir dist/build/gf/gf-tmp -hidir dist/build/gf/gf-tmp -stubdir dist/build/gf/gf-tmp
|
||||
|
||||
@@ -551,7 +551,7 @@ strsFromTerm t = case t of
|
||||
d0 <- strsFromTerm d
|
||||
v0 <- mapM (strsFromTerm . fst) vs
|
||||
c0 <- mapM (strsFromTerm . snd) vs
|
||||
let vs' = zip v0 c0
|
||||
--let vs' = zip v0 c0
|
||||
return [strTok (str2strings def) vars |
|
||||
def <- d0,
|
||||
vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] |
|
||||
|
||||
@@ -9,7 +9,7 @@ module GF.Infra.SIO(
|
||||
-- * Unrestricted, safe operations
|
||||
-- ** From the standard libraries
|
||||
getCPUTime,getCurrentDirectory,getLibraryDirectory,
|
||||
newStdGen,print,putStrLn,
|
||||
newStdGen,print,putStr,putStrLn,
|
||||
-- ** Specific to GF
|
||||
importGrammar,importSource,
|
||||
#ifdef C_RUNTIME
|
||||
@@ -22,11 +22,11 @@ module GF.Infra.SIO(
|
||||
-- Output to stdout will /not/ be captured or redirected.
|
||||
restricted,restrictedSystem
|
||||
) where
|
||||
import Prelude hiding (putStrLn,print)
|
||||
import Prelude hiding (putStr,putStrLn,print)
|
||||
import Control.Applicative(Applicative(..))
|
||||
import Control.Monad(liftM,ap)
|
||||
import Control.Monad.Trans(MonadTrans(..))
|
||||
import System.IO(hPutStrLn,hFlush,stdout)
|
||||
import System.IO(hPutStr,hFlush,stdout)
|
||||
import GF.System.Catch(try)
|
||||
import System.Process(system)
|
||||
import System.Environment(getEnv)
|
||||
@@ -45,8 +45,8 @@ import qualified PGF2
|
||||
|
||||
-- * The SIO monad
|
||||
|
||||
type PutStrLn = String -> IO ()
|
||||
newtype SIO a = SIO {unS::PutStrLn->IO a}
|
||||
type PutStr = String -> IO ()
|
||||
newtype SIO a = SIO {unS::PutStr->IO a}
|
||||
|
||||
instance Functor SIO where fmap = liftM
|
||||
|
||||
@@ -62,9 +62,11 @@ instance Output SIO where
|
||||
ePutStr = lift0 . ePutStr
|
||||
ePutStrLn = lift0 . ePutStrLn
|
||||
putStrLnE = putStrLnFlush
|
||||
--putStrE = --- !!!
|
||||
putStrE = putStr
|
||||
|
||||
class MonadSIO m where liftSIO :: SIO a -> m a
|
||||
class {- Monad m => -} MonadSIO m where liftSIO :: SIO a -> m a
|
||||
-- ^ If the Monad m superclass is included, then the generic instance
|
||||
-- for monad transformers below would require UndecidableInstances
|
||||
|
||||
instance MonadSIO SIO where liftSIO = id
|
||||
|
||||
@@ -77,16 +79,17 @@ instance (MonadTrans t,Monad m,MonadSIO m) => MonadSIO (t m) where
|
||||
runSIO = hRunSIO stdout
|
||||
|
||||
-- | Redirect 'stdout' to the given handle
|
||||
hRunSIO h sio = unS sio (\s->hPutStrLn h s>>hFlush h)
|
||||
hRunSIO h sio = unS sio (\s->hPutStr h s>>hFlush h)
|
||||
|
||||
-- | Capture 'stdout'
|
||||
captureSIO :: SIO a -> IO (String,a)
|
||||
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 (Just xs:ys) = xs++takeJust ys
|
||||
takeJust _ = []
|
||||
|
||||
-- * Restricted accesss to arbitrary (potentially unsafe) IO operations
|
||||
@@ -105,8 +108,10 @@ restrictedIO io =
|
||||
lift0 io = SIO $ const io
|
||||
lift1 f io = SIO $ f . unS io
|
||||
|
||||
putStr = putStrFlush
|
||||
putStrFlush s = SIO ($ s)
|
||||
putStrLn = putStrLnFlush
|
||||
putStrLnFlush s = SIO ($ s)
|
||||
putStrLnFlush s = putStr s >> putStrFlush "\n"
|
||||
print x = putStrLn (show x)
|
||||
|
||||
getCPUTime = lift0 IO.getCPUTime
|
||||
|
||||
@@ -517,7 +517,7 @@ type Continuation = TrieMap.TrieMap Token ActiveSet
|
||||
getContinuationInfo :: ParseState -> Map.Map [Token] [(FunId, CId, String)]
|
||||
getContinuationInfo pstate = Map.map (map f . Set.toList) contMap
|
||||
where
|
||||
PState abstr concr chart cont = pstate
|
||||
PState _abstr concr _chart cont = pstate
|
||||
contMap = Map.fromList (TrieMap.toList cont) -- always get [([], _::ActiveSet)]
|
||||
f :: Active -> (FunId,CId,String)
|
||||
f (Active int dotpos funid seqid pargs ak) = (funid, cid, seq)
|
||||
|
||||
Reference in New Issue
Block a user