dialogue (empty) → 0.1.0

raw patch · 7 files changed

+660/−0 lines, 7 filesdep +basedep +bytestringdep +dialogue

Dependencies added: base, bytestring, dialogue, directory

Files

ChangeLog.md +4/−0
LICENSE +30/−0
README.md +3/−0
dialogue.cabal +62/−0
examples/Main.hs +65/−0
src/System/IO/Continuation.hs +174/−0
src/System/IO/Dialogue.hs +322/−0

+ ChangeLog.md view

@@ -0,0 +1,4 @@+# Changelog for dialogue++## 0.1.0 2022-02-13+  - First version.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Alias Qli (c) 2022++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alias Qli nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,3 @@+# dialogue++Implement I/O described in Haskell Report 1.2, including stream-based and continuation-based I/O. You may want to [read the report](https://www.haskell.org/definition/haskell-report-1.2.ps.gz) or see the [examples](examples/Main.hs).

+ dialogue.cabal view

@@ -0,0 +1,62 @@+cabal-version: 2.4++name:           dialogue+version:        0.1.0+category:       IO+synopsis:       I/O in Haskell Report 1.2+description:    Please see the README on GitHub at <https://github.com/AliasQli/dialogue#readme>+homepage:       https://github.com/AliasQli/dialogue#readme+bug-reports:    https://github.com/AliasQli/dialogue/issues+author:         Alias Qli+maintainer:     2576814881@qq.com+copyright:      2022 Alias Qli+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/AliasQli/dialogue++library+  exposed-modules:+      System.IO.Continuation+      System.IO.Dialogue+  hs-source-dirs:+      src+  ghc-options: +    -Wall+    -Wcompat+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wredundant-constraints+    -Wno-name-shadowing+    -Wno-orphans+  build-depends:+      base        >= 4.7 && < 5+    , bytestring  >= 0.10.12 && < 0.11+    , directory   >= 1.3.6 && < 1.4+  default-language: Haskell2010++executable examples+  main-is: Main.hs+  hs-source-dirs:+      examples+  ghc-options:+    -Wall+    -Wcompat +    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wredundant-constraints+    -Wno-name-shadowing+    -Wno-orphans+    -threaded+    -rtsopts+    -with-rtsopts=-N+  build-depends:+      base >= 4.7 && < 5+    , dialogue+  default-language: Haskell2010

+ examples/Main.hs view

