Yogurt 0.3 → 0.4

raw patch · 7 files changed

+221/−111 lines, 7 filesdep +sybdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: syb

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Network/Yogurt.hs +11/−4
• Network/Yogurt/Engine.hs +0/−80
• Network/Yogurt/Mud.hs +31/−10
• Network/Yogurt/Readline.hs +76/−0
• Network/Yogurt/Session.hs +51/−0
• Network/Yogurt/Utils.hs +24/−11
• Yogurt.cabal +28/−6

@@ -1,10 +1,17 @@--- | Re-exports the other three modules.+-- | Provides Yogurt's version number and re-exports the other modules. module Network.Yogurt (+  version,   module Network.Yogurt.Mud,-  module Network.Yogurt.Engine,-  module Network.Yogurt.Utils+  module Network.Yogurt.Session,+  module Network.Yogurt.Utils,   ) where  import Network.Yogurt.Mud+import Network.Yogurt.Session import Network.Yogurt.Utils-import Network.Yogurt.Engine+import Data.Version+import qualified Paths_Yogurt as P++-- | The version number of this version of the library.+version :: Version+version = P.version

@@ -1,80 +0,0 @@-{-# LANGUAGE RecursiveDo #-}--module Network.Yogurt.Engine (connect, runMud) where--import Network.Yogurt.Mud-import System.IO-import Network-import Control.Concurrent-import Control.Monad.State-import System.Console.Readline-import Network.Yogurt.IO-import Data.Char (isSpace)-import System.Process----- | @connect hostname port program@ connects to a MUD and executes the specified program. Input is read from @stdin@, and output is written to @stdout@.-connect :: String -> Int -> Mud () -> IO ()-connect host port mud = mdo-  -- Connect.-  putStrLn $ "Connecting to " ++ host ++ " port " ++ show port ++ "..."-  h <- connectTo host (PortNumber (fromIntegral port))--  -- Create shared mud state, executing initial commands.-  let out ch msg = case ch of-        Local  -> writeToTTY msg-        Remote -> do hPutStr h msg; hFlush h-  let state0 = emptyMud (runMud vState) out-  state1 <- execStateT mud state0-  vState <- newMVar state1--  -- Start child threads.-  forkIO (handleSource vState localInput Remote)-  handleSource vState (remoteInput h) Local-  -  -- Clean.-  runCommand "stty echo" >>= waitForProcess-  return ()----- Watches an input source and updates the mud state whenever a new message arrives.-handleSource :: MVar MudState ->      -- to run mud computations-                IO (Maybe String) ->  -- input source-                Destination ->        -- target destination-                IO ()-handleSource env input dest = loop where-  loop = do-    mmessage <- input-    case mmessage of-      Nothing -> return ()-      Just message -> do-        runMud env (trigger dest message)-        loop----- Local input using readline.-localInput :: IO (Maybe String)-localInput = do-  maybeLine <- readline ""-  setLineBuffer ""-  case maybeLine of-    Nothing   -> return Nothing-    Just line -> do-      when (not $ all isSpace line) (addHistory line)-      return (Just $ line ++ "\n")----- Remote input using a connection handle.-remoteInput :: Handle -> IO (Maybe String)-remoteInput h = do-  input <- maybeInput (hGetImpatientLine h 10)-  return input----- | Runs a Mud computation, executes the results (such as sending messages to the screen or the MUD) and returns the computation's result. The MVar is updated.-runMud :: MVar MudState -> Mud a -> IO a-runMud vState prog = do-  s <- takeMVar vState-  (rv, s') <- runStateT prog s-  putMVar vState s'-  return rv

@@ -1,15 +1,20 @@-{-# OPTIONS_GHC -fglasgow-exts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ImpredicativeTypes #-}+{-# LANGUAGE LiberalTypeSynonyms #-}  -- | The core of Yogurt, consisting of the Mud monad and all functions manipulating this monad. module Network.Yogurt.Mud (    -- * Types-  Mud, MudState, emptyMud,+  Mud, MudState,   RunMud, Output,   Hook,   Destination(..),   Pattern,   Var,+  +  -- * Running Mud computations+  emptyMud, runMud,    -- * Hooks   -- | A hook watches a channel for messages matching a specific regular expression.@@ -32,6 +37,8 @@    -- * Triggering hooks   trigger, triggerJust, io,+  +  -- * Multi-threading   liftIO, forkWithCallback    ) where@@ -47,6 +54,7 @@ import Data.Monoid (mconcat) import Data.IORef import Control.Concurrent (forkIO, ThreadId)+import Control.Concurrent.MVar   @@ -56,7 +64,7 @@ -- | The Mud monad is a state monad over IO. type Mud = StateT MudState IO --- | Run a Mud computation in IO.+-- | Run a Mud computation in IO. A common implementation of this function is @'runMud' vState@. type RunMud = forall a. Mud a -> IO a  -- | Provides a way to output messages.@@ -71,10 +79,6 @@   , mOutput   :: Output   } --- | The initial state of the Mud monad.-emptyMud :: RunMud -> Output -> MudState-emptyMud = MudState empty [0..] Nothing- -- | The abstract @Hook@ type. For every pair of hooks @(h1, h2)@: -- -- * @h1 == h2@ iff they were created by the same call to 'mkHook'.@@ -92,10 +96,10 @@   (==) = (==) `on` hId  instance Ord Hook where-  compare = flip $ mconcat [comparing hPriority, comparing hId]+  compare = flip $ mconcat [comparing hDestination, comparing hPriority, comparing hId]  instance Show Hook where-  show (Hook hid prio dest pat _) = "Hook #" ++ show hid ++ " @" ++ show prio ++ " " ++ show dest ++ " [" ++ pat ++ "]"+  show (Hook hid prio dest pat _) = show dest ++ " @" ++ show prio ++ " [" ++ pat ++ "]"  -- | The direction in which a message is going. data Destination@@ -114,7 +118,7 @@   , mAfter         :: String   } --- | Variables hold temporary, updatable, typed data.+-- | Variables hold updatable, typed data. newtype Var a = Var (IORef a)  type Id = Int@@ -132,6 +136,23 @@  updateHooks :: (IntMap Hook -> IntMap Hook) -> Mud () updateHooks f = modify $ \s -> s { hooks = f (hooks s) }++++-- Section: Running Mud computations+++-- | The initial state of the Mud monad. The 'RunMud' argument is stored in the state to make 'forkWithCallback' possible; the 'Output' argument is used by 'Mud' computations for messages leaving the engine.+emptyMud :: RunMud -> Output -> MudState+emptyMud = MudState empty [0..] Nothing++-- | Runs a 'Mud' computation, executes the results (such as sending messages to the screen or the MUD) and returns the computation's result. The 'MVar' is updated.+runMud :: MVar MudState -> RunMud+runMud vState prog = do+  s <- takeMVar vState+  (rv, s') <- runStateT prog s+  putMVar vState s'+  return rv   

@@ -0,0 +1,76 @@+{-# LANGUAGE RecursiveDo #-}++-- | Provides a readline-based command-line interface for connecting to MUDs. +module Network.Yogurt.Readline (+    connect+  ) where++import Network.Yogurt.Mud+import Network.Yogurt.IO++import Control.Monad.State+import Control.Concurrent.MVar+import System.IO+import Data.Char (isSpace)+import System.Console.Readline+import Control.Concurrent+import Network+import System.Process+++-- | @connect hostname port program@ connects to a MUD and executes the specified program on connecting. Input is read from @stdin@ and output is written to @stdout@.+connect :: String -> Int -> Mud () -> IO ()+connect host port mud = mdo+  -- Connect.+  putStrLn $ "Connecting to " ++ host ++ " port " ++ show port ++ "..."+  h <- connectTo host (PortNumber (fromIntegral port))++  -- Create shared mud state, executing initial commands.+  let out ch msg = case ch of+        Local  -> writeToTTY msg+        Remote -> do hPutStr h msg; hFlush h+  let state0 = emptyMud (runMud vState) out+  state1 <- execStateT mud state0+  vState <- newMVar state1++  -- Start child threads.+  forkIO (handleSource vState localInput Remote)+  handleSource vState (remoteInput h) Local++  -- Clean.+  runCommand "stty echo" >>= waitForProcess+  return ()+++-- Watches an input source and updates the mud state whenever a new message arrives.+handleSource :: MVar MudState ->      -- to run mud computations+                IO (Maybe String) ->  -- input source+                Destination ->        -- target destination+                IO ()+handleSource env input dest = loop where+  loop = do+    mmessage <- input+    case mmessage of+      Nothing -> return ()+      Just message -> do+        runMud env (trigger dest message)+        loop+++-- Local input using readline.+localInput :: IO (Maybe String)+localInput = do+  maybeLine <- readline ""+  setLineBuffer ""+  case maybeLine of+    Nothing   -> return Nothing+    Just line -> do+      when (not $ all isSpace line) (addHistory line)+      return (Just $ line ++ "\n")+++-- Remote input using a connection handle.+remoteInput :: Handle -> IO (Maybe String)+remoteInput h = do+  input <- maybeInput (hGetImpatientLine h 10)+  return input

@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- | +-- Sessions are used by Yogurt's standalone executable @yogurt@; see package @Yogurt-Standalone@ on hackage.+--+-- Every Yogurt file loaded by @yogurt@ should define a value of type 'Session'. For future compatibility, such a session is best defined using 'session' as starting value:+--+-- > import Network.Yogurt+-- >+-- > newmoon :: Session+-- > newmoon = session+-- >   { hostName   = "eclipse.cs.pdx.edu"+-- >   , portNumber = 7680+-- >   , mudProgram = \reload -> do+-- >       mkCommand "reload" reload+-- >   }+-- +-- A module is free to define multiple sessions, in which case you will have to tell @yogurt@ which session to load.+module Network.Yogurt.Session (+    Session(..), Reload, session+  ) where++import Network.Yogurt.Mud+import Data.Generics (Typeable)+import Control.Monad+import Data.List (elemIndices)++-- | Describes a MUD session.+data Session = Session+  { -- | The hostname to connect to.+    hostName    :: String+    -- | The port to connect to.+  , portNumber  :: Int+    -- | The initial program to run. The 'Reload' argument provides a way to+    --   reload the plugin without interrupting the MUD connection.+  , mudProgram  :: Reload -> Mud ()+  }+  deriving Typeable++-- | When executed, reloads the session from disk without interrupting the MUD connection. If the reloaded+--   session contains no errors, all hooks are uninstalled before the reloaded program is executed. Timers+--   are /not/ stopped and previous variables will still be reachable if you hang on to their handles.+type Reload = Mud ()++-- | Starting value for sessions. The default 'mudProgram' is @return ()@. There are no default values for 'hostName' and 'portNumber'.+session :: Session+session = Session+  { hostName    = error "session hostName not set"+  , portNumber  = error "session portNumber not set"+  , mudProgram  = const (return ())+  }

@@ -1,9 +1,10 @@-{-# OPTIONS_GHC -fglasgow-exts #-}+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE Rank2Types #-}  -- | Convenience functions on top of "Yogurt.Mud". module Network.Yogurt.Utils (-  -- * Hook and timer derivatives-  mkTrigger, mkTriggerOnce,+  -- * Hook derivatives+  mkTrigger, mkTriggerOnce, triggerOneOf,   mkAlias, mkArgAlias, mkCommand,    -- * Timers@@ -15,7 +16,8 @@   -- * Logging   Logger, startLogging, stopLogging, -  -- * Miscellaneous+  -- * Triggering multiple hooks+  -- | By default, when a message causes a hook to fire, the message is stopped and discarded unless the hook decides otherwise. These functions provide ways to give other hooks with lower priorities a chance to fire as well.   matchMore, matchMoreOn, matchMoreOn'    ) where@@ -30,7 +32,7 @@   --- Hook and timer derivatives.+-- Hook derivatives.   -- | Creates a hook that watches messages headed to the terminal. When fired, the message is passed on to the terminal and the action is executed.@@ -43,6 +45,13 @@   hook <- mkTrigger pat (act >> rmHook hook)   return hook +-- | For each pair @(pattern, action)@ a hook is installed. As soon as one of the hooks fires, the hooks are removed and the corresponding action is executed.+triggerOneOf :: [(Pattern, Mud ())] -> Mud ()+triggerOneOf pairs = mdo+  hs <- forM pairs $ \(pat, act) -> do+    mkTrigger pat (forM hs rmHook >> act)+  return ()+ -- | @mkAlias command subst@ creates a hook that watches messages headed to the remote MUD. If the message is or starts with the word @command@, the command is replaced by @subst@ before being sent to the MUD. mkAlias :: String -> String -> Mud Hook mkAlias pat subst = mkHook Remote ("^" ++ pat ++ "($| .*$)") $ do@@ -55,7 +64,7 @@   args <- fmap words (group 1)   echorln (f args) --- | Like 'mkAlias', but instead of substituting the command, a program is executed.+-- | Like 'mkAlias', but instead of substituting the command, a program is executed. The command's arguments are available as 'group' 1. mkCommand :: String -> Mud a -> Mud Hook mkCommand pat = mkHook Remote ("^" ++ pat ++ "($| .*$)") @@ -64,7 +73,7 @@ -- Section: Timers.  --- | The abstract Time type.+-- | The abstract Timer type. newtype Timer = Timer (Var Bool)  -- | Interval in milliseconds.@@ -110,13 +119,16 @@ -- Sending messages.  +withNewline :: String -> String+withNewline = (++ "\r\n")+ -- | Sends a message to the terminal, triggering hooks. receive :: String -> Mud () receive = trigger Local  -- | Sends a message appended with a newline character to the MUD, triggering hooks. sendln :: String -> Mud ()-sendln m = trigger Remote (m ++ "\n")+sendln = trigger Remote . withNewline  -- | Sends a message to the terminal, without triggering hooks. echo :: String -> Mud ()@@ -124,11 +136,11 @@  -- | Sends a message appended with a newline character to the terminal, without triggering hooks. echoln :: String -> Mud ()-echoln m = echo (m ++ "\n")+echoln = echo . withNewline  -- | Sends a message appended with a newline character to the MUD, without triggering hooks. echorln :: String -> Mud ()-echorln m = io Remote (m ++ "\n")+echorln = io Remote . withNewline  -- | Sends a bell character to the terminal. bell :: Mud ()@@ -165,7 +177,8 @@   -- | When called from a hook body, gives hooks that haven't been considered yet--- a chance to match on the currently triggering message. Useful if you want to+-- a chance to match on the currently triggering message. If no other hooks match,+-- the message is sent on to its destination. Useful if you want to -- build a hook that only has a side-effect and doesn't want to directly affect -- the other active hooks. matchMore :: Mud ()

@@ -1,21 +1,43 @@ Name:           Yogurt-Version:        0.3+Version:        0.4 Synopsis:       A MUD client library-Description:    A MUD client library for Haskell. Features prioritized, regex-based hooks, variables and timers.+Description:   	Yogurt is a functional MUD client featuring prioritized, regex-based hooks, variables, timers, logging, dynamic loading of Yogurt scripts and more. For example programs, please see Yogurt's home page.+                .+                This package provides the library. To use Yogurt as a standalone executable and dynamically load and reload Yogurt scripts, please see package @Yogurt-Standalone@.+                .+                If you do not wish to install the readline-based command-line interface available in module @Network.Yogurt.Readline@, install using @cabal install Yogurt -f-readline@. + Author:         Martijn van Steenbergen Maintainer:     martijn@van.steenbergen.nl Stability:      Experimental Copyright:      Some Rights Reserved (CC) 2008-2009 Martijn van Steenbergen-Homepage:       http://martijn.van.steenbergen.nl/projects/yogurt/+Homepage:       http://code.google.com/p/yogurt-mud/ + Cabal-Version:  >= 1.2 License:        BSD3 License-file:   LICENSE Category:       Network Build-type:     Simple ++Flag readline+  Description:  Enable the readline-based command-line interface.+  Default:      True++ Library-  Build-Depends:    base, mtl, regex-posix, containers, time, old-locale, readline, network, process-  Exposed-Modules:  Network.Yogurt, Network.Yogurt.Mud, Network.Yogurt.Utils, Network.Yogurt.Engine-  Other-Modules:    Network.Yogurt.Ansi, Network.Yogurt.IO+  Exposed-Modules:  Network.Yogurt, Network.Yogurt.Mud, Network.Yogurt.Utils, Network.Yogurt.Session+  Other-Modules:    Network.Yogurt.Ansi, Paths_Yogurt+  Build-Depends:    mtl, regex-posix, containers, time, old-locale++  if impl(ghc >= 6.10)+    Build-Depends:  base >= 4, base < 5, syb+  else+    Build-Depends:  base >= 3, base < 4++  if flag(readline)+    Exposed-Modules:  Network.Yogurt.Readline+    Other-Modules:    Network.Yogurt.IO+    Build-Depends:    readline, process, network