@@ -0,0 +1,65 @@+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+{-# OPTIONS_GHC -Wno-unused-matches #-}++-- | Here are some examples from the report.+module Main where++import           Prelude                    hiding (readFile)+import           System.IO.Continuation+import           System.IO.Dialogue++-- | A small example using the stream-based I/O. Note the irrefutable patterns!+example1 :: Dialogue+example1 ~(Success: ~((Str userInput) : ~(Success : ~(r4 : _)))) =+  [ AppendChan stdout "please type a filename\n"+  , ReadChan stdin+  , AppendChan stdout name+  , ReadFile name+  , AppendChan stdout (case r4 of Str contents    -> contents+                                  Failure ioerror -> "can't open file")+  , AppendChan stdout "\nfinished"+  ] where (name : _) = lines userInput++-- | Same as 'example1', but using the continuation-based I/O.+example2 :: Dialogue+example2 =+  appendChan stdout "please type a filename\n" exit (+  readChan stdin exit (\userInput ->+  let (name : _) = lines userInput in+  appendChan stdout name exit (+  readFile name (\ioerror -> appendChan stdout+                             "can't open file" exit done)+                (\contents ->+  appendChan stdout contents exit done))))++------------------------------------------------------------++-- | An example involving synchronisation.+program :: Dialogue+program = readChan stdin exit (\userInput -> readNums (lines userInput))++readNums :: [String] -> Dialogue+readNums inputLines =+  readInt "Enter first number: " inputLines+    (\num1 inputLines1 ->+      readInt "Enter second number: " inputLines1+        (\num2 _ -> reportResult num1 num2))++reportResult :: Int -> Int -> Dialogue+reportResult num1 num2 =+  appendChan stdout ("Their sum is: " ++ show (num1 + num2)) exit done++readInt :: String -> [String] -> (Int -> [String] -> Dialogue) -> Dialogue+readInt prompt inputLines succ =+  appendChan stdout prompt exit+    (case inputLines of+      (l1 : rest) -> case reads l1 of+        [(x,"")] -> succ x rest+        _        -> appendChan stdout+            "Error - retype the number\n" exit+            (readInt prompt rest succ)+      _ -> appendChan stdout "Early EOF" exit done)++main :: IO ()+main = runDialogue program

+ src/System/IO/Continuation.hs view

@@ -0,0 +1,174 @@+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}++{-|+Module      : System.IO.Continuation+Description : Continuation-based I/O.+Copyright   : (c) Alias Qli, 2022+License     : BSD-3-Clause+Maintainer  : 2576814881@qq.com+Stability   : experimental+Portability : POSIX++This module implements continuation-based I/O as described in Haskell Report 1.2. It shares +the same basic types as stream-based I/O.+-}++module System.IO.Continuation+  ( -- * Continuation Types+    SuccCont+  , StrCont+  , StrListCont+  , BinCont+  , FailCont+  , -- * Transactions+    -- | Continuation-based I/O is based on a collection of functions called /transactions/+    -- defined in a continuation style. Please refer to the corresponding constructors under +    -- 'Request' for documentations.+    done+  , readFile+  , writeFile+  , appendFile+  , readBinFile+  , writeBinFile+  , appendBinFile+  , deleteFile+  , statusFile+  , readChan+  , appendChan+  , readBinChan+  , appendBinChan+  , statusChan+  , echo+  , getArgs+  , getProgName+  , getEnv+  , setEnv+  , -- * Other Functions+    exit+  , abort+  , print+  , prints+  , interact+  , -- * Re-exports+    -- ** Types+    Dialogue+  , Bin+  , Name+  , IOError (..)+  , -- ** Channels+    stdin+  , stdout+  , stderr+  , stdecho+  , -- ** Run the Program+    runDialogue+  ) where++import           Prelude            (Bool, Show (..), String, shows)+import           System.IO.Dialogue++type SuccCont = Dialogue+type StrCont = String -> Dialogue+type StrListCont = [String] -> Dialogue+type BinCont = Bin -> Dialogue+type FailCont = IOError -> Dialogue++strDispatch :: FailCont -> StrCont -> Dialogue+strDispatch fail succ (resp:resps) = case resp of+  Str val     -> succ val resps+  Failure msg -> fail msg resps++strListDispatch :: FailCont -> StrListCont -> Dialogue+strListDispatch fail succ (resp:resps) = case resp of+  StrList val -> succ val resps+  Failure msg -> fail msg resps++binDispatch :: FailCont -> BinCont -> Dialogue+binDispatch fail succ (resp:resps) = case resp of+  Bn val      -> succ val resps+  Failure msg -> fail msg resps++succDispatch :: FailCont -> SuccCont -> Dialogue+succDispatch fail succ (resp:resps) = case resp of+  Success     -> succ resps+  Failure msg -> fail msg resps++done :: Dialogue+done _ = []++readFile  :: Name -> FailCont -> StrCont -> Dialogue+readFile name fail succ resps = ReadFile name : strDispatch fail succ resps++writeFile :: Name -> String -> FailCont -> SuccCont -> Dialogue+writeFile name contents fail succ resps = WriteFile name contents : succDispatch fail succ resps++appendFile :: Name -> String -> FailCont -> SuccCont -> Dialogue+appendFile name contents fail succ resps = AppendFile name contents : succDispatch fail succ resps++readBinFile  :: Name -> FailCont -> BinCont -> Dialogue+readBinFile name fail succ resps = ReadBinFile name : binDispatch fail succ resps++writeBinFile :: Name -> Bin -> FailCont -> SuccCont -> Dialogue+writeBinFile name contents fail succ resps = WriteBinFile name contents : succDispatch fail succ resps++appendBinFile :: Name -> Bin -> FailCont -> SuccCont -> Dialogue+appendBinFile name contents fail succ resps = AppendBinFile name contents : succDispatch fail succ resps++deleteFile :: Name -> FailCont -> SuccCont -> Dialogue+deleteFile name fail succ resps = DeleteFile name : succDispatch fail succ resps++statusFile :: Name -> FailCont -> StrCont -> Dialogue+statusFile name fail succ resps = StatusFile name : strDispatch fail succ resps++readChan :: Name -> FailCont -> StrCont -> Dialogue+readChan name fail succ resps = ReadChan name : strDispatch fail succ resps++appendChan :: Name -> String -> FailCont -> SuccCont -> Dialogue+appendChan name contents fail succ resps = AppendChan name contents : succDispatch fail succ resps++readBinChan :: Name -> FailCont -> BinCont -> Dialogue+readBinChan name fail succ resps = ReadBinChan name : binDispatch fail succ resps++appendBinChan :: Name -> Bin -> FailCont -> SuccCont -> Dialogue+appendBinChan name contents fail succ resps = AppendBinChan name contents : succDispatch fail succ resps++statusChan :: Name -> FailCont -> StrCont -> Dialogue+statusChan name fail succ resps = StatusChan name : strDispatch fail succ resps++echo :: Bool -> FailCont -> SuccCont -> Dialogue+echo bool fail succ resps = Echo bool : succDispatch fail succ resps++getArgs :: FailCont -> StrListCont -> Dialogue+getArgs fail succ resps = GetArgs : strListDispatch fail succ resps++getProgName :: FailCont -> StrCont -> Dialogue+getProgName fail succ resps = GetProgName : strDispatch fail succ resps++getEnv :: String -> FailCont -> StrCont -> Dialogue+getEnv name fail succ resps = GetEnv name : strDispatch fail succ resps++setEnv :: String -> String -> FailCont -> SuccCont -> Dialogue+setEnv name value fail succ resps = SetEnv name value : succDispatch fail succ resps++abort :: FailCont+abort _ = done++exit :: FailCont+exit err = appendChan stderr msg abort done+  where+    msg = case err of+      ReadError s   -> s+      WriteError s  -> s+      SearchError s -> s+      FormatError s -> s+      OtherError s  -> s++print :: Show a => a -> Dialogue+print x = appendChan stdout (show x) exit done++prints :: Show a => a -> String -> Dialogue+prints x s = appendChan stdout (shows x s) exit done++interact :: (String -> String) -> Dialogue+interact f = readChan stdin exit+  (\x -> appendChan stdout (f x) exit done)

+ src/System/IO/Dialogue.hs view

@@ -0,0 +1,322 @@+{-# LANGUAGE LambdaCase    #-}+{-# LANGUAGE TupleSections #-}++{-|+Module      : System.IO.Dialogue+Description : Stream-based I/O.+Copyright   : (c) Alias Qli, 2022+License     : BSD-3-Clause+Maintainer  : 2576814881@qq.com+Stability   : experimental+Portability : POSIX++This module implements stream-based I/O as described in Haskell Report 1.2.++As th resport says, "Haskell's I/O system is based on the view that a program communicates to+the outside world via /streams of messages/: a program issues a stream of /requests/ to the+operating system and in  return receives a stream of /responses/." And a stream in Haskell is+only a lazy list.+-}++module System.IO.Dialogue+  ( -- * The Program Type+    Dialogue+  , -- ** Request Types+    Request (..)+  ,  -- *** The Binary Type+    Bin+  , nullBin+  , appendBin+  , isNullBin+  , -- *** The 'Name' Type+    Name+  , -- **** Channels+    stdin+  , stdout+  , stderr+  , stdecho+  , -- ** Response Types+    Response (..)+  , IOError (..)+  , -- * Run the Program+    runDialogue+  ) where++import           Control.Concurrent   (newChan, readChan, writeChan)+import           Control.Monad+import           Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as LBS+import           Data.Function        ((&))+import           GHC.IO+import           Prelude              hiding (IOError)+import           System.Directory+import           System.Environment   (getArgs, getProgName, lookupEnv, setEnv)+import           System.IO            hiding (stderr, stdin, stdout)+import qualified System.IO            as Handle++-- * The Program Type++-- | Type of a Haskell program.+-- @['Response']@ is an ordered list of /responses/ and @['Request']@ is an ordered list of /requests/;+-- the /n/th response is the operating system's reply to the /n/th request.+type Dialogue = [Response] -> [Request]++-- | /Requests/ a program may issue.+data Request+  -- file system requests:+  = -- | @'ReadFile' name@ returns the contents of file @name@.+    --+    --   * If successful, the response will be of the form @'Str' s@, where @s@ is a string value;+    --+    --   * If the file does not exist, the response @'Failure' ('SearchError' string)@ is induced;+    --+    --   * If it is unreachable for some other reason, the @'Failure' ('ReadError' string)@ error is induced.+    ReadFile Name+  | -- | @'WriteFile' name string@ writes @string@ to file @name@. If the file does not exist, it is+    -- created. If it already exists, it is overwritten.+    --+    --   * A successful response has form @'Success'@;+    --+    --   * The only failure possible has the form @'Failure' ('WriteError' string)@.+    --+    -- This request is "hyperstrict" in its second argument: no response is+    -- returned until the entire list of values is completely evaluated.+    WriteFile Name String+  | -- | Identicle to 'WriteFile', except that+    --+    --   (1) the @string@ argument is appended to the current contents of the file named @name@;+    --+    --   (2) If the file does not exist, the response @'Failure' ('SearchError' string)@ is induced.+    --+    -- All other errors have form @'Failure' ('WriteError' string)@,+    -- and the request is hyperstrict in its second argument.+    AppendFile Name String+  | -- | Similar to 'ReadFile', except that if successful, the response will be of the form @'Bn' b@,+    -- where @b@ is a binary value.+    ReadBinFile Name+  | -- | Similar to 'WriteFile', except that it writes a binary value to file.+    WriteBinFile Name Bin+  | -- | Similar to 'AppendFile', except that it writes a binary value to file.+    AppendBinFile Name Bin+  | -- | @'DeleteFile' name@ delete file @name@, with successful response @'Success'@.+    --+    --   * If the file does not exist, the response @'Failure' ('SearchError' string)@ is induced.+    --+    --   * If it cannot be deleted for some other reason,+    --     a response of the form @'Failure' ('WriteError' string)@ is induced.+    DeleteFile Name+  | -- | @'StatusFile' name@ induce @'Failure' ('SearchError' string)@ if an object @name@ does not exist,+    -- or @'Failure' ('OtherError' string)@ if any other error should occur. Otherwise induce+    -- @'Str' status@ where @ststus@ is a string containing, in this order:+    --+    --   (1) Either \'f', \'d', or \'u' depending on whether the object is a file, directory,+    --       or something else, respectively;+    --+    --   (2) \'r' if the object is readable by this program, \'-' if not;+    --+    --   (3) \'w' if the object is writable by this program, \'-' if not;+    --+    --   (4) \'x' if the object is executable by this program, \'-' if not.+    --+    -- For example, "dr--" denotes a directory that can be read but not written or executed.+    StatusFile Name+  -- channel system requests:+  | -- | @'ReadChan' name@ opens channel @name@ for input.+    --+    --   * A successful response returns the contents of the channel as a lazy stream of characters.+    --+    --   * If the channel does not exist, the response @'Failure' ('SearchError' string)@ is induced;+    --+    --   * All other errors have form @'Failure' ('ReadError' string)@.+    --+    -- Unlike files, once a 'ReadChan' or 'ReadBinChan' request has been issued for a particular channel,+    -- it cannot be issued again for the same channel in that program, This reflects the ephemeral nature+    -- of its contents and prevents a serious space leak.+    --+    -- /Known issue/: This request would leave the handle behind the channel in /semi-closed/ state,+    -- causing any other attempt to read from the channel to fail. This should be problematic if your program+    -- issued an request to read from @stdin@, and+    --+    --   (1) You called Haskell functions that read from @stdin@ (/e.g./ 'getLine'), or ran another program+    --       that issues such a request after the program finishes.+    --+    --   (2) You're running the program from @ghci@.+    ReadChan Name+  | -- | @'AppendChan' name string@ writes @string@ to channel @name@. The sematics is as for 'AppendFile', except:+    --+    --   (1) The second argument is appended to whatever was previously written (if anything);+    --+    --   (2) If channel does not exist, the response @'Failure' ('SearchError' string)@ is induced.+    --+    -- All other errors have form @'Failure' ('WriteError' string)@.+    -- This request is hyperstrict in its second argument.+    AppendChan Name String+  | -- | Similar to 'ReadChan', except that if successful, the response will be of the form @'Bn' b@,+    -- where @b@ is a lazy binary value.+    ReadBinChan Name+  | -- | Similar to 'AppendChan', except that it writes a binary value to the channel.+    AppendBinChan Name Bin+  | -- | @'StatusChan' name@ induces @'Failure' ('SearchError' string)@ if an channel @name@ does not exist,+    -- otherwise it always induces @'Str' "0 0"@. The two @"0"@s indicate that there's no bound on the+    -- maximum line length and page length allowed on the channel, respectively.+    StatusChan Name+  -- environment requests:+  | -- | @'Echo' 'True'@ enables echoing of @stdin@ on @stdecho@; @'Echo' 'False'@ disables it. Either+    -- @'Success'@ or @'Failure' ('OtherError' string)@ is induced.+    --+    -- The report requires that the echo mode can only be set once by a particular program, before any+    -- I/O operation involving @stdin@. However, the restriction is loosened, and echo mode may be set+    -- at any time by the proogram multiple times.+    --+    -- /Known issue/: It's currently implemented as 'hSetEcho', which is known not to work on Windows.+    Echo Bool+  | -- | Induces the response @'StrList' str_list@, where @str_list@ is a list of the program's explicit+    -- command line arguments.+    GetArgs+  | -- | Returns the short name of the current program, not including search path information. If successful,+    -- the response will be of the form @'Str' s@, where @s@ is a string. If the operating system is unable+    -- to provbide the program name, @'Failure' ('OtherError' string)@ is induced.+    GetProgName+  | -- | @'GetEnv' name@ Returns the value of environment variable @name@. If successful, the response will be+    -- of the form @'Str' s@, where @s@ is a string. If the environment variable does not exist,+    -- a 'SearchError' is induced.+    GetEnv Name+  | -- | @'SetEnv' name string@ sets environment variable @name@ to @string@, with response @'Success'@.+    -- If the environment variable does not exist, it is created.+    SetEnv Name String+  deriving (Read, Show, Eq, Ord)++-- | 'Bin' is a datatype for binary values, as required by the report, and is implemented as a lazy 'ByteString'.+type Bin = ByteString++-- | The empty binary value.+nullBin :: Bin+nullBin = LBS.empty++-- | Append two 'Bin's.+appendBin :: Bin -> Bin -> Bin+appendBin = LBS.append++-- | Test whether a 'Bin' is empty.+isNullBin :: Bin -> Bool+isNullBin = LBS.null++-- | This type synonym is described in Haskell Report 1.0, and exists for backward compatibility.+type Name = String++-- | The @stdin@ channel. Readable.+stdin :: Name+stdin = "stdin"++-- | The @stdout@ channel. Writable.+stdout :: Name+stdout = "stdout"++-- | The @stderr@ channel. Writable.+stderr :: Name+stderr = "stderr"++-- | The @stdecho@ channel. Writable. Attached to @stdout@.+stdecho :: Name+stdecho = "stdecho"++data ChanMode = R | A deriving Eq++mapChan :: Name -> Maybe (Handle, ChanMode)+mapChan = \case+  "stdin"   -> Just (Handle.stdin, R)+  "stdout"  -> Just (Handle.stdout, A)+  "stderr"  -> Just (Handle.stderr, A)+  "stdecho" -> Just (Handle.stdout, A)+  _         -> Nothing++-- | /Responses/ a program may receive.+data Response+  = Success+  | Str String+  | StrList [String]+  | Bn Bin+  | Failure IOError+  deriving (Read, Show, Eq, Ord)++data IOError+  = WriteError String+  | ReadError String+  | SearchError String+  | -- | Since we're using a modern device and the maximum line length and page length+    -- allowed on the channel have no bound, this error would never occur.+    FormatError String+  | OtherError String+  deriving (Read, Show, Eq, Ord)++failWith :: Applicative f => IOError -> f Response+failWith = pure . Failure++fileNotFound, chanCantRead, chanCantAppend, chanNotExist, varNotExist :: IOError+fileNotFound   = SearchError "File not found."+chanCantRead   = ReadError "Can't read from channel."+chanCantAppend = WriteError "Can't append to channel."+chanNotExist   = SearchError "Channel doesn't exist."+varNotExist    = SearchError "Environment variable doesn't exist."++ensureFileExist :: FilePath -> IO Response -> IO Response+ensureFileExist name io =+  doesFileExist name >>= \case+    False -> failWith fileNotFound+    True  -> io++withMode :: Applicative f => Name -> ChanMode -> (Handle -> f Response) -> f Response+withMode name mode f = case mapChan name of+  Nothing     -> failWith chanNotExist+  Just (h, m)+    | m == mode -> f h+    | mode == R -> failWith chanCantRead+    | otherwise -> failWith chanCantAppend++interpret :: Request -> IO Response+interpret req = case interpret' req of+    (io, err) -> catchAny io (failWith . err . show)+  where+    interpret' (ReadFile name)          = (ensureFileExist name $ Str <$> readFile name, ReadError)+    interpret' (WriteFile name str)     = (Success <$ writeFile name str, WriteError)+    interpret' (AppendFile name str)    = (ensureFileExist name $ Success <$ appendFile name str, WriteError)+    interpret' (ReadBinFile name)       = (ensureFileExist name $ Bn <$> LBS.readFile name, ReadError)+    interpret' (WriteBinFile name bin)  = (Success <$ LBS.writeFile name bin, WriteError)+    interpret' (AppendBinFile name bin) = (ensureFileExist name $ Success <$ LBS.appendFile name bin, WriteError)+    interpret' (DeleteFile name)        = (ensureFileExist name $ Success <$ removeFile name, WriteError)+    interpret' (StatusFile name)        = (, OtherError) $ do+      [p, f, d] <- mapM (unsafeInterleaveIO . ($ name)) [doesPathExist, doesFileExist, doesDirectoryExist]+      let ty = case (p, f, d) of+            (False, _, _) -> Nothing+            (_, True, _)  -> Just 'f'+            (_, _, True)  -> Just 'd'+            _             -> Just 'u'+      case ty of+        Nothing -> failWith fileNotFound+        Just c -> do+          s <- getPermissions name+          return $ Str+            [ c+            , if readable s then 'r' else '-'+            , if writable s then 'w' else '-'+            , if executable s then 'x' else '-'+            ]+    interpret' (ReadChan name)          = (withMode name R (fmap Str . hGetContents), ReadError)+    interpret' (AppendChan name str)    = (withMode name A (\h -> Success <$ (hPutStr h str >> hFlush h)), WriteError)+    interpret' (ReadBinChan name)       = (withMode name R (fmap Bn . LBS.hGetContents), ReadError)+    interpret' (AppendBinChan name str) = (withMode name A (\h -> Success <$ (LBS.hPutStr h str >> hFlush h)), WriteError)+    interpret' (StatusChan name)        = (mapChan name & maybe (failWith chanNotExist) (const (pure (Str "0 0"))), OtherError)+    interpret' (Echo b)                 = (Success <$ hSetEcho Handle.stdin b, OtherError)+    interpret' GetArgs                  = (StrList <$> getArgs, OtherError)+    interpret' GetProgName              = (Str <$> getProgName, OtherError)+    interpret' (GetEnv name)            = (lookupEnv name >>= maybe (failWith varNotExist) (pure . Str), OtherError)+    interpret' (SetEnv name str)        = (Success <$ setEnv name str, OtherError)++-- | The central function to run a program.+runDialogue :: Dialogue -> IO ()+runDialogue prog = do+  resChan <- newChan+  let reading = unsafeInterleaveIO $ (:) <$> readChan resChan <*> reading+  input <- reading+  let output = prog input+  forM_ output $ interpret >=> writeChan resChan